home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
TURBOPAS
/
PMODEM.ARK
/
RECEIVE.INC
< prev
next >
Wrap
Text File
|
1987-02-22
|
5KB
|
170 lines
{********** 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+}