home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / pmodem.ark / RECEIVE.INC < prev    next >
Encoding:
Text File  |  1987-02-22  |  4.5 KB  |  170 lines
  1. {********** receive.inc **********}
  2.           { receive file }
  3.  
  4. procedure receive_a_file;
  5. label re_nameit, retry, loop1, loop2;
  6. var
  7.   local, local1, other, inch : char;
  8.   opening : integer;
  9.   block_string : datab;
  10.   buffer: array[1..128] of byte;
  11.  
  12.   blocknum, tries, loop : integer;
  13.   comp, locblock, crc2     : integer;
  14.   fatal, error, done, crcON  : boolean;
  15.   successful               : boolean;
  16.   hicrc, csum2, mode, locrc : byte;
  17.  
  18.   function acknakout(ch : byte): boolean;
  19.     var  times, loops: integer;
  20.     begin
  21.       times := 0;
  22.       repeat
  23.         loops := 0;
  24.         xmit(ch);
  25.         while (loops < 10) {and not timedin} do loops := loops + 1;
  26.         times := times + 1;
  27.       until modem_in_ready or (times > 9) or not carrier;
  28.       acknakout := modem_in_ready and carrier;
  29.     end;
  30.  
  31. function recchar(var error: boolean): char;
  32.     var temp: char;
  33.     begin
  34.       temp := '0';  recchar := temp;
  35.       if not carrier then error := true;
  36.       {  if not timedin then error := true }
  37.       repeat
  38.         sinp(temp);
  39.         if temp = CAN then error:= true;
  40.       until modem_in_ready or error;
  41.       if not error then temp := modem_in;
  42.       calcCRC(ord(temp));
  43.       recchar := temp;
  44.     end;
  45.  
  46. begin  {receive_a_file}
  47.   write('RECEIVE file ');
  48.   delete(line,1,1);
  49.   if upCase(line[1]) = 'C' then begin
  50.      crcON:= false;
  51.      writeln('(checksum)');
  52.   end
  53.   else begin
  54.      crcON:= true;
  55.      writeln('(CRC)');
  56.   end;
  57.   writeln;
  58.   timein;
  59. re_nameit:
  60.   write('Enter NAME of file to recieve: ');
  61.   readln(temp1); upper(temp1);
  62.   if temp1[1] in [^@..' '] then temp1:= '';
  63.   if length(temp1)>0 then sourceName:= temp1
  64.   else begin
  65.     writeln;
  66.     goto loop2;
  67.   end;
  68.   Bdos(13);  {reset drive}
  69.   if findfile(sourceName) then begin
  70.     writeln('++ file ', sourceName, ' exists ++');
  71.     goto re_nameit;
  72.   end;
  73.   openFile(sourceName);
  74.   tries := 0;
  75.   done := false;
  76.   opening := 0;
  77.   locblock := 1;
  78.  
  79. {$I-}
  80.   fatal := ioresult > 0;
  81.   if fatal then goto loop2;
  82.   if crcON then mode := ord('C') else mode := ord(nak);
  83.   xmit(mode);  xmit(mode);
  84.  
  85.   repeat
  86.     tries := tries + 1;
  87.     error := false;
  88.     repeat
  89.       opening := ord(recchar(error));
  90.     until (opening in [ord(soh), ord(eot), ord(can)]) or error;
  91.  
  92.     if opening = ord(can) then fatal := true;
  93.     if opening = ord(eot) then done := true;
  94.     if opening = ord(soh) then error:= false;
  95.  
  96.     { do the block }
  97.        if not (error or fatal or done) then begin
  98.        blocknum := ord(recchar(error));
  99.        comp := ord(recchar(error));
  100.        if (comp + blocknum) = 255 then begin
  101.           crc := 0;
  102.           checksum := 0;
  103.           for loop:= 1 to 128 do begin
  104.             buffer[loop] := ord(recchar(error));
  105.             if error then begin
  106.               fatal:= true;
  107.               goto loop2;
  108.             end;
  109.           end;
  110.        end else error:= true;
  111.        end;
  112.  
  113.        if not (error or fatal or done) then begin   {check CRC/checksum}
  114.           calcCRC(0);
  115.           calcCRC(0);
  116.           crc2:= crc;
  117.           csum2:= checksum;
  118.           hicrc := ord(recchar(error));
  119.           if crcON then begin
  120.             locrc := ord(recchar(error));
  121.             if (lo(crc2) <> locrc) or (hi(crc2) <> hicrc) then error := true;
  122.           end
  123.           else if csum2 <> hicrc then error := true;
  124.        end;
  125.  
  126.        if (lo(locblock) <> blocknum)   {verify block number}
  127.           and (lo(locblock) <> lo(blocknum+1))
  128.             then error := true;
  129.  
  130.        if not (error or fatal or done) then begin   {save the block}
  131.           blockwrite(sourceFile, buffer, 1);
  132.           if IOresult <> 0 then fatal := true;
  133.           write(cr, locblock);  clrEol;
  134.           xmit(ord(ack));
  135.        end;
  136.  
  137.        if not (error or fatal or done) then begin  {get ready for next block}
  138.           tries := 0;
  139.           locblock := locblock + 1;
  140.        end;
  141.  
  142.     { end of block }
  143.  
  144.     if error then begin   {show error}
  145.        write('.');
  146.        xmit(ord(nak));
  147.        tries:= tries + 1;
  148.     {  if tries > 6 then crcON := not crcON; }
  149.     end;
  150.  
  151.     if fatal then xmit(ord(can));
  152.     if done then xmit(ord(ack));
  153.  
  154.   until done or fatal or not carrier;
  155.  
  156. LOOP2:
  157.   close(sourceFile);
  158.   successful := (IOresult = 0) and done and not fatal;
  159.   writeln(BELL);
  160.   if successful then writeln('++ transfer completed ++')
  161.   else begin
  162.     erase(sourceFile);
  163.     writeln('++ transfer aborted ++');
  164.   end;
  165.   eraseOK:= false;
  166.   writeln;
  167.   terminal_mode;
  168. end; {recieve_a_file}
  169.  
  170. {$I+}