10 !------------------------------------------------------------ & ! & ! XMODEM.BAS & ! & ! Jeff Loucks AMS & ! & ! ADAPTED TO RSTS/E BY J. LOUCKS ON 20-SEP-84 & ! & ! THIS ROUTINE FOLLOWS THE PROTOCOL ORIGINALLY & ! DEVELOPED AND DESCRIBED BY WARD CHRISTENSEN. & ! & ! 30-Oct-84 Sam Janney Added screen handling. & ! Added routines to open & ! KB: and display header. & ! Added interface to the & ! WMMS system. & ! & ! 31-Oct-84 Mark Servello Inserted code to put & ! terminal into VT52 mode & ! so calls to Screen routines & ! work correctly. Changed & ! reference to variable & ! TIME.OUT% in line 2100 & ! for loop to be consistent & ! with rest of code. & ! & ! 20-Nov-84 Mark Servello Modified to not ask for & ! RETURN before starting & ! rcve or xmt loop. & ! & ! 28-Nov-84 Mark Servello Inserted close statements & ! in send/receive sections to & ! make sure kb: open on only & ! one channel at a time, and & ! transfer channels closed when & ! transfer complete or aborted. & ! Added prompt to enter RETURN & ! before display of main cmd & ! prompt to re-synch remote & ! computer with screen prompt & ! after transfer. & ! & ! 17-Mar-86 Sam Janney Removed screen handling to & ! allow it to be built in a & ! "DIBOL" type environ..... & !------------------------------------------------------------ & 20 DIM CHAR%(128%), BUF%(128%) & \ CHAR%(0%)=128% & 30 MAX.ERRORS% = 10% & \ SEND.TIMEOUT% = 180% & \ RECEIVE.TIMEOUT% = 10% & & \ SOH% = 1% ! A START OF HEADER & \ EOT% = 4% ! D END OF TRANSMISSION & \ ACK% = 6% ! F ACKNOWLEDGE & \ NAK% = 21% ! U NEGATIVE ACKNOWLEDGE & \ CAN% = 24% ! U CANCEL & \ CR$=CHR$(13%) & \ LF$=CHR$(10%) & 90 ON ERROR GOTO 31000 & & !-------------------------------------------------------------------- & ! MAIN LINE & !-------------------------------------------------------------------- & 100 ERROR.FLAG% = 0 ! M.S. 11-28-84 RESET ERROR FLAG & \ GOSUB 4000 ! display header and reopen kb & \ PRINT 'Send, Receive, Help or Quit '; & \ WAIT 0% & \ INPUT X$ & & \ X$ = LEFT(CVT$$(X$,-1%)+'Q',1%) & \ BUF.LENGTH%=0% & \ BUF.POINTER%=BUF.LENGTH%+1% & \ ON INSTR(1%,'SRHQ',X$)+1% GOTO 100, 1000, 2000, 3000, 30100 !32767 & & !-------------------------------------------------------------------- & ! SEND & !-------------------------------------------------------------------- & 1000 PRINT 'Enter the name of the file to send '; & \ INPUT LINE F$ & & \ F$ = CVT$$(F$,-1%) & \ GOTO 100 IF F$ = '' & \ GOTO 1020 & 1010 PRINT '?File could not be opened.' & \ GOTO 1000 & 1020 OPEN F$ FOR INPUT AS FILE #2% & & ! M.S. 11-20-84 - CHANGED TO NOT ASK FOR RETURN BEFORE STARTING SEND & ! LOOP & 1030 PRINT 'Ready to send. Set up your computer' & \ PRINT 'to receive and the transfer will begin.' & & \ GOSUB 10000 ! OPEN KB: AND CANCEL ALL TYPE AHEAD & \ FIELD #1%, 128% AS KEYBOARD$ & \ FILE.BLOCK% = 0% & \ CURRENT.BLOCK% = 1% & \ ERROR.COUNT% = 0% & 1100 C% = FNCHAR.IN%(SEND.TIMEOUT%) ! WAIT FOR RECEIVER & \ GOTO 1300 IF TIMEOUT% ! EOT, WAITED TOO LONG & \ GOTO 1400 IF C% = CAN% ! ACK THE CANCEL & & \ IF C% = ACK% THEN ! MUST BE ACK OR NAK & CURRENT.BLOCK% = CURRENT.BLOCK% + 1% & ELSE & GOTO 1100 UNLESS C% = NAK% & 1110 GOSUB 10200 ! GET DATA FROM INPUT FILE & \ GOTO 1200 IF EOF% ! EOT, NO MORE DATA & \ X% = FNCHAR.OUT%(SOH%) ! SEND SOH & \ X% = FNCHAR.OUT%(CURRENT.BLOCK%) ! SEND BLOCK NUMBER & \ X% = FNCHAR.OUT%(NOT CURRENT.BLOCK%) ! SEND COMPLEMENT & \ LSET KEYBOARD$ = DATA.$ & \ PUT #1%, RECORD 4096%, COUNT 128% ! SEND THE DATA BLOCK & \ X% = FNCHAR.OUT%(CK%) ! SEND CHECKSUM & \ GOTO 1100 & 1200 X% = FNCHAR.OUT%(EOT%) ! SEND EOT & \ C% = FNCHAR.IN%(RECEIVE.TIMEOUT%) ! WAIT FOR ACK & \ IF TIMEOUT% OR C% <> ACK% THEN & GOTO 1200 & ELSE & GOTO 1500 & 1300 X% = FNCHAR.OUT%(EOT%) ! SEND EOT & \ ERROR.FLAG% = -1% ! M.S. 11-28-84 SET ERROR FLAG & \ GOTO 1500 ! DON'T WAIT & 1400 X% = FNCHAR.OUT%(ACK%) ! SEND ACK & \ ERROR.FLAG% = -1% ! M.S. 11-28-84 SET ERROR FLAG & & ! M.S. 11-28-84 CHANGED TO CLOSE INPUT FILE AND OUTPUT KB CHANNEL & ! BEFORE RETURN TO PROMPT LOOP & 1500 CLOSE #1%,#2% & \ GOSUB 4200 & \ GOTO 100 & & !-------------------------------------------------------------------- & ! RECEIVE & !-------------------------------------------------------------------- & 2000 PRINT 'Enter the name of the file to receive '; & \ INPUT LINE F$ & & \ F$ = CVT$$(F$,-1%) & \ GOTO 100 IF F$ = '' & 2010 OPEN F$ FOR INPUT AS FILE #2% & \ CLOSE #2% & \ PRINT '%File already exists.', 'Overwrite (Y OR N) '; & \ INPUT X$ & & \ X$ = CVT$$(X$,-1%) & \ GOTO 2000 UNLESS LEFT(X$,1%) = 'Y' & 2020 OPEN F$ FOR OUTPUT AS FILE #2% & & ! M.S. 11-20-84 - CHANGED TO NOT ASK FOR RETURN BEFORE STARTING SEND & ! LOOP & 2030 PRINT 'Ready to receive. Set up your computer' & \ PRINT 'to send and the transfer will begin.' & & \ GOSUB 10000 ! OPEN KB: AND CANCEL ALL TYPE AHEAD & \ CURRENT.BLOCK%, ERROR.COUNT% = 0% & \ PROMPT% = NAK% ! START BY NAK'ING THE SENDER & 2100 X% = FNCHAR.OUT%(PROMPT%) ! PROMPT SENDER & \ C% = FNCHAR.IN%(RECEIVE.TIMEOUT%) ! WAIT FOR SENDER & \ GOTO 2100 IF TIMEOUT% ! --M.S. was TIME.OUT% & \ GOTO 2400 IF C% = EOT% OR C% = CAN% ! ACK, END OF TRANSFER & \ GOTO 2100 UNLESS C% = SOH% & \ PROMPT% = ACK% ! CONTINUE BY ACK'ING & & \ B% = FNCHAR.IN%(1%) & \ GOTO 2200 IF TIMEOUT% ! NAK, TIME OUT & \ BNOT% = (NOT FNCHAR.IN%(1%)) AND 255% & \ GOTO 2200 IF TIMEOUT% ! NAK, TIME OUT & \ GOTO 2200 IF B% <> BNOT% ! NAK, BAD HEADER & \ GOTO 2300 & UNLESS B% = CURRENT.BLOCK% OR B% = ((CURRENT.BLOCK%+1%) AND 255%) & ! CAN, BAD SYNC & & \ CK% = 0% & \ FOR I% = 1% TO 128% & \ C% = FNCHAR.IN%(1%) & \ GOTO 2200 IF TIMEOUT% & \ CK% = CK% + C% & \ CHAR%(I%) = C% & \ NEXT I% & \ CK% = CK% AND 255% & \ CHECK.SUM% = FNCHAR.IN%(1%) ! GET THE CHECKSUM & \ GOTO 2200 IF TIMEOUT% ! NAK, TIME OUT & \ GOTO 2200 IF CK% <> CHECK.SUM% & ! NAK, BAD CHECKSUM & \ CHANGE CHAR% TO GETSTR$ & \ PRINT #2%, GETSTR$; UNLESS B% = CURRENT.BLOCK% & \ CURRENT.BLOCK% = B% & \ ERROR.COUNT% = 0% & \ GOTO 2100 & 2200 GOSUB 10100 ! WAIT FOR LINE TO CLEAR & \ ERROR.COUNT% = ERROR.COUNT% + 1% & \ IF ERROR.COUNT% > MAX.ERRORS% THEN & X% = FNCHAR.OUT%(CAN%) ! CAN, EXCESSIVE ERRORS & \ ERROR.FLAG% = -1% ! M.S. 11-28-84 SET ERROR FLAG & \ GOTO 2500 ! M.S. 11-28-84 2201 !ELSE & PROMPT% = NAK% ! NAK, RE-TRANSMIT & \ GOTO 2100 & 2300 GOSUB 10100 ! WAIT FOR LINE TO CLEAR & \ X% = FNCHAR.OUT%(CAN%) ! CAN THE TRANSFER & \ ERROR.FLAG% = -1% ! M.S. 11-28-84 SET ERROR FLAG & \ GOTO 2500 ! M.S. 11-28-84 & 2400 X% = FNCHAR.OUT%(ACK%) & \ GOTO 2500 ! M.S. 11-28-84 & & ! M.S. 11-28-84 CHANGED TO CLOSE INPUT FILE AND OUTPUT KB CHANNEL & ! BEFORE RETURN TO PROMPT LOOP & 2500 CLOSE #1%,#2% & \ GOSUB 4200 & \ GOTO 100 & & !-------------------------------------------------------------------- & ! HELP & !-------------------------------------------------------------------- & 3000 PRINT ! position cursor & \ PRINT CR$;LF$; & \ PRINT CR$;LF$; & ' THE XMODEM PROTOCOL IS A LOW LEVEL DATA EXCHANGE METHOD THAT';CR$;LF$; & 'WILL ALLOW ERROR FREE DATA TRANSFER WHEN LINE ERROR RATES ARE';CR$;LF$; & 'MODERATE TO LOW. THE PROTOCOL ALLOWS EITHER SENDING OR RECEIVING';CR$;LF$; & 'OF 8 BIT BINARY DATA AS 128 BYTE BLOCKS AND MAY BE USED FOR ASCII';CR$;LF$; & 'TEXT FILES AS WELL AS BINARY DATA AND/OR EXECUTABLE FILES.';CR$;LF$; & ' MOST BULLETIN BOARDS AND PERSONAL COMPUTERS ARE EQUIPPED TO';CR$;LF$; & 'HANDLE THE XMODEM PROTOCOL. A FEW EXAMPLES OF SOFTWARE COMPATIBLE';CR$;LF$; & 'WITH XMODEM ARE: ZSTEM, PC-TALK, MODEM7, HOSTCOMM AND SUPERTERM.';CR$;LF$; & ' THIS IMPLEMENTATION USES CHECKSUM AND DOES NOT SUPPORT CRC FOR';CR$;LF$; & 'DATA CHECKING.';CR$;LF$; & ' COMMENTS AND/OR SUGGESTIONS REGARDING THE XMODEM PROTOCOL MAY';CR$;LF$; & 'BE DIRECTED TO WARD CHRISTENSEN AT (312) 849-6279 AS OF 1/1/82.';CR$;LF$ & \ INPUT X$ & \ GOTO 100 & & !-------------------------------------------------------------------- & ! SUBROUTINES & !-------------------------------------------------------------------- & 4000 PRINT & \ PRINT 'XMODEM DATA EXCHANGE PROGRAM V1.0' & \ PRINT & \ RETURN & & ! M.S. 11-28-84 ASK FOR BEFORE PROMPTING FOR NEXT USER CHOICE & ! THIS ALLOWS THE USER TO EXIT LOCAL MODE ON THE REMOTE & ! COMPUTER AND RE-ENTER TERMINAL MODE WITHOUT LOSING THE & ! COMMAND PROMPT LINE. & 4200 WAIT 5% & \ IF ERROR.FLAG% THEN & PRINT '?Transfer aborted.' & \ PRINT 'Press to continue'; & \ GOTO 4210 4201 !ELSE & PRINT 'Transfer complete.' & \ PRINT 'Press to continue'; & 4210 INPUT X$ & \ GOTO 100 & & ! OPEN KB: AND CANCEL TYPE AHEAD & ! & 10000 OPEN 'KB:' AS FILE #1%, MODE 1% & \ FIELD #1%, 1% AS ONE.CHAR$ & \ X$ = SYS(CHR$(11%)+CHR$(1%)) & \ RETURN & & ! WAIT FOR LINE TO CLEAR & 10100 C% = FNCHAR.IN%(1%) & \ GOTO 10100 UNLESS TIMEOUT% & \ RETURN & & ! GET DATA SEGMENT FROM INPUT FILE & ! 10200 BLOCK.NUMBER% = (CURRENT.BLOCK%-1%)/4% + 1% & \ SEGMENT.NUMBER% = (CURRENT.BLOCK%-1%) AND 3% & \ IF FILE.BLOCK% <> BLOCK.NUMBER% THEN & GET #2%, BLOCK BLOCK.NUMBER% & \ FILE.BLOCK% = BLOCK.NUMBER% & 10210 FIELD #2%, SEGMENT.NUMBER%*128% AS J$, 128% AS DATA.$ & \ EOF% = 0% & \ CK% = 0% & \ CK% = CK% + ASCII(MID(DATA.$,I%,1%)) FOR I% = 1% TO 128% & \ CK% = CK% AND 255% & \ RETURN & 10220 EOF% = -1% & \ RETURN & & !-------------------------------------------------------------------- & ! FUNCTIONS & !-------------------------------------------------------------------- & 20000 DEF FNCHAR.IN%( ZW% ) & \ TIMEOUT% = 0% & \ IF BUF.POINTER% > BUF.LENGTH% THEN & BUF.POINTER% = 1% & \ WAIT ZW% & \ GET #1% & \ BUF.LENGTH% = RECOUNT & \ FIELD #1%, BUF.LENGTH% AS INPUT.DATA$ & \ CHANGE INPUT.DATA$ TO BUF% & 20010 FNCHAR.IN% = BUF%(BUF.POINTER%) & \ BUF.POINTER% = BUF.POINTER% + 1% & \ GOTO 20030 & 20020 TIMEOUT% = -1% & \ BUF.LENGTH% = 0% & \ GOSUB 10000 & 20030 FNEND & 20300 DEF FNCHAR.OUT%( Z% ) & \ LSET ONE.CHAR$ = CHR$(Z% AND 255%) & \ PUT #1%, RECORD 4096%, COUNT 1% & 20310 FNEND & 30100 !============================================================ & ! E X I T & !============================================================ & & GOTO 32767 & & !-------------------------------------------------------------------- & ! ERROR TRAPPING & !-------------------------------------------------------------------- & 31000 ! & RESUME 100 IF ERL = 100% & \ RESUME 1010 IF ERL = 1020% & \ RESUME 2020 IF ERL = 2010% & \ RESUME 10220 IF ERL = 10200% & \ RESUME 20020 IF ERL = 20000% & \ RESUME 90 & & !-------------------------------------------------------------------- & ! EXIT & !-------------------------------------------------------------------- & 32767 END ! XMODEM.BAS