home *** CD-ROM | disk | FTP | other *** search
/ Shareware 1 2 the Maxx / sw_1.zip / sw_1 / PROGRAM / PCL4P30.ZIP / XYMODEM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-18  |  10KB  |  341 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*  This program is donated to the Public    *)
  4. (*  Domain by MarshallSoft Computing, Inc.   *)
  5. (*  It is provided as an example of the use  *)
  6. (*  of the Personal Communications Library.  *)
  7. (*                                           *)
  8. (*********************************************)
  9.  
  10. {$DEFINE DEBUG}
  11.  
  12. unit xymodem;
  13.  
  14. interface
  15.  
  16. uses xypacket,term_io,PCL4P;
  17.  
  18. function TxyModem(
  19.          Port     : Integer;     (* COM port [0..3] *)
  20.      Var Filename : String20;    (* filename buffer *)
  21.      Var Buffer   : BufferType;  (* 1024 byte data buffer *)
  22.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  23.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  24.        : Boolean;
  25.  
  26. function RxyModem(
  27.          Port     : Integer;        (* COM port [0..3] *)
  28.      Var Filename : String20;       (* filename buffer *)
  29.      Var Buffer   : BufferType;     (* 1024 byte data buffer *)
  30.          CRCflag  : Boolean;        (* if TRUE, use CRC instead of checksum *)
  31.          BatchFlag: Boolean)        (* if TRUE, get filename from packet 0 *)
  32.        : Boolean;
  33.  
  34. implementation
  35.  
  36. Const ONESECOND = 18;
  37.  
  38. function TxyModem(
  39.          Port     : Integer;     (* COM port [0..3] *)
  40.      Var Filename : String20;    (* filename buffer *)
  41.      Var Buffer   : BufferType;  (* 1024 byte data buffer *)
  42.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  43.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  44.        : Boolean;
  45. Label 999;
  46. Var
  47.   i, k   : Integer;
  48.   Code   : Integer;
  49.   Flag   : Boolean;
  50.   Handle : File;
  51.   c      : Char;
  52.   Packet     : Integer;
  53.   PacketType : Char;
  54.   PacketNbr  : Byte;
  55.   BlockSize  : Word;
  56.   ReadSize   : Word;
  57.   FirstPacket: Word;
  58.   EOTflag  : Boolean;
  59.   CheckSum : Word;
  60.   Number1K : Word;       (* total # 1K ( 8 records ) packets *)
  61.   Number128 : Word;      (* total # 128 byte ( 1 record ) packets *)
  62.   CRCflag : Boolean;
  63.   FileBytes : LongInt;
  64.   RemainingBytes : LongInt;
  65.   EmptyFlag : Boolean;
  66.   Message  : String40;
  67.   Temp1 : String20;
  68.   Temp2 : String20;
  69.   Result : Word;
  70. begin
  71.  (* begin *)
  72.  Number128 := 0;
  73.  Number1K := 0;
  74.  CRCflag := FALSE;
  75.  EmptyFlag := FALSE;
  76.  EOTflag := FALSE;
  77.  if BatchFlag then
  78.    begin
  79.      if (Length(Filename)=0) then EmptyFlag := TRUE;
  80.    end;
  81.  if not EmptyFlag then
  82.    begin (* not EmptyFlag *)
  83.      (*EmptyFlag := FALSE;*)
  84. {$I-}
  85.      Assign(Handle,Filename);
  86.      Reset(Handle,1);
  87. {$I+}
  88.      if IOResult <> 0 then
  89.        begin
  90.          Message := 'Cannot open ' + Filename;
  91.          WriteMsg(Message,1);
  92.          TxyModem := FALSE;
  93.          goto 999;
  94.        end;
  95.    end; (* not EmptyFlag *)
  96.  WriteMsg('XYMODEM send: waiting for receiver ',1);
  97.  (* compute # blocks *)
  98.  if EmptyFlag then
  99.    begin (* empty file *)
  100.      Number128 := 0;
  101.      Number1K := 0
  102.    end
  103.  else
  104.    begin (* file not empty *)
  105.      FileBytes := FileSize(Handle);
  106.      RemainingBytes := FileBytes;
  107.      if OneKflag
  108.        then Number1K := FileBytes div 1024
  109.        else Number1K := 0;
  110.      Number128 := 1 + (FileBytes - 1 - 1024 * Number1K) div 128;
  111.      Str(Number1K,Temp1);
  112.      Str(Number128,Temp2);
  113.      Message := Temp1+' 1K & '+Temp2+' 128-byte packets';
  114.      WriteMsg(Message,1);
  115.    end;
  116.  (* clear comm port [there may be several NAKs queued up] *)
  117.  Code := SioRxFlush(Port);
  118.  (* get receivers start up NAK or 'C' *)
  119.  if not TxStartup(Port,CRCflag) then
  120.    begin
  121.      TxyModem := FALSE;
  122.      goto 999;
  123.    end;
  124.  (* loop over all packets *)
  125.  if BatchFlag
  126.    then FirstPacket := 0
  127.    else FirstPacket := 1;
  128.  (* transmit each packet in turn *)
  129.  for Packet := FirstPacket to Number1K+Number128 do
  130.    begin (* issue message *)
  131.      str(Packet,Temp1);
  132.      Message := 'Packet ' + Temp1;
  133.      WriteMsg(Message,1);
  134.      (* load up Buffer *)
  135.      if Packet=0 then
  136.        begin (* packet = 0 *)
  137.          if EmptyFlag then Buffer[0] := 0
  138.          else
  139.            begin (* not empty *)
  140.              (* copy filename to buffer *)
  141.              BlockSize := 128;
  142.              k := 0;
  143.              for i:= 1 to Length(Filename) do
  144.                begin
  145.                  Buffer[k] := ord(Filename[i]);
  146.                  k := k + 1;
  147.                end;
  148.              Buffer[k] := 0;
  149.              (* copy file length to buffer *)
  150.              k := k + 1;
  151.              Str(FileBytes,Temp1);
  152.              for i := 1 to Length(Temp1) do
  153.                begin
  154.                  Buffer[k] := ord(Temp1[i]);
  155.                  k := k + 1;
  156.                end;
  157.              (* pad remainder of buffer *)
  158.              for i := k to 127 do Buffer[i] := 0;
  159.            end (* not empty *)
  160.         end (* Packet = 0 *)
  161.       else
  162.         begin  (* Packet > 0 *)
  163.           (* DATA Packet: use 1K or 128-byte blocks ? *)
  164.           if BatchFlag and (Packet <= Number1K)
  165.             then BlockSize := 1024
  166.             else BlockSize := 128;
  167.           (* compute # bytes to read *)
  168.           if RemainingBytes < BlockSize then ReadSize := RemainingBytes
  169.           else ReadSize := BlockSize;
  170.           (* read next block from disk *)
  171.           BlockRead(Handle,Buffer,ReadSize,Result);
  172.           RemainingBytes := RemainingBytes - Result;
  173.           if Result <> ReadSize then
  174.             begin
  175.               WriteMsg('Unexpected EOF on disk read',1);
  176.               TxyModem := FALSE;
  177.               goto 999;
  178.             end;
  179.           (* pad short buffer with ^Z *)
  180.           if ReadSize < BlockSize then
  181.             for i:= ReadSize to Blocksize do Buffer[i] := $1A;
  182.         end; (* Packet > 0 *)
  183.      (* send this packet *)
  184.      if not TxPacket(Port,Packet,BlockSize,Buffer,CRCflag) then
  185.        begin
  186.          TxyModem := FALSE;
  187.          goto 999
  188.        end;
  189.      Code := SioDelay(5);
  190.      (* must 'restart' after non null packet 0 *)
  191.      if (not EmptyFlag) and (Packet=0) then Flag := TxStartup(Port,CRCflag);
  192.    end; (* end -- for(Packet) *)
  193.  (* done if empty packet 0 *)
  194.  if EmptyFlag then
  195.    begin
  196.      WriteMsg('Batch transfer completed',1);
  197.      TxyModem := TRUE;
  198.      goto 999;
  199.    end;
  200.  (* all done. send EOT up to 10 times *)
  201.  close(Handle);
  202.  if not TxEOT(Port) then
  203.    begin
  204.      SayError(Port,'EOT not acknowledged');
  205.      TxyModem := FALSE;
  206.      goto 999;
  207.    end;
  208.  WriteMsg('Transfer completed',1);
  209.  TxyModem := TRUE;
  210. 999: end; (* end -- TxyModem *)
  211.  
  212. function RxyModem(
  213.          Port     : Integer;        (* COM port [0..3] *)
  214.      Var Filename : String20;       (* filename buffer *)
  215.      Var Buffer   : BufferType;     (* 1024 byte data buffer *)
  216.          CRCflag  : Boolean;        (* use CRC instead of checksum *)
  217.          BatchFlag: Boolean)        (* get filename from packet 0 *)
  218.        : Boolean;
  219. Label 999;
  220. Var
  221.   i, k    : Integer;
  222.   Handle  : File;         (* file Handle *)
  223.   Packet  : Integer;      (* packet index *)
  224.   Code    : Integer;      (* return code *)
  225.   Flag    : Boolean;
  226.   EOTflag : Boolean;
  227.   Message : String40;
  228.   Temp    : String40;
  229.   Result  : Integer;
  230.   FirstPacket: Word;
  231.   PacketNbr  : Byte;
  232.   FileBytes  : LongInt;
  233.   EmptyFlag  : Boolean;
  234.   BufferSize : Word;
  235.   (* begin *)
  236. begin
  237.   EmptyFlag := FALSE;
  238.   EOTflag := FALSE;
  239.   WriteMsg('XYMODEM Receive: Waiting for Sender ',1);
  240.   (* clear comm port *)
  241.   Code := SioRxFlush(Port);
  242.   (* Send NAKs or 'C's *)
  243.   if not RxStartup(Port,CRCflag) then
  244.     begin
  245.       RxyModem := FALSE;
  246.       goto 999;
  247.     end;
  248.   (* open file unless BatchFlag is on *)
  249.   if BatchFlag then FirstPacket := 0
  250.   else
  251.     begin (* not BatchFlag *)
  252.       FirstPacket := 1;
  253.       (* open Filename for write *)
  254. {$I-}
  255.       Assign(Handle,Filename);
  256.       Rewrite(Handle,1);
  257. {$I+}
  258.       if IOResult <> 0 then
  259.         begin
  260.           Message := 'Cannot open ' + Filename;
  261.           WriteMsg(Message,1);
  262.           RxyModem := FALSE;
  263.           goto 999;
  264.         end;
  265.     end; (* not BatchFlag *)
  266.   (* get each packet in turn *)
  267.   for Packet := FirstPacket to MaxInt do
  268.     begin (* issue message *)
  269.       str(Packet,Temp);
  270.       Message := 'Packet ' + Temp;
  271.       WriteMsg(Message,1);
  272.       PacketNbr := Packet AND $00ff;
  273.       (* get next packet *)
  274.       if not RxPacket(Port,Packet,BufferSize,Buffer,CRCflag,EOTflag) then
  275.         begin
  276.           RxyModem := FALSE;
  277.           goto 999;
  278.         end;
  279.       (* packet 0 ? *)
  280.       if Packet = 0 then
  281.         begin (* Packet = 0 *)
  282.           if Buffer[0] = 0 then
  283.             begin
  284.               WriteMsg('Batch transfer complete',1);
  285.               RxyModem := TRUE;
  286.               goto 999;
  287.             end;
  288.           (* get filename *)
  289.           i := 0;
  290.           k := 1;
  291.           repeat
  292.             Filename[k] := chr(Buffer[i]);
  293.             i := i + 1;
  294.             k := k + 1;
  295.           until Buffer[i] = 0;
  296.           FileName[0] := chr(i);
  297.           (* get file size *)
  298.           i := i + 1;
  299.           k := 1;
  300.           repeat
  301.             Temp[k] := chr(Buffer[i]);
  302.             i := i + 1;
  303.             k := k + 1;
  304.           until Buffer[i] = 0;
  305.           Temp[0] := chr(k - 1);
  306.           Val(Temp,FileBytes,Result);
  307.        end; (* Packet = 0 *)
  308.     (* all done if EOT was received *)
  309.     if EOTflag then
  310.       begin
  311.         close(Handle);
  312.         WriteMsg('Transfer completed',1);
  313.         RxyModem := TRUE;
  314.         goto 999
  315.       end;
  316.     (* process the packet *)
  317.     if Packet = 0 then
  318.       begin
  319.         (* open file using filename in packet 0 *)
  320. {$I-}
  321.         Assign(Handle,Filename);
  322.         Rewrite(Handle,1);
  323. {$I+}
  324.         if IOResult <> 0 then
  325.           begin
  326.             Message := 'Cannot open ' + Filename;
  327.             WriteMsg(Message,1);
  328.             RxyModem := FALSE;
  329.             goto 999;
  330.           end;
  331.         (* must 'restart' after packet 0 *)
  332.         Flag := RxStartup(Port,CRCflag);
  333.       end
  334.     else (* Packet > 0 [DATA packet] *)
  335.       begin (* write Buffer *)
  336.         BlockWrite(Handle,Buffer,BufferSize)
  337.       end (* end -- else *)
  338.   end; (* end -- for(Packet) *)
  339. 999:end; (* end - RxyModem *)
  340.  
  341. end.