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