147 SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):XON$=CHR$(17):XOFF$=CHR$(19):NAK$=CHR$(21):CAN$=CHR$(24):' DEFNS FOR XMODEM PROTOCOL ROUTINES. 300 $ CX=-1 : GOSUB 3820 'OPEN FILE 3061 GOSUB 19000 ' GO TEST FOR APPROPRIATE PROTOCOL. 3073 IF PROTO=2 THEN GOTO 22000 ' RECEIVE WITH XMODEM PROTOCOL. 19000 PRINT:PRINT "SPECIFY PROTOCOL DESIRED (IF ANY):" 19010 PRINT " 1 - NONE" 19020 PRINT " 2 - CHRISTENSEN XMODEM (FOR RCPM SYSTEMS)" 19030 INPUT "SELECTION?",PROTO 19040 IF PROTO < 1 OR PROTO > 2 THEN PROTO=1 19042 IF PROTO = 2 THEN IF DTA$<>"8" THEN PRINT "ERROR - XMODEM PROTOCOL REQUIRES 8 BIT DATA WORDS. NO PROTOCOL WILL BE USED.":PROTO=1 19050 RETURN 20000 ' GET CHARACTER ----------------------------------------- 20010 Y$="" 20020 FOR XA=1 TO 420 20030 IF NOT EOF(1) THEN Y$=INPUT$(LOC(1),#1) : RETURN 20040 NEXT XA : Y$="" : RETURN 21000 ' TIMEOUT ----------------------------------------------- 21010 FOR XB = 1 TO 10 21020 GOSUB 20000 21030 IF MID$(Y$,1,1)=SOH$ THEN RETURN 21040 IF MID$(Y$,1,1)=EOT$ THEN 22350 21050 IF MID$(Y$,1,1)=CAN$ THEN 22360 21060 IF Y$<>"" THEN GOSUB 25000 : GOTO 21000 21070 NEXT XB 21080 IF Y$="" THEN PRINT #1,NAK$; 21090 GOTO 21000 22000 ' RECEIVE WITH XMODEM PROTOCOL --------------------------- 22010 PRINT "RECEIVE FILE WITH XMODEM PROTOCOL" : PRINT 22020 'IF EVEN THEN GOSUB 3940 ' SET WORD STRUCTURE TO 8-N-1 22030 'GOSUB 3740 ' OPEN FILE 22040 GOSUB 25000 ' PURGE BUFFER 22050 X$="" : SEC=1 22060 PRINT #1,NAK$; 22070 GOSUB 21000 ' TIMEOUT 22080 GOSUB 20000 ' GET CHAR 22090 IF Y$="" THEN PRINT "TIMEOUT" : GOTO 22120 22100 X$=X$+Y$ 22110 IF LEN(X$)<=131 THEN 22080 22120 IF LEN(X$)= 132 THEN Z$=MID$(X$,4,128) : N=132 : GOTO 22200 22130 IF LEN(X$)= 131 THEN Z$=MID$(X$,3,128) : N=131 : GOTO 22200 22140 IF LEN(X$)> 132 THEN 22310 22150 IF X$=EOT$ THEN 22350 22160 IF X$=CAN$ THEN 22360 22170 GOTO 22300 22180 IF SEC<> VAL(MID$(X$,2,1) THEN 22330 22190 IF (SEC XOR 255) <> VAL(MID$(X$,3,1) THEN 22340 22200 FOR Q=1 TO 128 : CK=CK+ASC(MID$(Z$,Q,1)) : NEXT 22210 IF (CK AND 255) <> (ASC(MID$(X$,N,1))) THEN 22320 22220 PRINT "RECEIVED #";SEC : SEC=255 AND (SEC+1) 22230 PRINT #2,Z$; 22240 PRINT #1,ACK$; 22250 X$="" : CK=0 : GOTO 22080 22300 PRINT "SHORT BLOCK IN #" ;SEC : PRINT #1,NAK$; : GOTO 22250 22310 PRINT "LONG BLOCK IN #" ;SEC : PRINT #1,NAK$; : GOTO 22250 22320 PRINT "CHECKSUM ERROR IN #";SEC : PRINT #1,NAK$; : GOTO 22250 22330 PRINT "BLOCK # ERROR IN #";SEC : PRINT #1,NAK$; : GOTO 22250 22340 PRINT "COMPLEMENT ERROR IN #";SEC:PRINT #1,NAK$; : GOTO 22250 22350 PRINT "FILE CLOSED." : PRINT #1,ACK$; : GOTO 3010 22360 PRINT "TRANSFER ABORTED AT RECEIVER" : GOTO 3010 25000 'PURGE BUFFER ------------------------------------------ 25010 WHILE NOT EOF(1) : DUMMY$=INPUT$(LOC(1),#1) : WEND : RETURN 30000 ' SEND WITH XMODEM PROTOCOL ----------------------------------- 30010 PRINT "SEND FILE WITH XMODEM PROTOCOL" : PRINT 30020 IF EVEN THEN GOSUB 3930 'SET TO N-8-1 WORD STRUCTURE 30040 SEC=0 : GOSUB 25000 'PURGE BUFFER 30050 EOT=0 : Y$="" : X$="" 30100 WHILE NOT EOF(1) 'WAIT FOR NAK 30110 Y$=INPUT$(1,#1) 30120 IF Y$=CAN$ THEN 30510 30130 IF Y$=NAK$ THEN 30310 30140 WEND : GOTO 30100 30150 ' 30200 WHILE NOT EOF (1) ' WAIT FOR ACK 30210 Y$=INPUT$(1,#1) 30220 IF Y$=ACK$ THEN CK=0 : Y$="" : GOTO 30360 30230 IF Y$=NAK$ THEN 30460 30240 IF Y$=CAN$ THEN 30510 30250 WEND : GOTO 30200 30260 ' 30300 IF EOT THEN 30500 ' BUILD AND SEND BLOCK 30310 CK=0 : Y$="" 30320 IF EOF(3) THEN 30490 30330 LINE INPUT #3,Z$ 30340 Y$=Y$+CHR$(13) : CK=CK+13 30360 IF EOT THEN 30500 30365 FOR X=1 TO LEN(Z$) 30370 Y$=Y$+MID$(Z$,X,1) 30380 CK=CK+ASC(MID$(Z$,X,1)) 30390 IF LEN(Y$)=128 THEN 30410 30400 NEXT : GOTO 30320 30410 Z$=MID$(Z$,X+1) 30420 CK=(CK AND 255) 30430 IF CK>256 THEN CK=CK-256 : GOTO 30430 30440 SEC=255 AND (SEC+1) 30450 A$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Y$+CHR$(CK) 30460 PRINT "SEND #";SEC 30470 PRINT #1,A$; 30480 GOTO 30200 30490 Z$=Y$+SPACE$(128-LEN(Y$)) : EOT=-1 : GOTO 30360 30500 PRINT "TRANSMISSION ENDED." : PRINT #1,EOT$; : CLOSE #3 : RETURN 400 30510 PRINT "TRANSMISSION ABORTED BY RECEIVER":CLOSE #3:RETURN 400 65399 '** DONE - PRESS ENTER TO RETURN TO MENU **