{ ROSRCV.INC - Remote Operating System File Receive Routines } overlay procedure RecvXmodem; { Receive a file using Xmodem protocol } const maxerr = 10; { Max errors during transfer } start_err = 25; { Max errors starting transfer } var i, block, mm, ss: integer; XfrName: FileName; XfrFile: untype_file; procedure RecvFile; var CRCmode, timeout, EndOfFile, write_err: boolean; bt: byte; ch: char; errcnt: integer; procedure RecvBlock; var blocknum, blockcpl: byte; mv, vv: integer; begin blocknum := GetByte(1, timeout); { Get header } blockcpl := not GetByte(1, timeout); for i := 1 to 128 do { Get block } Buffer[i] := GetByte(1, timeout); mv := GetByte(1, timeout); { Get verification byte(s) } if CRCmode then mv := swap(mv) or GetByte(1, timeout); OK := (blocknum = blockcpl); if OK then begin OK := (blocknum = lo(block)); if OK then begin vv := 0; if CRCmode then begin for i := 1 to 128 do updcrc(vv, Buffer[i]); updcrc(vv, 0); updcrc(vv, 0) end else begin for i := 1 to 128 do vv := vv + Buffer[i]; vv := lo(vv) end; OK := (mv = vv); if OK then begin {$I-} blockwrite(XfrFile, Buffer, BufBlocks) {$I+}; write_err := (IOresult = 0); OK := write_err; if not OK then write(' ++ Disk or directory full') end else if CRCmode then write(' ++ CRC failed') else write(' ++ Checksum failed') end else begin OK := (blocknum = lo(pred(block))); if not OK then write(' ++ Block number') end end else write(' ++ Block complement mismatch'); end; begin { RecvFile } writeln(USR, XfrName, ' will be received in a private area.'); writeln(USR, diskfree, 'k disk space available. Please cancel if file is too large.'); writeln(USR, 'To cancel, type CTL-X.'); writeln(USR, 'Ready to receive...'); OK := FALSE; EndOfFile := FALSE; CRCmode := TRUE; errcnt := 0; block := 1; repeat bt := GetByte(4, timeout); if timeout then begin errcnt := succ(errcnt); if errcnt > 5 { Try CRC 5 times (20 sec) } then CRCmode := not CRCmode; { then alternate mode } if CRCmode then PutByte(ord('C')) else PutByte(ord(NAK)) end { SOH and EOT must be solicited to be valid, but CAN may be sent anytime } until ((errcnt > 0) and (bt in [ord(SOH), ord(EOT)])) or (bt = ord(CAN)) or (errcnt >= start_err); if errcnt >= start_err then errcnt := maxerr else errcnt := 0; while (not EndOfFile) and (errcnt < maxerr) do begin case chr(bt) of SOH: begin RecvBlock; ch := GetChar; { Monitor local console } if OK then begin if block = 1 then if CRCmode then writeln('CRC mode selected.') else writeln('Checksum mode selected.'); write(CR, 'Block received: ', block); block := succ(block); errcnt := 0; PutByte(ord(ACK)) end else begin errcnt := succ(errcnt); writeln(' - error ', errcnt, ' ++'); if write_err then begin errcnt := maxerr; PutByte(ord(CAN)) end else PutByte(ord(NAK)) end end; EOT: begin EndOfFile := TRUE; PutByte(ord(ACK)) end; CAN: begin OK := FALSE; errcnt := maxerr end; else begin OK := FALSE; if timeout then write(' ++ Timeout') else begin write(' ++ Received ', bt, ', not SOH'); repeat { Wait for junk to finish } bt := GetByte(1, timeout) until timeout end; errcnt := succ(errcnt); writeln(' - error ', errcnt, ' ++'); if errcnt < maxerr then PutByte(ord(NAK)) end end; if (not EndOfFile) and (errcnt < maxerr) then bt := GetByte(10, timeout) end; bt := GetByte(2, timeout); writeln(USR) end; begin { RecvXmodem } XfrName := correct_fn(prompt('File name', 12, 'ES')); if XfrName <> '' then begin while (length(XfrName) - pos('.', XfrName)) < 2 do XfrName := XfrName + '-'; log(4, XfrName); SetSect(RcvDrv, RcvUsr); Assign(XfrFile, XfrName); {$I-} Reset(XfrFile) {$I+}; { Ensure file doesn't already exist } OK := (IOresult <> 0); if OK then begin {$I-} Rewrite(XfrFile) {$I+}; { Try to open file } OK := (IOresult = 0); if OK then begin RecvFile; Close(XfrFile); if OK then OK := (FileSize(XfrFile) > 0); if OK then hide_release(XfrName, private) else begin Erase(XfrFile); writeln(USR, 'Transfer cancelled. Incomplete file deleted.') end end else writeln(USR, 'Cannot create ', XfrName, '.') end else begin Close(XfrFile); writeln(USR, XfrName, ' already exists in destination area.'); writeln(USR, 'Please select another name.') end; SetSect(HomDrv, HomUsr); if OK then begin log(7, ''); send_time(block, mm, ss); extra_time := extra_time + mm; user_rec.upload := succ(user_rec.upload); writeln(USR, 'Transfer complete.'); writeln(USR, 'Please enter a one line description of your file:'); writeln(USR); writeln(USR, ' |------------------------------------------------|'); with nwin_rec do begin status := private; name := XfrName; GetTAD(date); user := user_loc; descr := prompt('', 50, 'E') end; seek(nwin_file, FileSize(nwin_file)); write(nwin_file, nwin_rec); writeln(USR, 'Thanks, ', user_rec.fn, '!') end else log(8, '') end end;