1000 ! RKERMIT
1010 ! 
1020 ! - Utvecklat
1030 ! - av:  LID@N DATA
1040 ! -
1050 ! - Projekt:     REMOTE
1060 ! - Konstrukt|r: Mikael Lid`n
1070 ! - Vers:        1.0
1080 ! - P}b|rjat:    850726
1090 ! - [ndring:     850726
1100 ! 
1110 ! 
1115 EXTEND : INTEGER : OPTION BASE 0
1120 COMMON Huvud$=20,Prog$=5,Printer$=16,Mtyp
1130 ! *
1140 ! 
1150 ! 
1160 DEF FNKermit LOCAL A$=10,Mval,Flf
1170   Maxpack=78 : Soh=1 : Brkchr=192 : Maxtry=5 : Myquote=ASCII('#') : Mypad=0 : Mypchar=0 : Myeol=13 : Mytime=5
1180   Maxtim=20 : Mintim=2 : True=-1 : False=0 : Fd=4 : Remfd=9 : Sp=32 : Del=127 : Brf=7 : Ctrc=193 : Eol=13
1190   DIM Recpkt$=80,Packet$=160,Inbuff$=160,Q$=100,Sp$=25,V24buf$=1024
1200   Vbuf=VARPTR(V24buf$) : Vrot=VAROOT(V24buf$)
1210   Sp$=SPACE$(25)
1220   OPEN 'CON:' AS FILE Remfd
1230   WHILE True
1240     Mval=FNHead
1250     ! 
1260     WHILE Mval=2
1270       IF FNRecsw ; CUR(15,0) 'OK' SPACE$(78) ELSE ; CUR(15,0) 'Mottagningen misslyckades' SPACE$(53)
1280       ; '<Tryck p} n}gon tangent>'; : GET A$
1290       Mval=0
1300     WEND 
1310     ! 
1320     WHILE Mval=3
1330       Nfiles=FNFiles(0) : Flf=-1
1340       WHILE Nfiles>0 AND Flf
1350         Ifile=1
1360         Filnam$=File$(Ifile)
1370         IF FNSendsw ; CUR(15,0) 'OK' SPACE$(78) ELSE ; CUR(15,0) 'S{ndningen misslyckades' SPACE$(55)
1380         ; '<Tryck p} n}gon tangent>'; : GET A$
1390         Flf=0
1400       WEND 
1410       Mval=0
1420     WEND 
1430     IF Mval=4 RETURN 0
1440   WEND 
1450 FNEND 
1460 ! *
1470 ! 
1480 ! S{nd mina parametrar till andra {ndan
1490 ! 
1500 DEF FNSpar$=CHR$(Maxpack+32,Mytime+32,Mypad+32,Mypchar XOR 64,Myeol+32,Myquote) 
1510 ! *
1520 ! 
1530 ! Packa upp parametrar fr}n andra sidan
1540 ! 
1550 DEF FNRpar(S$) LOCAL Pp,Ss$=6
1560   Spsiz=ASCII(S$)-32 : Timint=ASCII(MID$(S$,2,1))-32
1570   Pad=ASCII(MID$(S$,3,1))-32 : Padchar=ASCII(MID$(S$,4,1))
1580   Padchar=Padchar XOR 64
1590   Eol=ASCII(MID$(S$,5,1))-32 : Quote=ASCII(MID$(S$,6,1))
1600   RETURN 0
1610 FNEND 
1620 ! *
1630 ! 
1640 ! Packa upp ett paket till fil
1650 ! 
1660 DEF FNBufemp(Buf,Fd,Lgd) LOCAL I,T,Pp
1670   I=1 : Pp=Buf
1680   WHILE I<=Lgd
1690     T=PEEK(Pp)
1700     IF T=Myquote I=I+1 : Pp=Pp+1 : Z=FNUnquote(PEEK(Pp)) ELSE ; #Fd CHR$(T); : Krad=Krad+1
1710     I=I+1 : Pp=Pp+1
1720   WEND 
1730   RETURN Lgd
1740 FNEND 
1750 ! *
1760 ! 
1770 ! Packa upp quote packat
1780 ! 
1790 DEF FNUnquote(T)
1800   IF T=Myquote ; #Fd CHR$(T); : Krad=Krad+1 : RETURN 0
1810   T=T XOR 64 : IF T=Myeol Krad=0
1820   IF T=9 ; #Fd SPACE$(8*((Krad+8)/8)-Krad); : Krad=8*((Krad+8)/8) : RETURN 0
1830   ; #Fd CHR$(T); : RETURN 0
1840 FNEND 
1850 ! *
1860 ! 
1870 ! Fyll buffert (fill{sning)
1880 ! 
1890 DEF FNBufill$ LOCAL B$=90,I,T
1900   B$=''
1910   WHILE True
1920     IF LEN(Inbuff$)=0 ON ERROR GOTO 1970 : INPUT LINE #2,Inbuff$
1930     T=ASCII(Inbuff$) AND 127
1940     IF T<Sp OR T=Myquote OR T=Del IF LEN(B$)>Spsiz-9 RETURN B$ ELSE B$=B$+FNQ$(T) ELSE B$=B$+CHR$(T)
1950     Inbuff$=RIGHT$(Inbuff$,2) : IF LEN(B$)>=Spsiz-8 RETURN B$
1960   WEND 
1970   RESUME 1980
1980   RETURN B$
1990 FNEND 
2000 ! *
2010 ! 
2020 ! S{ndpaket till andra {ndan
2030 ! 
2040 DEF FNSpack(Type,Num,Length,Data$) LOCAL Chksum,Buffer$=170,I
2050   Buffer$=STRING$(Padchar,Pad)+CHR$(Soh,Length+35,Num+32,Type)+Data$
2060   Chksum=Length+Num+Type+67
2070   I=1
2080   WHILE I<=Length : Chksum=Chksum+ASCII(MID$(Data$,I,1)) : I=I+1 : WEND 
2090   Chksum=(Chksum+(Chksum AND 192)/64) AND 63
2100   Buffer$=Buffer$+CHR$(Chksum+32,Eol,10)
2110   ; #Remfd Buffer$;
2120   RETURN LEN(Buffer$)
2130 FNEND 
2140 ! *
2150 ! 
2160 ! Tag emot ett paket
2170 ! 
2180 DEF FNRpack(Length,Num,Datax) LOCAL T,Chksum,L,Pdata,Done,Type,J
2190   IF Timint>Maxtim OR Timint<Mintim THEN Timint=Mytime
2200   T=FNGetch
2210   WHILE T<>Soh : T=FNGetch : IF T<0 RETURN False
2220   WEND 
2230   WHILE J<4+L
2240     T=FNGetch : IF T<0 RETURN -9 ELSE IF T=Soh J=-1
2250     IF J=0 Chksum=T : L=T-35 : POKE Length,L,SWAP%(L)
2260     IF J=1 Chksum=Chksum+T : POKE Num,T-32,0
2270     IF J=2 Chksum=Chksum+T : Type=T : Pp=PEEK2(Datax+2) : POKE Datax+4,0,0
2280     IF J>2 AND J-3<L Chksum=Chksum+T : POKE Pp,T : Pp=Pp+1
2290     J=J+1
2300   WEND 
2310   Chksum=(Chksum+(Chksum AND 192)/64) AND 63
2320   IF Chksum<>T-32 RETURN False
2330   POKE Datax+4,L,0
2340   RETURN Type
2350 FNEND 
2360 ! *
2370 ! 
2380 ! S{nd huvudrutin
2390 ! 
2400 DEF FNSendsw
2410   State=ASCII('S') : N=0 : Numtry=0
2420   WHILE True
2430     IF INSTR(1,'DFZSBCA',CHR$(State))=0 RETURN False
2440     IF State=68 State=FNSdata
2450     IF State=70 State=FNSfile
2460     IF State=90 State=FNSeof
2470     IF State=83 State=FNSinit
2480     IF State=66 State=FNSbreak
2490     IF State=67 RETURN True
2500     IF State=65 RETURN False
2510   WEND 
2520 FNEND 
2530 ! *
2540 ! 
2550 ! S{ndningsinitiering
2560 ! 
2570 DEF FNSinit LOCAL Num,Length,Type
2580   IF Numtry>Maxtry RETURN ASCII('A')
2590   Numtry=Numtry+1
2600   Packet$=FNSpar$
2610   H=FNSpack(ASCII('S'),N,6,Packet$)
2620   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2630   IF Type=ASCII('N') RETURN State
2640   IF Type=0 RETURN State
2650   IF Type<>ASCII('Y') RETURN ASCII('A')
2660   IF N<>Num RETURN State
2670   H=FNRpar(Recpkt$)
2680   IF Eol=0 Eol=13
2690   IF Quote=0 Quote=ASCII('#')
2700   Numtry=0 : N=(N+1) AND 63
2710   OPEN Filnam$ AS FILE 2
2720   RETURN ASCII('F')
2730 FNEND 
2740 ! *
2750 ! 
2760 ! S{nd file header
2770 ! 
2780 DEF FNSfile LOCAL Num,Length,H,Type
2790   IF Numtry>Maxtry RETURN ASCII('A')
2800   Numtry=Numtry+1
2810   Length=LEN(Filnam$) : H=FNSpack(ASCII('F'),N,Length,Filnam$)
2820   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2830   IF Type=0 RETURN State
2840   IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A')
2850   IF Type=ASCII('N') Num=((Num-1) AND 63)
2860   IF N<>Num RETURN State
2870   Numtry=0 : N=(N+1) AND 63 : Packet$=FNBufill$ : Size=LEN(Packet$)
2880   RETURN ASCII('D')
2890 FNEND 
2900 ! *
2910 ! 
2920 ! S{nd datafil
2930 ! 
2940 DEF FNSdata LOCAL Num,Length,H
2950   IF Numtry>Maxtry RETURN ASCII('A')
2960   Numtry=Numtry+1
2970   H=FNSpack(ASCII('D'),N,Size,Packet$)
2980   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2990   IF Type=0 RETURN State
3000   IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A')
3010   IF Type=ASCII('N') Num=((Num-1) AND 63)
3020   IF N<>Num RETURN State
3030   Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : Pktnum=Pktnum+1
3040   Packet$=FNBufill$ : Size=LEN(Packet$) : IF Size=0 RETURN ASCII('Z')
3050   RETURN ASCII('D')
3060 FNEND 
3070 ! *
3080 ! 
3090 ! S{nd EOF
3100 ! 
3110 DEF FNSeof LOCAL Num,Length,H
3120   IF Numtry>Maxtry RETURN ASCII('A')
3130   Numtry=Numtry+1
3140   H=FNSpack(ASCII('Z'),N,0,'')
3150   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
3160   IF Type=0 RETURN State
3170   IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A')
3180   IF Type=ASCII('N') Num=((Num-1) AND 63)
3190   IF N<>Num RETURN State
3200   Numtry=0 : N=(N+1) AND 63
3210   CLOSE 2
3220   Ifile=Ifile+1 : IF Ifile>Nfiles RETURN ASCII('B')
3230   Filnam$=File$(Ifile)
3240   OPEN Filnam$ AS FILE 2
3250   RETURN ASCII('F')
3260 FNEND 
3270 ! *
3280 ! 
3290 ! S{nd break  (EOT)
3300 ! 
3310 DEF FNSbreak LOCAL Num,Length,H,Type
3320   IF Numtry>Maxtry RETURN ASCII('A')
3330   Numtry=Numtry+1
3340   H=FNSpack(ASCII('B'),N,0,'')
3350   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
3360   IF Type=0 RETURN State
3370   IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A')
3380   IF Type=ASCII('N') Num=((Num-1) AND 63)
3390   IF N<>Num RETURN State
3400   Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('C')
3410 FNEND 
3420 ! *
3430 ! 
3440 ! State switchning f|r mottag filer
3450 ! 
3460 DEF FNRecsw
3470   Nfiles=FNFiles(1) : File=0
3480   State=ASCII('R') : N=0 : Numtry=0
3490   WHILE True
3500     IF State=ASCII('D') State=FNRdata
3510     IF State=ASCII('F') State=FNRfile
3520     IF State=ASCII('R') State=FNRinit
3530     IF State=ASCII('C') RETURN True
3540     IF State=ASCII('A') RETURN False
3550   WEND 
3560 FNEND 
3570 ! *
3580 ! 
3590 ! Mottagnings initiering
3600 ! 
3610 DEF FNRinit LOCAL Num,Length,Type
3620   IF Numtry>Maxtry RETURN ASCII('A')
3630   Numtry=Numtry+1
3640   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
3650   IF Type=False RETURN State
3660   IF Type<>ASCII('S') RETURN ASCII('A')
3670   H=FNRpar(Packet$) : Packet$=FNSpar$
3680   H=FNSpack(ASCII('Y'),N,6,Packet$) : Oldtry=Numtry
3690   Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('F')
3700 FNEND 
3710 ! *
3720 ! 
3730 ! Tag emot file header
3740 ! 
3750 DEF FNRfile LOCAL Lengh,Num,Type,H,Filename$=20
3760   IF Numtry>Maxtry RETURN ASCII('A')
3770   Numtry=Numtry+1
3780   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
3790   IF Type=0 RETURN State
3800   ! 
3810   WHILE Type=ASCII('S')
3820     Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
3830     IF Num<>((N-1) AND 63) RETURN ASCII('A')
3840     Packet$=FNSpar$ : H=FNSpack(ASCII('Y'),Num,6,Packet$)
3850     Numtry=0 : RETURN State
3860   WEND 
3870   ! 
3880   ! End-of-file
3890   ! 
3900   WHILE Type=ASCII('Z')
3910     Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
3920     IF Num<>((N-1) AND 63) RETURN ASCII('A')
3930     H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State
3940   WEND 
3950   ! 
3960   ! File header
3970   ! 
3980   WHILE Type=ASCII('F')
3990     File=File+1
4000     IF Num<>N RETURN ('A')
4010     IF FNGetfil(Packet$)=False RETURN ASCII('A')
4020     IF File<=Nfiles THEN Filename$=File$(File) ELSE Filename$=Packet$
4030     H=FNSpack(ASCII('Y'),N,0,'')
4040     Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D')
4050   WEND 
4060   ! 
4070   ! End-of-Transmission
4080   ! 
4090   WHILE Type=ASCII('B')
4100     IF Num<>N RETURN ('A')
4110     H=FNSpack(ASCII('Y'),N,0,'') : RETURN ASCII('C')
4120   WEND 
4130   ! 
4140   RETURN ASCII('A')
4150 FNEND 
4160 ! *
4170 ! 
4180 ! Tag emot data
4190 ! 
4200 DEF FNRdata LOCAL Num,Length,H,Type
4210   IF Numtry>Maxtry RETURN ASCII('A')
4220   Numtry=Numtry+1
4230   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
4240   IF Type=0 RETURN State
4250   ! 
4260   ! Data
4270   ! 
4280   WHILE Type=ASCII('D')
4290     WHILE Num<>N
4300       Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
4310       IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,6,Packet$) : Numtry=0 : RETURN State
4320       RETURN ASCII('A')
4330     WEND 
4340     H=FNBufemp(VARPTR(Packet$),Fd,LEN(Packet$)) : H=FNSpack(ASCII('Y'),N,0,'')
4350     Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D')
4360   WEND 
4370   ! 
4380   ! File header
4390   ! 
4400   WHILE Type=ASCII('F')
4410     Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
4420     IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State
4430     RETURN ASCII('A')
4440   WEND 
4450   ! 
4460   ! End-of-file
4470   ! 
4480   WHILE Type=ASCII('Z')
4490     IF Num<>N RETURN ASCII('A')
4500     H=FNSpack(ASCII('Y'),N,0,'') : CLOSE Fd : N=(N+1) AND 63 : RETURN ASCII('F')
4510     H=FNSpack(ASCII('N'),N,0,'')
4520     RETURN State
4530   WEND 
4540   ! 
4550   RETURN ASCII('A')
4560 FNEND 
4570 ! *
4580 ! 
4590 ! L{s tecken
4600 ! 
4610 DEF FNInchr LOCAL A,L
4620   A=PEEK(65507)
4630   POKE Vbuf,A : POKE 65506,0 : L=1+Vbuf
4640   FOR Ti=0 TO 1000
4650     IF PEEK(65506) POKE L,PEEK(65507) : POKE 65506,0 : L=L+1 : Ti=0
4660   NEXT Ti 
4670   POKE Vrot,L-Vbuf : POKE Vrot+4,L-Vbuf
4680   RETURN 0
4690 FNEND 
4700 ! *
4710 ! 
4720 ! Inmatning av filnamn
4730 ! 
4740 DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,I
4750   Nfile=0 : ; CUR(12,0) 'Specifiera filnamn                  '
4760   ; SPACE$(162)
4770   ; CUR(13,0); : INPUT LINE Aa$ : Aa$=LEFT$(Aa$,LEN(Aa$)-2)
4780   IF Aa$='' RETURN 0
4790   Nfile=Nfile+1
4800   K=INSTR(1,Aa$,',')
4810   WHILE K
4820     File$(Nfile)=LEFT$(Aa$,K-1) : Aa$=RIGHT$(Aa$,K+1)
4830     Nfile=Nfile+1
4840     K=INSTR(1,Aa$,',')
4850   WEND 
4860   File$(Nfile)=Aa$
4870   IF Rsw RETURN Nfile
4880   ON ERROR GOTO 4910
4890   I=1 : WHILE I<=Nfile : OPEN File$(I) AS FILE 2 : CLOSE 2 : I=I+1 : WEND 
4900   ON ERROR GOTO : RETURN Nfile
4910   RESUME 4920
4920   ON ERROR GOTO : RETURN -1
4930 FNEND 
4940 ! *
4950 ! 
4960 ! L{s ett tecken
4970 ! 
4980 DEF FNGetch LOCAL Sec,A,Dummy$=1
4990   IF LEN(V24buf$)<>0 A=ASCII(V24buf$) : V24buf$=RIGHT$(V24buf$,2) : RETURN A
5000   Sec=PEEK(65524)+Timint+1 : IF Sec>59 Sec=Sec-60
5010   WHILE Sec<>PEEK(65524)
5020     IF PEEK(65506) Z=FNInchr : A=ASCII(V24buf$) : V24buf$=RIGHT$(V24buf$,2) : RETURN A
5030   WEND 
5040   RETURN -1
5050 FNEND 
5060 ! *
5070 ! 
5080 ! Skriv ut meny - l{s in menyval
5090 ! 
5100 DEF FNHead LOCAL F,F$=1,Baud
5110   ON ERROR GOTO 5230
5120   ; CHR$(12)
5130   ; 'REMOTE KERMIT fil|verf|ring'
5140   ; 
5150   ; 'M   Mottag filer'
5160   ; 'S   S{nd filer'
5170   ; 
5180   ; 'A   Avsluta KERMIT'
5190   WHILE F=0
5200     ; CUR(11,0) 'V{lj funktion: '; : GET F$
5210     F$=CHR$(ASCII(F$) AND 223) : ; F$
5220     F=INSTR(1,' MSA',F$) : IF F RETURN F
5230   WEND 
5240 FNEND 
5250 ! *
5260 ! 
5270 ! Skapa en ny fil
5280 ! 
5290 DEF FNGetfil(Aa$) LOCAL A$=30
5300   A$=Aa$ : IF File<=Nfiles A$=File$(File)
5310   ON ERROR GOTO 5320 : PREPARE A$ AS FILE Fd : Krad=0 : RETURN True
5320   RETURN False
5330 FNEND 
5340 ! *
5350 ! 
5360 ! Quote ett tecken
5370 ! 
5380 DEF FNQ$(T)
5390   IF T=Myquote RETURN CHR$(Myquote,Myquote)
5400   RETURN CHR$(Myquote,T XOR 64)
5410 FNEND 
5420 ! *
5430 ! 
5440 ! Tids f|rdr|jning
5450 ! 
5460 DEF FNDelay LOCAL X.
5470   X.=1. : WHILE X.<1500. : X.=X.+1. : WEND 
5480   RETURN 0
5490 FNEND 
5500 ! *
5510 ! 
5520 ! Huvudprogram
5530 ! 
5540 Z=FNKermit