home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
maibasicfour.tar.gz
/
maibasicfour.tar
/
mbfshl.bas
< prev
Wrap
BASIC Source File
|
1988-08-16
|
39KB
|
766 lines
0100 REM"-------------------------------------------------
0110 REM" * K E R M I T * File Transfer Utility MBFSHL.BAS
0120 REM" ===================
0130 REM"* BASIC-BB86 Version for MAI Basic Four MPx Series 7000,8000,9000
0140 REM"* E. Wastrodowski, Sphere Holdings Limited 88-04-01 V 1.0
0150 REM"* The following program implements the Kermit file transfer
0151 REM"* protocol. The protocol was designed at the Columbia University
0152 REM"* Center for Computing Activities (CUCCA) in 1981-82 by Bill
0153 REM"* Catchings and Frank da Cruz.
0154 REM"* This particular implementation was developed at Sphere Holdings
0155 REM"* Limited to run on the MAI Basic Four MPx series of minicomputers.
0156 REM"* It implements the protocol as found in the KERMIT Protocol Manual
0157 REM"* except for user interaction--a menu is used rather than commands.
0158 REM"* Version 1.0 is designed to run as a 'remote' Kermit from the
0160 REM"* listing of LUXKER.BAS provided on TAPE C by Columbia University.
0170 REM"* It can be run in 'local' mode using the connect option.
0180 REM"* It sends files as ASCII delimited with quotes, and commas for
0190 REM"* field separators.
0200 REM"*
0220 REM"* Debug printout on LP
0230 REM"*
0240 REM"* Basic dialect similar to Microsoft Basic
0260 REM"* -------------------------------------------------
0280 MAXPACK=80,SOH=1,BRKCHR=192,MAXTRY=5000,MYQUOTE=ASCII("#"),MYPAD=0,MYCHA
0280:R=128,MYEOL=13,MYTIME=10;REM or is it 50
0290 MAXTIM=20,MINTIM=2,TRUE=-1,FALSE=0,FD=4,REMFD=1,SP=32,DEL=127,BRF=7,CTRC
0290:=193,EOL=13
0294 START0$="",END0$=""
0295 REM Baud rate cannot be set on MAI B4 hosts
0296 MYQUOTE$=CHAR(MYQUOTE)
0297 CLOSE(REMFD);OPEN(REMFD)"T*";PRINT(REMFD)'BO';HOST=TRUE;REM "In case the
0297:y don't go into connect
0300 DIM RECPKT$(80),PACKET$(80),INBUFF$(160),Q$(100),SP$(25),VERSION$(12)
0320 VERSION$="Version 1.0"
0340 IF TRUE<>TRUE GOTO 600 ELSE GOSUB 4080;ON F-1 GOTO 350,360,410,510,570;R
0340:EM was WHILE True ON FNHead
0350 GOSUB 3550;GOTO 330;REM was H=FNConnect; GOTO 330; ! Dumb terminal until
0350: PF1
0360 REM-----------Receive files from remote--------------
0370 GOSUB 2700; IF RETURN0<>FALSE PRINT @(0,15),"ok",SP$ ELSE PRINT @(0,15),
0370:"Received failed ",SP$;REM "was if FNRecsw..
0380 IF DEBUG0=TRUE IF RETURN0<>FALSE PRINT(17)"OK",SP$ ELSE PRINT (17)"Recei
0380:ved failed ",SP$;REM "was IF FNRecsw....
0390 INPUT "<Push any key to continue> ",'CI',*
0400 GOTO 590
0410 REM"------------Send file to remote------------
0420 RSW=0;GOSUB 3820;IF NFILE<=0 GOTO 590;REM was NFILES=FNFiles(0);IF NFILE
0420:S<=0 GOTO 590
0425 IF HOST=TRUE PRINT @(0,15),"Now return to local task to receive files ",
0425:IFILE$,
0430 IFILE=1
0434 IF POS(","=IFILE$)=0 IFILE$=IFILE$+","
0435 K=POS(","=IFILE$)
0440 FILNAM$=IFILE$(1,K-1),IFILE$=IFILE$(K+1)
0450 GOSUB 1560;IF SENDSW=TRUE PRINT @(0,15),"OK",SP$ ELSE PRINT @(0,15)," Se
0450:nd failed",SP$;REM was IF FNSendsw ; CUR(15,0) 'OK' Sp$; ELSE ; CUR(15,0
0450:) ' Send failed' Sp$
0460 INPUT "<Push any key to continue> ",'CI',*
0470 GOTO 590
0500 REM"-------- Set debug mode on/off each time ----------
0510 IF DEBUG0=TRUE DEBUG0=FALSE;CLOSE(17) ELSE DEBUG0=TRUE;OPEN(17)"LP";REM
0510:OPEN "pr:" AS FILE 17
0520 IF DEBUG0=TRUE PRINT @(0,12),"D e b u g m o d e" ELSE PRINT @(0,12),"N
0520:o t d e b u g m o d e"
0530 IF DEBUG0=TRUE PRINT (17)"D e b u g m o d e"
0540 GOSUB 4590;REM H=FN(DELAY)
0550 GOTO 590
0560 REM"--------End of Kermit Session --------------
0570 PRINT @(15,20),"E N D of K E R M I T session"
0580 INPUT "CR to do again, CTL IV to quit ",'CI',*;IF CTL>1 RELEASE
0590 GOTO 340;REM WEND
0600 STOP
0610 REM---------------------------------------------
0620 REM* Kermit subroutines, standard from UNIX
0630 REM---------------------------------------------
0640 REM* FNSpar$ = spar(data)
0650 REM send my parameters to other end
0660 REM---------------------------------------------
0665 REM"DEF FNSpar$=chr$(Maxpack+32,Mytime+32,Mypad+32,Mypchar XOR 64,Myeol+
0665:32,Myquote)
0670 DEF FNSPAR$(Z$)=CHAR$(MAXPACK+32)+CHAR(MYTIME+32)+CHAR(MYPAD+32)+XOR(CHA
0670:R(MYPCHAR),CHAR(64))+CHAR(MYEOL+32)+CHAR(MYQUOTE)
0680 REM-------------------------------------------
0690 REM* FNRpar = rpar from 1890,2930
0700 REM* Unpack data from other end
0710 REM------------------------------------------
0720 REM DEF FNRpar(S$) LOCAL Pp,Ss$=6
0730 SPSIZ=ASCII(S$)-32,TIMINT=ASCII(S$(2))-32
0740 PAD=ASCII(S$(3))-32,PADCHAR=ASCII(S$(4)),PADCHAR$=XOR(S$(4,1),CHAR(64)),
0740:PADCHAR=ASC(PADCHAR$)
0750 EOL=ASCII(S$(5))-32,QUOTE=ASCII(S$(6))
0760 RETURN
0765 MAXPACK=SPSIZ,MYTIME=TIMINT,MYPAD=PAD,MYPCHAR=PADCHAR,MYEOL=EOL,MYQUOTE=
0765:QUOTE
0766 C$=FNSPAR$(Z$)+"&1~,?"
0767 ESCAPE
0770 REM "FNEND
0780 REM-----------------------
0790 REM"* FNBufemp (buf,fd,len)
0800 REM"* unpack a packet to file
0810 REM"* Buf Packet bufer pointer, VARPTR (BUF$)
0820 REM"* fd file number
0830 REM"*lgd Packet Length (redundant, only for compatiblity)
0840 REM"________________________
0850 REM DEF FNBufemp(Buf,Fd,Lgd) LOCAL I,T,Pp
0860 I=1,PP=BUF,DUMMY$="";FOR PP=1 TO LEN(BUF$)
0865 LGD=LEN(BUF$)
0869 REM"was 870 WHILE I<=Lgd : T=PEEK(Pp) : IF T=Myquote GOSUB 900 ELSE ; #F
0869:d CHR$(T); : Krad=Krad+1
0870 IF I>LGD ESCAPE ELSE T$=BUF$(PP,1); IF T$=MYQUOTE$ GOSUB 900 ELSE IF T$=
0870:CHAR(EOL) OR T$=CHAR(10) WRITERECORD(FD)PEEK$;PEEK$="" ELSE PEEK$=PEEK$+
0870:T$;KRAD=KRAD+1
0880 I=I+1;NEXT PP;REM WEND
0881 RETURN; REM remember to empty peek$ with the last eof
0885 WRITERECORD(FD)PEEK$
0890 RETURN;REM RETURN Lgd
0900 REM Unquote function
0910 I=I+1,PP=PP+1,T$=BUF$(PP,1)
0920 IF T$=MYQUOTE$ PEEK$=PEEK$+T$;KRAD=KRAD+1;RETURN;REM ## = # was IF T=Myq
0920:uote ; #Fd CHR$(T); : Krad=Krad+1 : RETURN ! ## = #
0930 T$=XOR(T$,CHAR(64));IF ASCII(T$)=MYEOL KRAD=0;REM End-ofline was T=T XO
0930:R 64 : IF T=Myeol Krad=0 ! End-of-line
0940 IF ASCII(T$)=9 PEEK$=PEEK$+SP$(8*((KRAD+8)/8)-KRAD);KRAD=8*((KRAD+8)/8);
0940:RETURN;REM HT--was IF T=9 : #Fd SPACE$(8*((Krad+8)/8)-Krad); : Krad=8*(K
0940:rad+8)/8) : RETURN ! HT horizontal tab
0950 PEEK$=PEEK$+T$; RETURN
0960 REM FNEND
0970 REM--------------------------
0980 REM * BUF$=Fnbufill$
0990 REM* Fill buffer, return size
1000 REM"------------------------------------
1005 REM From 2080,2250--get data from file I guess
1010 REM DEF FNBufill$ LOCAL B$=90,I,T
1020 B$="";REM B$=''
1030 IF TRUE=0 GOTO 1100; REM was WHILE True
1035 IF INBUFF$>"" GOTO 1050;REM left overs from last send
1036 IF IFILE=1 IF END0$>"" K2$=KEY(2,END=1090); IF K2$(1,LEN(END0$))>END0$ G
1036:OTO 1090
1040 READRECORD(2,END=1090)INBUFF$;IF LEN(INBUFF$)=0 OR POS($00$<INBUFF$)=0 G
1040:OTO 1090;REM was IF LEN(Inbuff$)=0 ON ERROR GOTO 1090 : INPUT LINE #2,In
1040:buff$
1042 Y=POS($8A$=INBUFF$);IF Y>0 INBUFF$=INBUFF$(1,Y-1)+""","""+INBUFF$(Y+1);
1042:GOTO 1042
1044 Y=1
1045 X=POS($00$=INBUFF$(Y));IF X>0 Y=Y+X
1047 IF POS($00$<INBUFF$(Y))=0 INBUFF$=INBUFF$(1,Y-1) ELSE Y=Y+POS($00$<INBUF
1047:F$(Y)); GOTO 1045
1048 IF INBUFF$(LEN(INBUFF$))=$00$ INBUFF$=INBUFF$(1,LEN(INBUFF$)-1) FI; INBU
1048:FF$=""""+INBUFF$(1,LEN(INBUFF$)-1)
1049 INBUFF$=INBUFF$+CHAR(13)+CHAR(10); REM "add CR + LF to end of the data
1050 T=ASCII(INBUFF$(1,1));REM was =ASCII(AND(INBUFF$(1,1),CHAR(127)));REM T=
1050:ASCII(Inbuff$) AND 127
1060 IF T<SP OR T=MYQUOTE OR T=DEL IF LEN(B$)>SPSIZ-9 RETURN ELSE GOSUB 4400;
1060:B$=B$+RETURN0$ FI ELSE B$=B$+CHAR$(T);REM RETURN B$
1070 INBUFF$=INBUFF$(2); IF LEN(B$)>=SPSIZ-8 RETURN;REM was Inbuff$=RIGHT$(In
1070:buff$,2) : if LEN(B$)>=Ssiz-8 RETURN B$
1080 GOTO 1030; REM "WEND
1090 REM "RESUME
1100 RETURN;REM return b$
1110 REM"FNEND
1120 REM-------------------------
1130 REM* FNSpack(type,num,length,data$) from 1820,2030,2370,2610,2940,3080,
1130: 3130,3210,3250,3390
1140 REM* Send packet to other end - call by name!
1150 REM--------------------------
1160 REM DEF FNSpack(Type,Num,Length,Data$) LOCAL Chksum,Buffer$=90,I
1170 DIM BUFFER$(PAD,PADCHAR$);BUFFER$=BUFFER$+CHAR(SOH)+CHAR(LENGTH+35)+CHAR
1170:(NUM0+32)+CHAR(TYPE)+DATA$
1175 GOTO 1197; REM"I don't think the proper check sum is calculated original
1175:ly? in Protocol manual section 6.1 pp23,24 it appears to include the toc
1175:har() function in the calculation of the arithmetic sum, which means tha
1175:t the +32 is included! on pp 40 it says that the "/" signifies integer
1175:division
1176 REM"amazing see 1390- was this program inconsisent or what?
1180 CHKSUM=LENGTH+NUM0+TYPE
1185 I=1
1190 IF I<=LENGTH CHKSUM=CHKSUM+ASCII(DATA$(I));I=I+1; GOTO 1190;REM was WHI
1190:LE I<=Length : Chksum=Chksum+ASCII(MID$(Data$,I,1)) : I=I+1 : WEND
1195 X=INT(CHKSUM/256);E1$=BIN(CHKSUM,X+1);DIM Y$(X+1,$C0$);E1$=AND(E1$,Y$),E
1195:1=INT(DEC(E1$)/64)+CHKSUM,X=INT(CHKSUM/256),E2$=BIN(CHKSUM,X+1);DIM Y$(X
1195:+1,$3F$);E2$=AND(E2$,Y$),CHKSUM=DEC(E2$)
1196 ESCAPE
1197 CHKSUM=0; FOR I=2+PAD TO LEN(BUFFER$); CHKSUM=CHKSUM+ASCII(BUFFER$(I));N
1197:EXT I
1198 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
1198:1,64)
1200 REM" Chksum=(Chksum+(Chksum AND 192)/64) AND 63
1210 BUFFER$=BUFFER$+CHAR(CHKSUM+32)+CHAR(EOL)+CHAR(10);REM was Buffer$=Buffe
1210:r$+CHR$(Chksum+32,Eol,10),CHR$(10)=$8A$=newline?
1220 PRINT (REMFD,TBL=9950)BUFFER$; IF HOST=FALSE PRINT @(0,15),"Send packet
1220:",N," ",CHAR(TYPE)," ",NUMTRY," ",
1230 IF DEBUG0=TRUE PRINT (17)"Send packet ",N," ",CHAR(TYPE)," ",NUMTRY
1240 IF DEBUG0=TRUE PRINT(17)BUFFER$
1250 H=LEN(BUFFER$); RETURN; REM RETURN LEN(Buffer$)
1260 REM FNEND
1270 REM-------------------------------------
1280 REM * FNRpack(&len,&num,&data$) - return type--from 1830,2040,2200,2390,
1280:2620,2900,3030,3340
1290 REM* Receive packet - store into data$ unpdate varoot
1300 REM* Store len, num via pointers, return type
1310 REM------------------------------------
1320 REM DEF FNRpack(Length,Num,Datax) LOCAL T,Chksum,L,Pdata,Done,Type
1330 REM gosub 4470 ! RETURN FNQrpack(Length,Num,Datax)
1340 IF TIMINT>MAXTIM OR TIMINT<MINTIM THEN TIMINT=MYTIME
1345 T=0,TYPE=FALSE
1346 GOSUB 4000;REM"GO GET A PACKET FROM REMFD
1347 IF T<0 RETURN0=FALSE;GOTO 1345;REM was RETURN
1348 IF DUMMY$="" GOTO 1345 ELSE FOR PP=1 TO LEN(DUMMY$); T=ASCII(DUMMY$(PP,1
1348:))
1349 REM"find Soh in the buffer
1350 IF T=SOH EXITTO 1360 ELSE NEXT PP;RETURN0=FALSE;IF HOST=FALSE INPUT "ABO
1350:UT TO ABORT @1350-NO SOH FOUND! ",'CI','RB',* FI;RETURN ;REM was T=0 : W
1350:HILE T><Soh: T=FNGetch : IF T<0 RETURN False
1360 REM WEND : Done=False
1370 REM" was "WHILE Done=False why i don't know. yes i do, it finds the last
1370: packet in the input buffer and uses that one, ignoring all the rest!
1375 PP=PP+1
1380 T=ASCII(DUMMY$(PP,1)); IF T<0 RETURN0=FALSE;RETURN ELSE IF T=SOH GOTO 14
1380:60;REM was T=FNGetch ...
1388 IF DEBUG0=TRUE X$="LENGTH+32";PRINT(17)IOL=7717
1389 REM"amazing..here we start the chksum including the +35 on the length
1390 CHKSUM=T;L=T-35;LENGTH=L,PP=PP+1,T=ASCII(DUMMY$(PP,1)); IF T<0 RETURN0=F
1390:ALSE;IF HOST=FALSE INPUT"ABOUT TO ABORT @1390 ",'CI','RB',* FI;RETURN EL
1390:SE IF T=SOH GOTO 1460 REM was Chksum=Chksum+T : L=T-35 : POKE Length,L,S
1390:WAP%(L) : T=FNGetch ...
1398 IF DEBUG0=TRUE X$="SEQ.NUMBER+32";PRINT(17)IOL=7717
1399 REM" and now the sequence number field--also a +32 here
1400 CHKSUM=CHKSUM+T,NUM0=T-32,PP=PP+1,T=ASCII(DUMMY$(PP,1));IF T<0 X=1400;GO
1400:TO 1551 ELSE IF T=SOH GOTO 1460;REM was Chksum=Chksum+T : POKE Num,T-32,
1400:0 : T=FNGetch ...
1408 IF DEBUG0=TRUE X$="TYPE FIELD";PRINT(17)IOL=7717
1409 REM" and now the type field--no +32 here tho
1410 CHKSUM=CHKSUM+T,TYPE=T,DATA$="",DATA$=DUMMY$(PP+1,L);REM was ...Pp=PEEK2
1410:(Datax+2) : POKE Datax+4,0,0 ! VAROOT=maxsiz,pointer,len
1415 I=0
1420 IF I>=L GOTO 1431 ELSE PP=PP+1,T=ASCII(DUMMY$(PP,1));IF T<0 X=1420;GOTO
1420:1551 ELSE IF T=SOH GOTO 1460; REM was I=0 : WHILE I<L : T=FNGetch ...
1428 IF DEBUG0=TRUE X$="DATA ";PRINT (17)IOL=7717
1430 CHKSUM=CHKSUM+T,I=I+1; GOTO 1420; REM was .. POKE Pp,T : Pp=Pp+1 : I=I+1
1430: : WEND
1439 REM"and now for the check character at the end, also including the +32
1440 PP=PP+1,T=ASCII(DUMMY$(PP));IF T<0 X=1440;GOTO 1551 ELSE IF T=SOH GOTO 1
1440:460;REM was T=FNGetch :..
1448 IF DEBUG0=TRUE X$="CHECK ";PRINT (17)IOL=7717
1450 DONE=TRUE
1460 IF DONE<>TRUE GOTO 1370; REM WEND
1464 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
1464:1,64); GOTO 1470
1465 E1$=AND(CHAR(CHKSUM),CHAR(192)),E1=ASCII(E1$)/64+CHKSUM,E2$=AND(CHAR(E1)
1465:,CHAR(63)),CHKSUM=ASCII(E2$); REM this one doesn't work! error 41
1468 ESCAPE
1469 E1=E1+CHKSUM,CHKSUM=MOD(E1,64);REM" Assuming that the AND 192 is a modul
1469:o -- see 2080,2440
1470 REM "Chksum=(Chksum+(Chksum AND 192)/64) AND 63--the char of 192 yields
1470:$40$ and the chr(192) is $C0$--kodak says to use $C0$--the char of 64 yi
1470:elds $C0$, the chr(64) is $40$--kodak says to use $40$--so the 192 and t
1470:he 64 are interrelated in high/low order bits! What is integer division
1470: by 64?--the anding function AND($01$,$10$) is $00$..so a 1 AND 0 is 0
1480 IF CHKSUM><T-32 IF DEBUG0=TRUE X$="NOT MATCHED";PRINT(17)IOL=7717 ELSE R
1480:ETURN0=FALSE;RETURN
1490 IF HOST=FALSE PRINT @(40,15)," Receive packet ",NUM0," ",N," ",CHAR(TYPE
1490:)," ",L," ",;REM was PEEK2(Num)...
1500 IF DEBUG0=TRUE PRINT(17)" Receive packet ",NUM0," ",N," ",CHAR(TYPE)," L
1500:en=",L;REM was PEEK2(Num)
1510 IF DEBUG0=FALSE RETURN0=TYPE;RETURN; REM was POKE Datax+4,L,0 : IF NOT D
1510:ebug RETURN type
1520 REM"POKE VAROOT(Q$)+2,PEEK(Datax+2),PEEK(Datax+3),PEEK(Datax+4),PEEK(Dat
1520:ax+5)
1530 PRINT(17)DATA$;REM was ; #17 CHR$(L+35,PEEK(Num)+32)+Q$+CHR$(T+32)
1540 RETURN0=TYPE
1550 RETURN;REM"FNEND
1551 IF HOST=FALSE PRINT "ABORT FROM ",X," ",;INPUT'RB','CI',*
1555 RETURN0=FALSE;RETURN
1560 REM------------------------------------------ from 450
1570 REM * FNSendsw Send Supervisor
1580 REM-----------------------------------------
1590 REM"DEF FNSendsw --- function def return value in sendsw
1595 STATE=ASCII("S"),N=0,NUMTRY=0
1600 IF TRUE=0 GOTO 1701;REM was WHILE True
1609 REM"ON INSTR(1,'DFZSBCA',CHR$(State))+1 GOTO 1620,1630,1640,1650,1660,16
1609:70,1680,1690
1610 ON POS(CHAR(STATE)="DFZSBCA") GOTO 1620,1630,1640,1650,1660,1670,1680,16
1610:90
1611 REM D F Z S B C A
1620 SENDSW=FALSE; GOTO 1710;REM "was RETURN false ! unknown state - fail
1630 GOSUB 2140;GOTO 1700;REM was STATE=FNSdata ; GOTO 1600 ! "Data-Send sta
1630:te^^
1640 GOSUB 1960;GOTO 1700 REM was STATE=FNSfile; GOTO 1600 ! REM File-Send st
1640:ate
1650 GOSUB 2300; GOTO 1700;REM was State=FNSeof ;GOTO 1600;REM"End-of-file
1660 GOSUB 1720;GOTO 1700;REM"State=FNSinit gosub to SEND-INIT @ 1720 output
1660:into state variable via RETURN ASCII('A'),etc!
1670 GOSUB 2540;GOTO 1700;REM was State=FNSbreak; GOTO 1610;REM"Break-send
1680 SENDSW=TRUE;GOTO 1710 REM"was RETURN True ! Complete
1690 SENDSW=FALSE;GOTO 1710 REM"was RETURN False ! Abort
1700 GOTO 1600;REM"WEND
1710 RETURN;REM "FNEND
1720 REM----------------------------------
1730 REM fnsinit - Send initiate from 1660
1740 REM Send my paramters, get other side's back
1750 REM---------------------------------------
1760 REM DEF FNSinit LOCAL Num,Length,Type
1770 IF DEBUG0=TRUE PRINT @(0,14),"Sinit
1770: "
1780 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many retries, give up
1790 NUMTRY=NUMTRY+1
1800 PACKET$=FNSPAR$(Z$)+"&1~,?"; REM was Packet$=FNSpar$
1810 IF DEBUG0=TRUE PRINT (17)"Packet # ",N
1820 TYPE=ASCII("S"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 11030; RE
1820:M"H=FNSpack(ASCII('S'),N,6,Packet$) ! Send an S-packet
1830 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
1830:! What was the reply?
1840 IF TYPE=ASCII("N") RETURN;REM state ! Nak
1850 IF TYPE=0 RETURN;REM State ! Receive failure, stay in S
1860 IF TYPE><ASCII("Y") STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 1860-w
1860:rong packet type",'CI','RB',* FI;RETURN;REM Somthin bad - abort
1870 REM Type = 'Y'
1880 IF N<>NUM0 RETURN;REM State ! Wrong ACK stay S
1890 S$=DATA$;GOSUB 680;REM H=FNRpar(Recpkt$) ! Get other side's info
1900 IF EOL=0 EOL=13; REM "Check and set defaults
1910 IF QUOTE=0 QUOTE=ASCII("#");REM"conrol prefix quote
1920 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63)));IF DEBUG0=TRUE PRINT(17)"Openi
1920:ng ",FILNAM$;REM"Open file to be sent; was I+1?
1930 CLOSE(2); OPEN(2)FILNAM$;IF HOST=FALSE PRINT @(0,14),"Sending ",FILNAM$,
1930:" ";REM "OPEN Filnam$ AS FILE 2
1940 STATE=ASCII("F");RETURN;REM Switch state to F
1950 REM FNEND
1960 REM------------------------------------------------
1970 REM FNSfile Send file header from 1640
1980 REM-----------------------------------------------
1990 REM DEF FNSfile LOCAL Num,Length,H,Type
2000 IF DEBUG0=TRUE PRINT(17)" Sfile"
2010 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2010 too
2010:many tries ",'CI','RB',* FI;RETURN;REM"Too many Retries, give up
2020 NUMTRY=NUMTRY+1
2030 LENGTH=LEN(FILNAM$),DATA$=FILNAM$,NUM0=N,TYPE=ASCII("F");GOSUB 11030 ;RE
2030:M H=FNSpack(ASCII('F'),N,Length,Filnam$) ! Send an F Packet
2040 GOSUB 1280;REM type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2040:! What was the reply?
2049 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2110,2080,2070,2100
2050 ON POS(CHAR(TYPE)="NY"+CHAR(0)) GOTO 2110,2060,2070,2100
2051 REM N Y 0
2060 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State ! NAK
2060: Stay in state
2065 REM"else they are NAKing the next one, well by golly, we better send it
2070 IF N<>NUM0 RETURN;REM State ! Wrong ACK - stay in F state
2075 IF IFILE=1 IF START0$>"" READ(2,KEY=START0$,DOM=2076)
2080 NUMTRY=0,N=MOD(N+1,64);GOSUB 1000;PACKET$=B$,SIZE=LEN(PACKET$);IF SIZE=0
2080: STATE=ASCII("Z");RETURN
2090 STATE=ASCII("D");RETURN;REM"Switch state to D
2100 RETURN;REM"State ! Receive failure - stay in F
2110 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2110 wrong packet ",'CI','
2110:RB',* FI;RETURN;REM Something else, just abort
2120 RETURN;REM FNEND; i think it will have to be gosubs
2130 REM----------------------------------------
2140 REM FNSdata - Send Data File from 1630
2150 REM---------------------------------------
2160 REM DEF FNSdata LOCAL Num,Length,H
2170 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many tries - give up
2180 NUMTRY=NUMTRY+1
2190 TYPE=ASCII("D"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 1130;REM
2190:H=FNSpack(ASCII("D"),N,SIZE,PACKET$) ! Send a D packet
2200 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2200:! What was the reply?
2209 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2280,2220,2230,2270
2210 ON POS(CHAR$(TYPE)="NY"+CHAR(0)) GOTO 2280,2220,2230,2270
2211 REM N Y 0
2220 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63))); IF N><NUM0 RETURN;REM State ! un
2220:less Nak for next packet
2225 REM else they are NAKing the next one, well by golly, send it!
2230 IF N<>NUM0 RETURN;REM State ! Wrong ACK - stay in D state
2240 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),PKTNUM=PKTNUM+1;
2240:REM"Bump packet count
2250 GOSUB 1000;PACKET$=B$,SIZE=LEN(PACKET$); IF SIZE=0 STATE=ASCII("Z");RETU
2250:RN;REM PACKET$=FNBufill,size=LEN(packet$);if size=0 state=ascii("Z");ret
2250:urn:rem EOF
2260 STATE=ASCII("D");RETURN;REM Good data, stay in D
2270 RETURN;REM"State ! Receive failure
2280 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2280 Unknown reply ",'CI',
2280:'RB',* FI;RETURN;REM Unknown reply, Abort
2290 RETURN;REM FNEND; i think these will be gosubs
2300 REM-------------------------------------------------
2310 REM FNSeof - Send End-of-file from 1650
2320 REM-------------------------------------------------
2330 REM"DEF FNSeof LOCAL Num,Length,H - function definition in the original
2340 IF DEBUG0=TRUE PRINT (17)"Seof"
2350 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "ABOUT TO ABORT @2
2350:350 -Too many tries",'RB','CI',* FI;RETURN;REM Too many tries - give up
2360 NUMTRY=NUMTRY+1
2370 TYPE=ASCII("Z"),NUM0=N,LENGTH=0,DATA$="";GOSUB 11020;REM was H=FNSpack(A
2370:SCII("Z"),N,0,'') ! send a Z packet
2380 IF DEBUG0=TRUE PRINT (17)"Seof1"
2390 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2390:! Check reply
2399 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2520,2410,2420,2510
2400 ON POS(CHAR$(TYPE)="NY"+CHAR$(0)) GOTO 2520,2410,2420,2510
2401 REM N Y 0
2410 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State ! Nak
2410:, stay in state
2420 IF DEBUG0=TRUE PRINT(17)"SEOF2"
2430 IF N<>NUM0 RETURN;REM State ! if wrong ACK, hold out
2440 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63)));REM"reset try-counter and bump
2440: counter
2450 IF DEBUG0=TRUE PRINT(17)"Closing ",FILNAM$
2460 CLOSE(2); IF DEBUG0=TRUE PRINT(17)"OK, Getting next file"
2470 IFILE=IFILE+1;IF IFILE>NFILES STATE=ASCII("B");RETURN;REM"EOT - all done
2480 FILNAM$=IFILE$(IFILE);IF DEBUG0=TRUE PRINT(17)"New file is ",FILNAM$
2490 OPEN(2)FILNAM$;REM"OPEN Filnam$ AS FILE 2
2500 STATE=ASCII("F");RETURN;REM More files, switch to F
2510 PRINT "RECEIVE FAILURE @2510 ";RETURN;REM State ! Receive failure, stay
2510:in state Z
2520 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2520 did not reply properl
2520:y ",'CI','RB',* FI;RETURN;REM"Something else, Abort
2530 RETURN;REM FNEND i think these must be gosubs
2540 REM-------------------------------------------------
2550 REM FNSbreak - Send Break (EOT) from 1670
2560 REM------------------------------------------------
2570 REM DEF FNSbreak LOCAL Num,Length,H,Type -- function def stuff??
2580 IF DEBUG0=TRUE PRINT(17)"Sbreak"
2590 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2590-too
2590:many tries ",'RB','CI' FI;RETURN
2600 NUMTRY=NUMTRY+1
2610 TYPE=ASCII("B"),NUM0=N,LENGTH=0,DATA$="";GOSUB 11020;REM was H=FNSPACK(A
2610:SCII("B"),N,0,'') ! send a B packet
2620 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2629 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2680,2640,2650,2670
2630 ON POS(CHAR$(TYPE)="NY"+CHAR(0)) GOTO 2680,2640,2650,2670
2631 REM N Y 0
2640 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State
2650 IF N<>NUM0 RETURN;REM State ! if wrong ACK, fail
2660 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("C");RETURN;REM Sw
2660:itch State to Complete
2670 RETURN;REM State
2680 STATE=ASCII("A");IF HOST=FALSE PRINT"ABORT @2680 Wrong reply packet ",DU
2680:MMY$,;INPUT'RB','CI',* FI;RETURN
2690 RETURN;REM"FNEND probably a gosub in MAI B4 lingo!
2700 REM-------------------------------------------------
2710 REM FNRecsw - State table switcher for receive files
2720 REM-------------------------------------------------
2730 REM DEF FNRecsw -- function definition stuff set this up for a gosub in
2730: MAI B4 lingo
2740 RSW=1;GOSUB 3820;IFILE=0;REM was Nfiles=FNFiles(1) : FILE=0 ! Assign loc
2740:al file names if necessary
2745 IF HOST=TRUE PRINT @(0,15),"Now return to local task to send files",
2750 STATE=ASCII("R"),N=0,NUMTRY=0; REM WHILE True -- what does it mean?
2759 REM"ON INSTR(1,'DFRCA',CHR$(State)) GOTO 2770,2780,2790,2800,2810
2760 ON POS(CHAR$(STATE)="DFRCA") GOTO 2810,2770,2780,2790,2800,2810
2761 REM D F R C A
2770 GOSUB 3280;GOTO 2820
2780 GOSUB 2970;GOTO 2820;REM"State=FNRfile : GOTO 2820 ! File Receive State
2790 GOSUB 2840;GOTO 2820;REM"State=FNRinit : GOTO 2820 ! Send initiate State
2800 RETURN0=TRUE;RETURN;REM Complete state
2810 RETURN0=FALSE;IF HOST=FALSE INPUT "ABOUT TO ABORT @ 2810 ",'CI','RB',* F
2810:I;RETURN;REM Abort State
2820 GOTO 2760;REM"WEND
2830 REM"FNEND -- when does it fall thru the WEND?
2840 REM--------------------------------
2850 REM FNRinit - Receive Initialization
2860 REM--------------------------------
2870 REM"DEF FNRinit LOCAL Num,Length,Type -- function definition stuff
2880 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many tries - abort
2890 NUMTRY=NUMTRY+1
2900 GOSUB 1270;REM"Type =FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(packet$))
2910 IF TYPE=FALSE RETURN;REM State ! Did not get a packet, keep waiting
2920 IF TYPE <>ASCII("S") STATE=ASCII("A");RETURN;REM Some unexpected packet
2920:- abort
2925 S$=DATA$
2930 GOSUB 680;PACKET$=FNSPAR$(Z$);REM"H=FNRpar(Packet$) : Packet$=FNSpr$
2940 TYPE=ASCII("Y"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 1120;OLDT
2940:RY=NUMTRY;REM"H=FNSpack(ASCII('Y'),N,6,Packet$)
2950 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("F");RETURN
2960 RETURN;REM"FNEND must be a gosub with state as output
2970 REM-----------------------------------------
2980 REM FNRfile - Receive file Header
2990 REM--------------------------------
3000 REM DEF FNRfile LOCAL Length,Num,Type,H,Filenam$=2
3010 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT"ABORT @3010 ON TRY
3010:S ",'CI','RB',* FI;RETURN;REM Too many tries, abort
3020 NUMTRY=NUMTRY+1
3030 GOSUB 1270;REM"Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$)
3039 REM"ON INSTR(1,'SZFB'+CHR$(0),CHR$(Type))+1 goto 3050,3060,3110,3140,323
3039:0,3260
3041 ON POS(CHAR(TYPE)="SZFB"+CHAR(0)) GOTO 3050,3060,3110,3140,3230,3260
3042 REM" S Z F B
3050 STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3050 ON STATE ",'CI','RB'
3050:,* FI;RETURN;REM Default - Abort, unknown packet
3060 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "A
3060:BORT AT 3060 TOO MANY TRYS ",'RB','CI',* FI;RETURN;REM Too many tries -
3060:abort
3070 IF NUM0<>ASCII(AND(CHAR(N-1),CHAR(63))) STATE=ASCII("A");IF HOST=FALSE P
3070:RINT "ABORT @ 3070 PACKETS OUT OF SEQUENCE ",NUM0," ",N,;INPUT 'RB','CI'
3070:,* FI;RETURN;REM Not previous packet, abort
3080 GOSUB 640;TYPE=ASCII("Y"),LENGTH=0,DATA$="";GOSUB 1120;REM"Packet$=FNSpa
3080:r$ : H=FNSpack(ASCII('Y'),Num,6,Packet$)
3090 NUMTRY=0;RETURN;REM State
3100 REM Case Z - End-of-file
3110 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "A
3110:BORT @ 3110 TOO MANY TRYS ",'CI','RB',* FI;RETURN
3120 IF NUM0<>ASCII(AND(CHAR(N-1),CHAR(63))) STATE=ASCII("A");IF HOST=FALSE I
3120:NPUT"ABORT @ 3120 WRONG SEQUENCE ",'RB','CI',* FI;RETURN;REM Not previou
3120:s packet, abort
3130 LENGTH=0,TYPE=ASCII("Y"),DATA$="";GOSUB 1120;NUMTRY=0;RETURN;REM"H=FNSpa
3130:ck(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State
3140 REM Case F - File header
3150 IFILE=IFILE+1;REM Another file
3160 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT"ABORT @ 3160 WRONG SEQUE
3160:NCE ",'CI','RB',* FI;RETURN;REM ('A') ! Wrong sequence-right block type
3170 AA$=DATA$;GOSUB 4290;IF RETURN0=FALSE IF HOST=FALSE PRINT @(0,15),"Could
3170: not create ",DATA$ FI;STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 31
3170:70 ",'CI','RB',* FI;RETURN;REM"('A')^^^
3180 FILENAM$=A$;REM IF IFILE<=NFILE K=POS(","=IFILE$), FILENAM$=IFILE$(1,K-1
3180:),IFILE$=IFILE$(K+1) ELSE FILENAM$=A$
3190 IF HOST=FALSE PRINT @(0,14)," Receiving ",FILENAM$,"
3190:"
3200 IF DEBUG0=TRUE PRINT(17)" Receiving ",FILENAM$
3210 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;REM"H=FNSpack(ASCII(
3210:'Y'),N,0,'') ! acknowledge file header
3220 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("D")
3220:; RETURN;REM" Switch to Data State
3230 REM Case B - End-of-Transmission
3240 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT @ 3240 WRONG SEQU
3240:ENCE ",'RB','CI',* FI;RETURN;REM ('A') ! Need right packet number here
3250 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;STATE=ASCII("C");RET
3250:URN;REM"H=FNSpack(ASCII('Y'),N,0,'') : RETURN ASCII('C') ! Goto Complete
3250: State
3260 RETURN;REM State ! Case False
3270 RETURN;REM FNEND this is now a gosub to 2970 with State as output
3280 REM-----------------------------
3290 REM FNRdata - Receive Data from 2770
3300 REM----------------------------
3310 REM DEF FNRdata LOCAL Num,Length,H,Type -- function definition stuff
3320 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3320 TOO
3320: MANY TRIES ",'CI','RB',* FI;RETURN;REM Too many tries - abort
3330 NUMTRY=NUMTRY+1
3340 GOSUB 1270;REM"Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
3350 IF DEBUG0=TRUE PRINT(17)" Rx ",LENGTH,NUM0,PACKET$
3359 REM"ON INSTR(1,'DFZ'+CHR$(0),CHR$(Type))+1 GOTO 3370,3380,3430,3460,3490
3360 ON POS(CHAR(TYPE)="DFZ"+CHR$(0)) GOTO 3370,3380,3430,3460,3490
3370 STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3370 SOME OTHER PACKET ",
3370:'CI','RB',* FI;RETURN;REM Default - someother packet, abort
3380 IF NUM0=N GOTO 3400 ELSE OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A
3380:");RETURN
3390 IF NUM0=ASCII(AND(CHAR(N-1),CHAR(63))) TYPE=ASCII("Y"),LENGTH=LEN(PACKET
3390:$),DATA$=PACKET$;GOSUB 1120;NUMTRY=0;RETURN ELSE STATE=ASCII("A");RETURN
3390:;REM "if Num=((N-1) AND 63) H=FNSpack (ASCII('Y'),Num,6,Packet$) : Numtr
3390:y=0 : RETURN State Else RETURN ASCII('A')
3400 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,BUF$=DATA$,DATA$="";GOSUB 1120
3405 LGD=LEN(BUF$);GOSUB 780;REM TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOS
3405:UB 1120
3410 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("D")
3410:;RETURN
3420 REM Case F - File header
3440 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT"AB
3440:ORT @ 3440 TOO MANY TRIES ",'CI','RB',* FI;RETURN
3450 REM Case Z - End-of-file
3460 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3460 WRONG SEQ
3460:UENCE ",'CI','RB',* FI;RETURN
3465 IF PEEK$>"" GOSUB 885
3470 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;CLOSE(FD);N=ASCII(AN
3470:D(CHAR(N+1),CHAR(63))),STATE=ASCII("F");RETURN
3480 TYPE=ASCII("N"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;REM "Nacka
3490 RETURN;REM state
3500 RETURN;REM FNEND
3510 REM-----------------------------------------
3520 REM FNConnect - Establish virtual terminal to remote host
3530 REM-----------------------------------------
3540 REM DEF FNConnect LOCAL Dummy$=
3550 REM IF HOST=TRUE PRINT @(15,0),"Kermit: nothing to connect in host mode
3550:",'RB','RB';RETURN
3554 INPUT(0,ERR=3554)'EO','BE',@(0,14),"ENTER PORT (CR=become host) ",'CI',P
3554:ORT$;IF PORT$="" CLOSE(REMFD);OPEN(REMFD)"T*";HOST=TRUE; GOTO 3585
3560 PRINT @(0,16),"Kermit: connected - terminal mode with host - Push PF1 to
3560: exit"
3570 REM "ON ERROR GOTO 3600
3580 REMFD=1,HOST=FALSE;CLOSE(REMFD);OPEN(REMFD,ERR=3600)PORT$;REM"OPEN 'V24:
3580:TSA30B24.' CHR$(Brf+48,Brf+48,65) AS FILE 1; GET #1,A$
3585 GOSUB 4590
3587 PRINT(REMFD)'BO'
3590 RETURN
3600 REM RESUME
3605 PRINT "ERROR ",ERR," ON OPEN OF ",PORT$
3610 PRINT "Kermit: disconnected";WAIT 2;RETURN;REM"ON ERROR GOTO : ; --:H=FN
3610:Delay
3620 RETURN;REM FNEND
3630 REM----------------------------
3640 REM FNInchr$ - get char from remote line
3650 REM----------------------------
3660 REM"DEF FNInchr$ LOCAL Dummy$=
3670 INPUT(REMFD,TIM=MAXTIM,ERR=3671)DUMMY$;DIM X$(LEN(DUMMY$),CHAR(127));DUM
3670:MY$=AND(DUMMY$,X$);RETURN;REM"GET #Remfd Dummy$ : RETURN CHR$(ASCII(Dumm
3670:y$) AND 127) ! strip parity bit
3680 RETURN;REM"FNEND
3690 REM-------------------------
3700 REM FNBaud%(B%) - set up baud rate
3710 REM Input: Baud rate
3720 REM Output: Port setting
3730 REM---------------------------
3740 REM" DEF FNBaud(B) LOCAL I,Nb,K
3750 I=1;REM RESTORE
3760 READ NB
3765 REM DATA 8,110,300,600,1200,2400,4800,9600,19200
3770 IF I>NB GOTO 3790 ELSE READ K; IF B=K RETURN0=I;RETURN;REM "WHILE I<=Nb
3770:: READ K : IF B=K RETURN I
3780 I=I+1
3790 REM WEND
3800 PRINT @(13,0),"**** Bad Baud rate =",B," Not permitted ****",'RB','RB',
3800:'RB';RETURN
3810 REM FNEND
3820 REM------------------------------
3830 REM FNFiles - input file names - check files from 420,2740
3840 REM-----------------------------
3850 REM"DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,i
3860 NFILE=0,IFILE$="";PRINT @(0,12),"Specify File names (use , between names
3860:) ",;DIM SPACE$(162)
3870 PRINT SPACE$,@(0,13),;INPUT AA$; IF AA$="" RETURN;REM was Aa$=LEFT$(Aa$,
3870:LEN(Aa$)-2) : IF LEN(Aa$)=0 RETURN (maybe 0?)
3880 NFILE=NFILE+1
3890 K=POS(","=AA$)
3895 IF K=1 AA$=AA$(K+1); GOTO 3880;REM "null file?
3900 IF K>0 IFILE$=IFILE$+AA$(1,K-1)+",",AA$=AA$(K+1);GOTO 3880
3910 IFILE$=IFILE$+AA$;REM aa$ is either null if it ends in a , or the last f
3910:ile name you want
3920 IF RSW>0 RETURN; REM "Receive mode, no filename check
3930 SETERR 3960;I=0,AA$=IFILE$
3935 K=POS(","=AA$); IF K=1 AA$=AA$(K+1); GOTO 3935 ELSE IF K=0 AND AA$="" GO
3935:TO 3950
3937 IF K=0 X$=AA$ ELSE X$=AA$(1,K-1),AA$=AA$(K+1)
3940 IF I>NFILE GOTO 3950 ELSE CLOSE(2);OPEN(2)X$;FID2$=FID(2);CLOSE(2);I=I+1
3940:;IF (ASC(FID2$(10))=2 AND DEC(FID2$(15,2))=0) OR ASC(FID2$(10))=4 PRINT
3940: X$, "is not a data file!" ELSE IF I>1 GOTO 3935
3942 INPUT(0,ERR=3942)@(0,17),"Enter starting key (cr=first) ",START0$
3945 INPUT(0,ERR=3945)@(0,18),"Enter ending key (cr=last) ",END0$; IF CTL>1 G
3945:OTO 3942 ELSE IF END0$="" END0$=$FF$
3947 GOTO 3935
3959 SETERR 15700;RETURN; REM "ON ERROR GOTO : RETURN Nfile
3960 REM"RESUME
3970 PRINT @(0,14),"file ",X$," does not exist - (ERROR=",ERR,") abort !!!!";
3970: INPUT A$;RETURN
3980 REM FNEND
3990 REM----------------------------------
4000 REM FNGetch - Get line char one by one from 1350,1380 now 1346
4010 REM Basic BASIC - version, for level 1.000
4020 REM-------------------------------------
4030 REM DEF FNGetch LOCAL Sec,I,Dummy$=
4040 REM SEC=PEEK(65524)+Timint+1; If Sec>59 Sec=Sec-60
4050 REM If PEEK2(PEEK2(65500)+6) RETURN ASCII(FNInchr$)
4060 REM"IF Sec=PEEK(65524) RETURN -1 ELSE goto 4050
4064 DUMMY$=""
4065 INPUT(REMFD,ERR=4066,TIM=TIMINT)DUMMY$;IF HOST=FALSE PRINT @(0,16),DUMMY
4065:$, FI;RETURN
4067 T=-1
4068 IF HOST=FALSE PRINT @(50,16),"TIME OUT"
4070 REM FNEND
4075 RETURN
4080 REM-----------------------------------------
4090 REM FNHead - Print Meny - input command
4100 REM-----------------------------------------
4110 REM DEF FNHead LOCAL f,F$=1,Baud
4120 REM RESTORE 3760 : READ Baud
4126 BAUD=1200;GOTO 4140
4130 IF BRF>0 FOR I=1 TO BRF; READ BAUD;NEXT I ELSE BAUD=1200
4140 SETERR 4270;REM"ON ERROR GOTO 4270
4145 DIM SPACE$(20)
4150 PRINT @(0,0),'CS'," K E R M I T f o r M A I B B 8 6 ",SPACE$,VERSI
4150:ON$
4190 PRINT 'LF',"1) Connect to host computer"
4200 PRINT "2) Receive files from you"
4210 PRINT "3) Send files to you"
4230 PRINT "4) Turn on debug mode"
4240 PRINT "5) Exit Kermit"
4259 PRINT @(0,11),"Specify function ",'CI',; INPUT F$; PRINT F$;F=NUM(F$,ERR
4259:=4259);IF F>5 PRINT "not yet implemented";GOTO 4259
4260 IF F>0 SETERR 15700;RETURN ELSE GOTO 4259
4270 REM RESUME
4271 SETERR 15700
4280 RETURN;REM FNEND
4290 REM----------------------
4300 REM FNGetfil(A$) - Create new file from 3170
4310 REM-------------------------------
4320 REM"DEF FNGetfil(Aa$) LOCAL A$=1
4330 A$=AA$;IF IFILE<=NFILE X=POS(","=IFILE$);IF X>0 A$=IFILE$(1,X-1),IFILE$=
4330:IFILE$(X+1)
4335 FA=LEN(A$); IF FA<6 FA$="%"+STR(FA)+A$ ELSE FA$=A$
4336 FA$=".DOWNLOAD."+FA$;REM" should put the download directory namne as a p
4336:aramter too!
4340 SETERR 4341;CREATE ATTR="NAME="+FA$+" ORGANIZATION=SER";SETERR 15700;OP
4340:EN(FD)FA$;LOCK(FD);KRAD=0;RETURN0=TRUE;RETURN ;REM"prepare a$ as file fd
4340: ; krad=0 : RETURN True
4342 IF ERR<>12 GOTO 4350 ELSE IF HOST=TRUE GOTO 4344
4343 PRINT @(0,14),"File ",FA$," already exists..cr to use it, ctl II to eras
4343:e first, ctl iv to exit ",;INPUT'CI',*; IF CTL=2 CLOSE(FD);ERASE FA$; RE
4343:TRY ELSE IF CTL>2 RETURN0=FALSE;RETURN
4344 CLOSE(FD);OPEN(FD)FA$;LOCK(FD)
4345 KRAD=0,RETURN0=TRUE;RETURN
4350 REM sorry pal - bad name
4360 REM RESUME
4370 SETERR 15700; PRINT @(0,14),"File ",A$," illegal file name(ERROR=",ERR,"
4370:) "; RETURN0=FALSE;RETURN
4380 REM FNEND
4390 REM----------------------------------------
4400 REM FNQ$(T) - quote a char from 1060
4410 REM-----------------------------------------
4420 REM DEF FNQ$(T)
4430 IF T=MYQUOTE RETURN0$=CHAR(T)+CHAR(T);RETURN;REM "# is sent as ##
4440 RETURN0$=CHAR$(MYQUOTE)+XOR(CHAR(T),CHAR(64));REM "<32 or DEL toggle con
4440:trol bit
4445 RETURN0$(2)=CHAR(ASC(RETURN0$(2)))
4450 RETURN; REM FNEND
4460 REM-------------------------------
4470 REM FNQrpack(&len,&num,&data$) - Emulate Rpack from keyboard from 1330
4480 REM----------------------------------------------------------
4490 REM DEF FNQrpack(Length,Num,Datax) LOCAL Typ,Pp,L1,Nn,Dd$=90,Typ$=1
4500 DIM SPACE$(79);PRINT @(0,22),SPACE$,@(0,22),"typ,num,text: ",;INPUT TYP$
4500:,NN,DD$
4510 TYP=ASCII(TYP$),L1=LEN(DD$);REM POKE Length,L1,SWAP%(L1);POKE Num,Nn,SWA
4510:P%(Nn)
4520 PP=PEEK2(DATAX+2);REM POKE Datax+4,L1,SWAP%(l1)
4530 I=1;IF I>L1 GOTO 4541 ELSE REM POKE Pp,ASCII(MID$(Dd$,I,1))
4540 I=I+1;PP=PP+1; GOTO 4530
4550 PRINT @(40,15)," Receive packet ",N," ",CHAR(TYP),SP$
4560 IF DEBUG0=TRUE PRINT(17)" Receive packet ",PEEK2(NUM0)," ",N,CHAR(TYP)
4570 RETURN0=TYP;RETURN
4580 REM FNEND
4590 REM------------------------------
4600 REM FNDelay delay 2 seconds from 540,,3585
4610 REM-----------------------------
4620 REM DEF FNDelay LOCAL X
4625 WAIT 2; GOTO 4650
4630 X=1
4640 IF X<15 X=X+1; GOTO 4640
4650 RETURN; REM FNEND
7717 IOLIST PP," ",X$,T," CHAR=",CHAR(T)," HTA=",HTA(DUMMY$(PP,1))," CHKSUM =
7717:",CHKSUM
7727 IOLIST PP," ",X$,T," CHR=",CHR(T)," HTA=",HTA(DUMMY$(PP,1))," CHKSUM =",
7727:CHKSUM
9949 REM CONVERSION TABLE: B4 ASCII TO STANDARD ASCII
9950 TABLE 7F000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F
9950:202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F40414243
9950:4445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F6061626364656667
9950:68696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F
9959 REM CONVERSION TABLE: STANDARD ASCII TO B4 ASCII
9960 TABLE 7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
9960:A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3
9960:C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7
9960:E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
10000 CHKSUM=0;FOR PP=2 TO LEN(DUMMY$)-1
10010 CHKSUM=CHKSUM+ASC(AND($3F$,DUMMY$(PP,1)))
10020 NEXT PP
10030 ESCAPE
11000 REM"DOIT IN LOW ORDER ASSKEY
11070 DIM BUFFER$(PAD,PADCHAR$);BUFFER$=BUFFER$+CHR(SOH)+CHR(LENGTH+35)+CHR(NU
11070:M0+32)+CHR(TYPE)+TBL(DATA$,9950)
11097 CHKSUM=0; FOR I=2+PAD TO LEN(BUFFER$); CHKSUM=CHKSUM+ASC(BUFFER$(I));NEX
11097:T I
11098 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
11098:1,64)
12010 BUFFER$=BUFFER$+CHR(CHKSUM+32)+CHR(EOL)+CHR(10);REM was Buffer$=Buffer$+
12010:CHR$(Chksum+32,Eol,10),CHR$(10)=$8A$=newline?
12020 PRINT (REMFD)BUFFER$; IF HOST=FALSE PRINT @(0,15),"Send packet ",N," ",C
12020:HAR(TYPE)," ",NUMTRY," ",
12030 IF DEBUG0=TRUE PRINT (17)"Send packet ",N," ",CHR(TYPE)," ",NUMTRY
12040 IF DEBUG0=TRUE PRINT(17)BUFFER$
12050 H=LEN(BUFFER$); RETURN; REM RETURN LEN(Buffer$)
12090 RETURN
16000 END