'----- PCACCESS.BAS - QuickBASIC communications and file download utility ' 'Written for PC Magazine by Jay Munro ' ' Compile and Link syntax: BC /o/x PCAccess; ' LINK /ex PCAccess; DEFINT A-Z 'Use integers unless over-ridden '----- QuickBASIC Subprograms DECLARE SUB AbortFile (FileName$) 'Clears buffer, closes file DECLARE SUB Call800 () 'Calls 800 Phones number DECLARE SUB CurSettings () 'Prints Current Setup DECLARE SUB PrintLogo () 'Prints PCMag logo and help DECLARE SUB HalfSec () 'Delaying tactics 'Checks blocks for errors DECLARE SUB CheckBlock (Message$, Status, Ptr, CRCTable%()) DECLARE SUB flushbuf () 'Flushes COM buffer DECLARE SUB Immediate (CRCTable%(), PromptData$()) 'Direct file transfer sub DECLARE SUB Logon (X) 'Auto-logon routine DECLARE SUB MakeCRCTable (CRCTable%()) 'Builds CRC value table DECLARE SUB XModemSub (CRCTable%()) 'XModem handler '----- QuickBASIC Functions DECLARE FUNCTION CRCCalc$ (A) 'CRC value function DECLARE FUNCTION FiltInp$ (InString$) 'Filters out special characters DECLARE FUNCTION GetString% (SearchSt$, ExitCode) 'Finds ID/Password/Etc. DECLARE FUNCTION GetKey$ () 'get single key ON ERROR GOTO ErrorCheck 'Directs errors to trap area '----- Set up shared variables DIM SHARED ACK$, CAN$, EOT$, NAK$, SOH$, BlockOk, CurBlk&, ComSpec$ DIM SHARED Phone$, DialCmd$, ErrCount, ID$, Password$, Quit$ DIM SHARED DirectFlag%, FileName$, NoGo%, SeeInput%, MiscFlag% '----- Set program constants ACK$ = CHR$(6) 'Acknowledge Character CAN$ = CHR$(24) 'Cancel transmission EOT$ = CHR$(4) 'End of Transmission NAK$ = CHR$(21) 'Negative Acknowledge SOH$ = CHR$(1) 'Start of Header Quit$ = CHR$(0) + CHR$(46) 'Abort File Character ALT-C Do800 = 0 DefaultPhone$ = "1 800 346 3247" SeeInput% = 0 'Flag to tell getstring to echo ' modem input DEF SEG = 0 IF PEEK(&H463) <> &HB4 THEN COLOR 14, 1 'Set colors of display ELSE COLOR 7, 0 END IF DEF SEG REDIM PromptData$(7, 2) 'Array for direct download Commands REDIM SHARED LogonData$(3, 2) 'Array for logon commands REDIM CRCTable%(255) 'Dim an array for CRC value table CALL MakeCRCTable(CRCTable%()) 'Fill the table ComSpec$ = "COM1:1200,E,7,1,BIN,CS0" 'default settings ' note: use "1200,N,8,1,BIN,CS0" after joining PC MagNet DialCmd$ = "ATDT" 'Hayes command for Tone dialing '----- Clear screen and display help and logo CLS CALL PrintLogo GOSUB ScriptData 'Load array of direct download commands '============ Open & retrieve configuration FileSpec$ = "PCAccess.CNF" 'File spec for configuration ConfigOpen% = -1 'Flag for error handling OPEN FileSpec$ FOR INPUT AS #4 'retrieve configuration LINE INPUT #4, ComSpec$ LINE INPUT #4, DialCmd$ LINE INPUT #4, Phone$ LINE INPUT #4, ID$ LINE INPUT #4, Password$ LINE INPUT #4, Setup$ LINE INPUT #4, ShellFile$ CLOSE #4 GOTO OpenSerialPort 'Jump over config stuff GetConfig: 'Label for error return on above open GOSUB FirstTime 'No .CNF file, then prompt for info '----- Open the COM port OpenSerialPort: ConfigOpen% = 0 'Reset error handling on file not found VIEW PRINT 1 TO 25 'Allow full screen printing CLS 'Clear old junk CALL PrintLogo 'Print logo and help LOCATE 1, 60, 1 'Print current comspec PRINT LEFT$(ComSpec$, 15) VIEW PRINT 5 TO 25 'Use area between lines 4 and 25 OPEN ComSpec$ FOR RANDOM AS #1 'Open communications buffer 'Put additional set-up here if needed IF LEN(Setup$) THEN 'Allow user to specify setup string PRINT #1, Setup$ ELSE PRINT #1, "ATZ" 'Reset modem END IF PRINT "Setting up Modem" Ok = GetString%("OK", ExitCode%) 'Hold until modem returns an OK IF Ok THEN PRINT "Modem Ready" 'If OK then print modem ready ELSE PRINT "Modem not responding" 'otherwise alert user PRINT "press ALT-X to quit" Do800 = 0 END IF IF Do800 THEN 'If needed, go for the number CALL Call800 Do800 = 0 GOTO InputLoop END IF IF INSTR(COMMAND$, "I") THEN 'Direct download from command line DirectFlag% = 1 ' "I" on command line CALL Immediate(CRCTable%(), PromptData$()) IF NoGo% THEN PRINT #1, "BYE" 'Optional one shot download END IF '----- Main input handler InputLoop: 'Input/Output loop DO I$ = INKEY$ 'Get keystroke from keyboard IF LEN(I$) THEN 'See if anything was entered I = ASC(RIGHT$(I$, 1)) 'Normal keys return LEN=1, extended IF LEN(I$) = 2 THEN I = -I ' keys return LEN=2 'Set extended scan code to -number SELECT CASE I 'Check for special keys CASE -23 'Immediate mode downloads directly DirectFlag% = -1 CALL Immediate(CRCTable%(), PromptData$()) CASE -45 'Alt-X EXIT DO CASE -32 'Alt-D - Dial a number CALL Logon(0) ' and do autologon PRINT CASE -38 'Alt-L - Just do autologon CALL Logon(-1) PRINT CASE -19 'Alt-R - Receive a file via XModem CALL XModemSub(CRCTable%()) CASE -31 'ALT-S Set up configuration ReConfig% = -1 EXIT DO CASE -49 'ALT-N get CIS Numbers X% = INSTR(ComSpec$, "N,8") IF X% THEN MID$(ComSpec$, X%, 3) = "E,7" 'retread comspec for CIS CLOSE #1 OPEN ComSpec$ FOR RANDOM AS #1 END IF CALL Call800 PRINT CASE -35 'ALT-H hang up PRINT #1, "+++"; FOR X = 1 TO 3 CALL HalfSec NEXT X PRINT #1, "ATH" CASE -59 'F1 - additional Help PRINT "F2 - Current Settings F3 - Shell to DOS F4 - Open/Close Logfile" CASE -60 'F2 - show current settings of CALL CurSettings 'phone-id-etc.. CASE -61 'F3 - shell to dos VIEW PRINT 1 TO 25 'Allow full screen printing CLS 'Clear old junk IF LEN(ShellFile$) THEN SHELL ShellFile$ 'The 'ol shell game ELSE SHELL END IF CLS 'cleanup on return CALL PrintLogo 'Print logo and help LOCATE 1, 60, 1 'Print current comspec PRINT LEFT$(ComSpec$, 15) VIEW PRINT 5 TO 25 'Use area between lines 4 and 25 CASE -62 'F4 - open/close log file PRINT #1, CHR$(19); IF LogIt% THEN IF BufPtr% THEN X$ = LEFT$(Buffer$, BufPtr%) PUT #6, , X$ END IF CLOSE #6 PRINT "Log file closed " LogIt% = 0 ELSE LINE INPUT "Enter Log File Name "; LogFile$ IF LEN(LogFile$) THEN OPEN LogFile$ FOR BINARY AS #6 PRINT "Log File "; LogFile$; " Opened " LogIt% = -1 BufSize% = 512 Buffer$ = SPACE$(BufSize%) BufPtr% = 1 END IF END IF PRINT #1, CHR$(17); CASE ELSE 'Send anything else to the modem PRINT #1, I$; 'Semi-colon prevents sending CR/LF END SELECT END IF IF NOT EOF(1) THEN 'Check the modem for characters Minput$ = INPUT$(LOC(1), #1) 'LOC(1) = # of characters in buffer PRINT FiltInp$(Minput$); 'Print filtered input IF LogIt% THEN 'Log to file MID$(Buffer$, BufPtr%) = Minput$ 'Use a pointer to track input BufPtr% = BufPtr% + LEN(Minput$) ' Mid$ is faster than IF BufPtr% > BufSize% THEN ' concatinating strings PRINT #1, CHR$(19); ' Send an XOFF while we save X$ = LEFT$(Buffer$, BufPtr%) 'PUT needs a real string PUT #6, , X$ 'PUT Latest BufPtr% = 1 'Reset Pointer PRINT #1, CHR$(17); 'Send XON to resume END IF END IF END IF LOOP 'Keep looping until we want to end CLOSE IF ReConfig% THEN 'Setup flag GOSUB FirstTime 'Go get Setup info ReConfig% = 0 GOTO OpenSerialPort END IF END ErrorCheck: SELECT CASE ERR 'Not all these error codes are needed ' Ones with * are recommended CASE 24 '* Modem probably wasn't connected PRINT "Device Timeout!" ' to phone line CASE 52 'Probably asked for COM port that PRINT "Bad File Name!" ' didn't exist (ie. COM3:) CASE 53 'Use this if you modify for uploading IF ConfigOpen% THEN RESUME GetConfig PRINT "File not found! " ' downloading doesn't need it CASE 57 '* Trap I/O error Err57% = Err57% + 1 'and give it slack before reporting it IF Err57% > 5 THEN 'to avoid errors when exiting PRINT "Device I/O Error!" 'More than 5, report it Err57% = 0 END IF CASE 61 '* Bad error when downloading PRINT "Disk full!" 'Try to start with enough room CASE 68 PRINT "Device Unavailable! " '* COM port doesn't exist, or under CASE 69 'this is a fatal error PRINT "Buffer Overflow - Fatal " CLOSE END CASE 71 '* Tried to access disk with open PRINT "Drive not ready!" ' drive door CASE 75 PRINT "Path/File access error" CASE 76 '* PRINT "Path not found" CASE ELSE '* Do it yourself error lookup PRINT "Error "; ERR; " Occurred" END SELECT IF INKEY$ <> "" THEN END 'Unconditional bail out on any error RESUME FirstTime: 'Setup information prompts PRINT "Configuration:" PRINT PRINT "Which Com Port is your modem on ? (1/2) "; IF GetKey$ = "2" THEN Port$ = "COM2:" ELSE Port$ = "COM1:" IF MiscFlag% THEN RETURN 'ESC pressed, bag out PRINT "one or

ulse dialing "; IF GetKey$ = "P" THEN DialCmd$ = "ATDP" ELSE DialCmd$ = "ATDT" IF MiscFlag% THEN RETURN 'ESC pressed, bag out PRINT "Select Baud Rate: " PRINT "1 - 300 " PRINT "2 - 1200" PRINT "3 - 2400" SELECT CASE GetKey$ CASE "1" Baud$ = "300" CASE "3" Baud$ = "2400" CASE ELSE Baud$ = "1200" END SELECT IF MiscFlag% THEN RETURN 'ESC pressed, bag out PRINT "Select Com specs - 7 bits when signing up, 8 bits for regular use" PRINT "1 - 7 bits, E parity, 1 stop" PRINT "2 - 8 bits, N parity, 1 stop" IF GetKey$ = "2" THEN Bits$ = ",N,8,1" ELSE Bits$ = ",E,7,1" IF MiscFlag% THEN RETURN 'ESC pressed, bag out PRINT "If you need to find your local PC MagNet phone number" PRINT "press enter for the following prompts" LINE INPUT "Enter your local phone number "; Phone$ IF Phone$ = "" THEN Phone$ = DefaultPhone$ LINE INPUT "Enter your ID "; ID$ IF ID$ = "" THEN ID$ = "177000,5000" LINE INPUT "Enter your Password "; Password$ IF Password$ = "" THEN Password$ = "PC*MAGNET" LINE INPUT "Enter Modem Initialization string "; Setup$ LINE INPUT "Enter Shell program to run "; ShellFile$ IF Phone$ = DefaultPhone$ THEN PRINT "Do you wish to call Compuserve's phone number service now? Y/N" IF GetKey$ = "Y" THEN Bits$ = ",E,7,1" 'Force 7 bits for CIS ComSpec$ = Port$ + Baud$ + Bits$ + ",BIN,CS0" Do800 = -1 GOTO SaveConfig END IF END IF ComSpec$ = Port$ + Baud$ + Bits$ + ",BIN,CS0" CALL CurSettings 'Print settings PRINT "Is this correct ? Y/N or ESC to cancel changes"; IF GetKey$ = "N" THEN GOTO FirstTime IF MiscFlag% THEN RETURN 'ESC pressed, bag out SaveConfig: PRINT "Saving configuration " OPEN "PCAccess.CNF" FOR OUTPUT AS #4 PRINT #4, ComSpec$ PRINT #4, DialCmd$ PRINT #4, Phone$ PRINT #4, ID$ PRINT #4, Password$ PRINT #4, Setup$ PRINT #4, ShellFile$ CLOSE #4 RETURN '================== ScriptData: RESTORE DirData ' FOR X% = 1 TO 7 'Read download data into array READ PromptData$(X%, 1) 'Read 'wait for' prompt READ PromptData$(X%, 2) 'Read 'answer' value NEXT X% RESTORE LogData FOR X% = 1 TO 3 'Read download data into array READ LogonData$(X%, 1) 'Read 'wait for' prompt READ LogonData$(X%, 2) 'Read 'answer' value NEXT X% RETURN DirData: 'direct download commands DATA !,GO UTILITIES,!,4,"):",,"):",Y,,,transfer!,1,complete,, LogData: DATA ":",CIS,":",,":",, ' LogonData$ # 2,2 & 3,2 will be filled in later SUB AbortFile (FileName$) STATIC CALL flushbuf 'Wait for clear line PRINT #1, CAN$; CAN$; CAN$; 'Send Cancel signal PRINT "*** File Aborted ***" 'Alert user CLOSE #2 'Close file END SUB SUB Call800 PRINT "This will call PC MagNets Phones service" PRINT "Follow instructions and make a note of your local phone number" PRINT "After you have logged off, press Alt-S to update your configuration" PRINT PRINT "Calling 1-800-346-3247" T! = TIMER CALL HalfSec Temp$ = DialCmd$ + "1 800 346 3247" PRINT #1, DialCmd$ + "1 800 346 3247" FOR X = 1 TO 10 Ok = GetString%("CONNECT", ExitCode) IF Ok THEN CALL HalfSec PRINT "Connected to CIS phone service" PRINT #1, CHR$(13) EXIT FOR END IF IF ExitCode THEN PRINT "No Answer" EXIT SUB END IF NEXT X FOR X = 1 TO 5 Ok = GetString%("Name:", ExitCode) IF Ok THEN PRINT #1, "Phones" PRINT "You're on, just follow instructions" EXIT SUB END IF NEXT X PRINT "PC MagNet Phones service not answering" END SUB SUB CheckBlock (Message$, Status%, Ptr%, CRCTable%()) STATIC 'Status = 1-OK get more (saved) ' 2-Retry block ' 3-Sender Abort ' 4-End of file (close) BlockOk% = 0 SELECT CASE LEFT$(Message$, 1) 'Check for: CASE EOT$ 'End of Transmission (good) Status% = 4 EXIT SUB CASE CAN$ 'Canceled by sender (not so good) Status% = 3 EXIT SUB CASE IS <> SOH$ 'Start Of Header bad (out of sync) IF Ptr% < 10 AND CurBlk& = 1 THEN 'probably start of file PRINT #1, "C"; 'So signal again Status% = 2 'Set Status for retry ErrCount% = ErrCount% + 1 'bump error count EXIT SUB END IF Status% = 1 'Bad block PRINT "SOH error" 'Report type of error CALL flushbuf 'Clear modem buffer CASE ELSE 'Check current block # vs sent block # BlockOk% = ((CurBlk& AND 255) = ASC(MID$(Message$, 2, 1))) BlockOk% = ((ASC(MID$(Message$, 2, 1)) XOR 255) = (ASC(MID$(Message$, 3, 1)))) IF BlockOk% THEN CRC$ = CHR$(0) + CHR$(0) 'Message CRC created in this routine FOR MG% = 4 TO 131 'Each character is considered and ' CRC on total message is created CRCH1 = ASC(LEFT$(CRC$, 1)) CRCL2 = CVI(CHR$(0) + RIGHT$(CRC$, 1)) CRC1$ = MKI$(CRCTable%(CRCH1 XOR ASC(MID$(Message$, MG%, 1))) XOR CRCL2) CRC$ = RIGHT$(CRC1$, 1) + LEFT$(CRC1$, 1) NEXT MG% Status% = 1 'Preset status to get next block 'Compare calculated CRC with sent CRC IF CRC$ = MID$(Message$, 132, 2) THEN BlockOk% = -1 'It is good! ELSE PRINT "CRC error" 'It is not good BlockOk% = 0 Status% = 0 END IF ELSE Status% = 1 PRINT "Block ID error" END IF END SELECT IF NOT BlockOk% THEN 'If block is bad then ErrCount% = ErrCount% + 1 ' bump error count, and report the ' block number that is at fault PRINT "*** Error - Block #"; CurBlk& PRINT "*** Error count "; ErrCount% PLAY "L16O3EC" END IF END SUB FUNCTION CRCCalc$ (A%) 'Don't make this SUB STATIC! HiCrc% = HiCrc% XOR A% LoCrc% = 0 FOR CT% = 0 TO 7 'Do the calculation Carry = 0 'Clear carry bit IF HiCrc > 127 THEN Carry = -1 'Is High bit on in CRC? HiCrc = (HiCrc * 2) AND 255 'Shift High byte left 1 bit IF LoCrc > 127 THEN HiCrc = HiCrc + 1 'Carry bit from LoCRC to Hi LoCrc = (LoCrc * 2) AND 255 'Shift Low byte left 1 bit IF Carry THEN 'If not carry then skip this HiCrc = HiCrc XOR 16 '&H10 in hex LoCrc = LoCrc XOR 33 '&H21 END IF NEXT CT% 'Go get another shift CRCCalc$ = CHR$(LoCrc) + CHR$(HiCrc) 'Assign function = CRC END FUNCTION SUB CurSettings PRINT STRING$(40, "=") PRINT " Phone : "; Phone$ PRINT " ID : "; ID$ PRINT "Password : "; Password$ PRINT "ComSpecs : "; ComSpec$ 'Port$ + Baud$ + Bits$ IF LEN(Setup$) THEN PRINT "Modem setup :"; Setup$ IF LEN(ShellFile$) THEN PRINT "Shell Program :"; ShellFile$ PRINT STRING$(40, "=") END SUB FUNCTION FiltInp$ (InString$) STATIC DO 'Converts backspace BackSpace = INSTR(InString$, CHR$(8)) 'Characters to left arrows IF BackSpace THEN MID$(InString$, BackSpace) = CHR$(29) END IF LOOP WHILE BackSpace '----- Strip out any line feed characters DO LineFeed = INSTR(InString$, CHR$(10)) IF LineFeed THEN InString$ = LEFT$(InString$, LineFeed - 1) + MID$(InString$, LineFeed + 1) END IF LOOP WHILE LineFeed FiltInp$ = InString$ END FUNCTION SUB flushbuf IF LOF(1) THEN DO UNTIL EOF(1) 'Flush buffer Junk$ = INPUT$(1, 1) 'Input into dummy string LOOP END IF END SUB FUNCTION GetKey$ A$ = "" WHILE A$ = "" 'Loop until we get a key A$ = UCASE$(INKEY$) WEND IF A$ = CHR$(27) THEN MiscFlag% = -1 ELSE MiscFlag% = 0 PRINT A$ END IF GetKey$ = A$ END FUNCTION FUNCTION GetString% (SearchSt$, ExitCode%) STATIC GetString% = 0 'Preset function value Timeout! = TIMER + 5 'Set a retry timeout Minput$ = "" 'Clear input string DO 'Press any key to bail out IF INKEY$ <> "" THEN ExitCode% = -1 EXIT FUNCTION END IF IF TIMER > Timeout! THEN 'Did we time out looking IF INSTR(Minput$, "MORE !") THEN ' for prompt only to be PRINT #1, CHR$(13); ' thwarted by a MORE ! Timeout! = TIMER + 5 'Yes, reset timer and do it ELSE EXIT FUNCTION 'Bail out on timeout END IF END IF IF TIMER > Timeout! THEN EXIT FUNCTION 'Bail out on timeout IF LOC(1) THEN I$ = INPUT$(LOC(1), 1) 'Get modem input IF SeeInput% THEN PRINT I$; Minput$ = Minput$ + I$ END IF LOOP UNTIL INSTR(Minput$, SearchSt$) 'Keep getting until a match PRINT GetString% = -1 'Success!!! END FUNCTION SUB HalfSec T! = TIMER WHILE TIMER < T! + .5 WEND END SUB SUB Immediate (CRCTable%(), PromptData$()) PRINT "Immediate Mode - Enter file to download: "; INPUT FileName$ 'Prompt user for file to download PRINT "Exit PC MagNet when done ? " IF GetKey$ = "N" THEN NoGo% = 0 ELSE NoGo% = -1 IF FileName$ = "" THEN GOTO OutHere 'Allow exit PRINT "Press ENTER to quit" PromptData$(3, 2) = FileName$ 'Assign array element to filename$ IF DirectFlag% = 1 THEN 'If started with an I on command line CALL Logon(0) ' then log on to PC MagNet ELSE 'Otherwise PRINT #1, "GO PCM-1" ' go to Main screen to start END IF FOR X% = 1 TO 7 'Loop through commands DO 'Do this until we receive a prompt IF ExitCode THEN GOTO OutHere ' or an exit code Ok = GetString%(PromptData$(X%, 1), ExitCode) IF Ok THEN PRINT PromptData$(X%, 2) 'Echo to screen to show were active PRINT #1, PromptData$(X%, 2) 'Send command out modem END IF LOOP UNTIL Ok 'Keep looping until valid NEXT X% Ok = GetString%(PromptData$(7, 1), ExitCode%) CALL XModemSub(CRCTable%()) 'Go download the file PRINT #1, " " 'Print a Carriage return OutHere: DirectFlag% = 0 'Reset flag for later use END SUB SUB Logon (LogOnOnly%) ExitCode% = 0 LogonData$(2, 2) = ID$ LogonData$(3, 2) = Password$ IF NOT LogOnOnly% THEN IF Phone$ = "" THEN 'Prompt if a number is not specified INPUT "Enter Number to Dial ", Phone$ IF Phone$ = "" THEN EXIT SUB END IF PRINT "*** Dialing "; Phone$ 'Dialing message PRINT #1, DialCmd$; Phone$ 'Send dial command + number to modem DO IF GetString%("CONNECT", ExitCode) THEN EXIT DO 'exit on connect I% = I% + 1 'Increment number of trys IF ExitCode THEN 'If a key was hit, exit PRINT "Aborted Logon" ' with abort message EXIT SUB END IF LOOP WHILE I% < 10 'Loop until there are too many trys IF I% = 10 THEN 'Tried too many times, exit PRINT "No answer" EXIT SUB END IF PRINT "Connected" 'Connection detected PRINT "*** Logging On ***" 'Message END IF Ok% = GetString%("CONNECT", ExitCode%) 'just a dummy to insure time on PRINT #1, "" 'Print a to port IF ID$ = "" OR Password$ = "" THEN EXIT SUB SeeInput% = -1 'watch what's happening FOR X% = 1 TO 3 'Loop through commands DO 'Do this until we receive a prompt IF ExitCode THEN PRINT "Logon aborted" GOTO OutOut ' or an exit code END IF Ok = GetString%(LogonData$(X%, 1), ExitCode) IF Ok THEN IF X > 2 THEN SeeInput% = 0 PRINT #1, LogonData$(X%, 2) 'Send command out modem END IF LOOP UNTIL Ok 'Keep looping until valid NEXT X% OutOut: END SUB SUB MakeCRCTable (CRCTable%()) STATIC FOR X% = 0 TO 255 'Assign CRC for each possible number CRCTable%(X%) = CVI(CRCCalc$(X%)) ' from 0-255 (8 bits) NEXT X% END SUB SUB PrintLogo STATIC LOCATE 1, 1, 1 'Print logo, help and comspec PRINT TAB(10); "PC Magazine - PCAccess"; PRINT "Alt-R:Receive File Alt-X:Exit Alt-D:Dial Alt-L:Log On Alt-C:Cancel Xfer"; PRINT "Alt-S:Setup Alt-H:Hangup Alt-N:Numbers (CIS Phone service)" PRINT STRING$(80, 205) END SUB SUB XModemSub (CRCTable%()) STATIC CurBlk& = 1 'Set current block to 1 BlockOk% = 0 'Clear good block flag Timeout! = 10 'Set time out (20 sec. for relaxed) ErrCount% = 0 'Clear the error counter TBlock% = 133 'Total block size CRC Abort% = 0 PRINT FileName$ IF DirectFlag% = 0 THEN INPUT ">>>> Enter file name to Receive > ", FileName$ IF FileName$ = "" THEN EXIT SUB 'User just pressed Enter END IF OPEN FileName$ FOR OUTPUT AS #2 'Open the output file PRINT "*** Sending start character ***" PRINT #1, "C"; '"C" requests CRC protocol DO IF ErrCount% > 14 THEN CALL AbortFile(FileName$) EXIT SUB 'Too many errors, exit END IF Buffer$ = SPACE$(TBlock%) 'Pad buffer to TBlock% characters FOR Ptr = 1 TO LEN(Buffer$) 'Assume we fill the whole buffer T! = TIMER 'Start a timer for timeout DO UNTIL LOC(1) 'Wait for a character to come in port IF INKEY$ = Quit$ THEN Abort% = -1 'User requested abort 'Short timeout for EOT IF LEFT$(Buffer$, 1) = EOT$ AND TIMER > T! + 3 THEN EXIT FOR 'short timeout to start IF CurBlk& = 1 AND TIMER > T! + 3 THEN EXIT FOR 'If timed out, jump out of loop IF TIMER > T! + Timeout! THEN EXIT FOR LOOP 'Put any characters into Buffer$ MID$(Buffer$, Ptr, 1) = INPUT$(1, 1) NEXT IF INKEY$ = Quit$ OR Abort% THEN 'User requesting abort CALL AbortFile(FileName$) EXIT SUB END IF CALL CheckBlock(Buffer$, Status%, Ptr%, CRCTable%()) SELECT CASE Status% CASE 1 IF BlockOk% THEN PRINT #2, MID$(Buffer$, 4, 128); 'the data block ErrCount% = 0 'Reset error count PRINT #1, ACK$; 'Signal 'OK' to sender PRINT "Block "; CurBlk&, CurBlk& * 128; " Bytes" 'update user CurBlk& = CurBlk& + 1 'Bump block count ELSE CALL flushbuf PRINT #1, NAK$ END IF CASE 3 'File aborted CALL AbortFile(FileName$) EXIT DO CASE 4 'File received okay PRINT #1, ACK$; 'Acknowledge end of file CLOSE #2 'Close output file CLS PRINT " *** End of transfer "; 'say that we're done 'How much we received PRINT ((CurBlk& - 1) * 128); " Bytes received" PRINT " File: "; FileName$; " saved" 'What was saved PRINT "Press Enter" PLAY "L16O2ECG" 'Use BEEP with OS/2 EXIT DO ' CASE ELSE 'Either retry or resend END SELECT LOOP END SUB