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 ; ''; : 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 ; ''; : 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 TSpsiz-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 TimintSoh : 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-3T-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