{********** receive.inc **********} { receive file } procedure receive_a_file; label re_nameit, retry, loop1, loop2; var local, local1, other, inch : char; opening : integer; block_string : datab; buffer: array[1..128] of byte; blocknum, tries, loop : integer; comp, locblock, crc2 : integer; fatal, error, done, crcON : boolean; successful : boolean; hicrc, csum2, mode, locrc : byte; function acknakout(ch : byte): boolean; var times, loops: integer; begin times := 0; repeat loops := 0; xmit(ch); while (loops < 10) {and not timedin} do loops := loops + 1; times := times + 1; until modem_in_ready or (times > 9) or not carrier; acknakout := modem_in_ready and carrier; end; function recchar(var error: boolean): char; var temp: char; begin temp := '0'; recchar := temp; if not carrier then error := true; { if not timedin then error := true } repeat sinp(temp); if temp = CAN then error:= true; until modem_in_ready or error; if not error then temp := modem_in; calcCRC(ord(temp)); recchar := temp; end; begin {receive_a_file} write('RECEIVE file '); delete(line,1,1); if upCase(line[1]) = 'C' then begin crcON:= false; writeln('(checksum)'); end else begin crcON:= true; writeln('(CRC)'); end; writeln; timein; re_nameit: write('Enter NAME of file to recieve: '); readln(temp1); upper(temp1); if temp1[1] in [^@..' '] then temp1:= ''; if length(temp1)>0 then sourceName:= temp1 else begin writeln; goto loop2; end; Bdos(13); {reset drive} if findfile(sourceName) then begin writeln('++ file ', sourceName, ' exists ++'); goto re_nameit; end; openFile(sourceName); tries := 0; done := false; opening := 0; locblock := 1; {$I-} fatal := ioresult > 0; if fatal then goto loop2; if crcON then mode := ord('C') else mode := ord(nak); xmit(mode); xmit(mode); repeat tries := tries + 1; error := false; repeat opening := ord(recchar(error)); until (opening in [ord(soh), ord(eot), ord(can)]) or error; if opening = ord(can) then fatal := true; if opening = ord(eot) then done := true; if opening = ord(soh) then error:= false; { do the block } if not (error or fatal or done) then begin blocknum := ord(recchar(error)); comp := ord(recchar(error)); if (comp + blocknum) = 255 then begin crc := 0; checksum := 0; for loop:= 1 to 128 do begin buffer[loop] := ord(recchar(error)); if error then begin fatal:= true; goto loop2; end; end; end else error:= true; end; if not (error or fatal or done) then begin {check CRC/checksum} calcCRC(0); calcCRC(0); crc2:= crc; csum2:= checksum; hicrc := ord(recchar(error)); if crcON then begin locrc := ord(recchar(error)); if (lo(crc2) <> locrc) or (hi(crc2) <> hicrc) then error := true; end else if csum2 <> hicrc then error := true; end; if (lo(locblock) <> blocknum) {verify block number} and (lo(locblock) <> lo(blocknum+1)) then error := true; if not (error or fatal or done) then begin {save the block} blockwrite(sourceFile, buffer, 1); if IOresult <> 0 then fatal := true; write(cr, locblock); clrEol; xmit(ord(ack)); end; if not (error or fatal or done) then begin {get ready for next block} tries := 0; locblock := locblock + 1; end; { end of block } if error then begin {show error} write('.'); xmit(ord(nak)); tries:= tries + 1; { if tries > 6 then crcON := not crcON; } end; if fatal then xmit(ord(can)); if done then xmit(ord(ack)); until done or fatal or not carrier; LOOP2: close(sourceFile); successful := (IOresult = 0) and done and not fatal; writeln(BELL); if successful then writeln('++ transfer completed ++') else begin erase(sourceFile); writeln('++ transfer aborted ++'); end; eraseOK:= false; writeln; terminal_mode; end; {recieve_a_file} {$I+}