home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pcl4p42 / xymodem.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-23  |  14KB  |  472 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. {$I DEFINES.PAS}
  12.  
  13.  
  14. unit xymodem;
  15.  
  16. interface
  17.  
  18. uses xypacket,term_io,PCL4P,crt,dos;
  19.  
  20. function TxyModem(
  21.          Port     : Integer;     (* COM port [0..3] *)
  22.      Var Filename : String12;    (* filename buffer *)
  23.      Var Buffer   : BufferType;  (* 1K byte data buffer *)
  24.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  25.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  26.        : Boolean;
  27.  
  28. function RxyModem(
  29.          Port     : Integer;        (* COM port [0..3] *)
  30.      Var Filename : String12;       (* filename buffer *)
  31.      Var Buffer   : BufferType;     (* 1K byte data buffer *)
  32.          NCGbyte  : Byte;           (* NAK, 'C', or 'G' *)
  33.          BatchFlag: Boolean)        (* if TRUE, get filename from packet 0 *)
  34.        : Boolean;
  35.  
  36. function XmodemTx(
  37.          Port     : Integer;        (* COM port [0..3] *)
  38.      Var Filename : String12;       (* filename buffer *)
  39.      Var Buffer   : BufferType;     (* 1K data buffer *)
  40.          OneKflag : Boolean)        (* 1K flag *)
  41.        : Boolean;
  42.  
  43. function XmodemRx(
  44.          Port     : Integer;        (* COM port [0..3] *)
  45.      Var Filename : String12;       (* filename buffer *)
  46.      Var Buffer   : BufferType;     (* 1K data buffer *)
  47.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  48.        : Boolean;
  49.  
  50. function YmodemTx(
  51.          Port     : Integer;        (* COM port [0..3] *)
  52.      Var Filespec : String12;       (* file spec buffer *)
  53.      Var Buffer   : BufferType;     (* 1K data buffer *)
  54.          OneKflag : Boolean)        (* 1K flag *)
  55.        : Boolean;
  56.  
  57. function YmodemRx(
  58.          Port     : Integer;        (* COM port [0..3] *)
  59.      Var Filename : String12;       (* filename buffer *)
  60.      Var Buffer   : BufferType;     (* 1K data buffer *)
  61.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  62.        : Boolean;
  63.  
  64. implementation
  65.  
  66. Const NAK = $15;
  67.       CAN = $18;
  68.  
  69. function TxyModem(
  70.          Port     : Integer;     (* COM port [0..3] *)
  71.      Var Filename : String12;    (* filename buffer *)
  72.      Var Buffer   : BufferType;  (* 1K byte data buffer *)
  73.          OneKflag : Boolean;     (* use 1K blocks when possible *)
  74.          BatchFlag: Boolean)     (* send filename in packet 0 *)
  75.        : Boolean;
  76. Label 999;
  77. Var
  78.   i, k   : Integer;
  79.   Code   : Integer;
  80.   Flag   : Boolean;
  81.   Handle : File;
  82.   c      : Char;
  83.   Packet     : Integer;
  84.   PacketType : Char;
  85.   PacketNbr  : Byte;
  86.   BlockSize  : Word;
  87.   ReadSize   : Word;
  88.   FirstPacket: Word;
  89.   EOTflag  : Boolean;
  90.   CheckSum : Word;
  91.   Number1K : Word;       (* total # 1K ( 8 records ) packets *)
  92.   Number128 : Word;      (* total # 128 byte ( 1 record ) packets *)
  93.   NCGbyte : Byte;
  94.   FileBytes : LongInt;
  95.   RemainingBytes : LongInt;
  96.   EmptyFlag : Boolean;
  97.   Message  : String40;
  98.   Temp1 : String12;
  99.   Temp2 : String12;
  100.   Result : Word;
  101. begin
  102.  (* begin *)
  103.  Number128 := 0;
  104.  Number1K := 0;
  105.  NCGbyte := NAK;
  106.  EmptyFlag := FALSE;
  107.  EOTflag := FALSE;
  108.  if BatchFlag then
  109.    begin
  110.      if (Length(Filename)=0) then EmptyFlag := TRUE;
  111.    end;
  112.  if not EmptyFlag then
  113.    begin (* not EmptyFlag *)
  114.      (*EmptyFlag := FALSE;*)
  115. {$I-}
  116.      Assign(Handle,Filename);
  117.      Reset(Handle,1);
  118. {$I+}
  119.      if IOResult <> 0 then
  120.        begin
  121.          Message := 'Cannot open ' + Filename;
  122.          WriteMsg(Message,1);
  123.          TxyModem := FALSE;
  124.          goto 999;
  125.        end;
  126.    end; (* not EmptyFlag *)
  127.  WriteMsg('XYMODEM send: waiting for receiver ',1);
  128.  (* compute # blocks *)
  129.  if EmptyFlag then
  130.    begin (* empty file *)
  131.      Number128 := 0;
  132.      Number1K := 0
  133.    end
  134.  else
  135.    begin (* file not empty *)
  136.      FileBytes := FileSize(Handle);
  137.      RemainingBytes := FileBytes;
  138.      if OneKflag
  139.        then Number1K := FileBytes div 1024
  140.        else Number1K := 0;
  141.      Number128 := (FileBytes - 1024 * Number1K) div 128;
  142.      if (128*Number128+1024*Number1K) < FileBytes
  143.         then Number128 := Number128 + 1;
  144.      Str(Number1K,Temp1);
  145.      Str(Number128,Temp2);
  146.      Message := Temp1+' 1K & '+Temp2+' 128-byte packets';
  147.      WriteMsg(Message,1);
  148.    end;
  149.  (* clear comm port [there may be several NAKs queued up] *)
  150.  Code := SioRxFlush(Port);
  151.  (* get receivers start up NAK or 'C' *)
  152.  if not TxStartup(Port,NCGbyte) then
  153.    begin
  154.      TxyModem := FALSE;
  155.      goto 999;
  156.    end;
  157.  (* loop over all packets *)
  158.  if BatchFlag
  159.    then FirstPacket := 0
  160.    else FirstPacket := 1;
  161.  (* transmit each packet in turn *)
  162.  for Packet := FirstPacket to Number1K+Number128 do
  163.    begin
  164.       (* user aborts ? *)
  165.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  166.         begin
  167.            TxCAN(Port);
  168.            WriteMsg('*** Canceled by USER ***',1);
  169.            TxyModem := FALSE;
  170.            goto 999
  171.         end;
  172.      (* issue message *)
  173.      str(Packet,Temp1);
  174.      Message := 'Packet ' + Temp1;
  175.      WriteMsg(Message,1);
  176.      (* load up Buffer *)
  177.      if Packet=0 then
  178.        begin (* packet = 0 *)
  179.          if EmptyFlag then Buffer[0] := 0
  180.          else
  181.            begin (* not empty *)
  182.              (* copy filename to buffer *)
  183.              BlockSize := 128;
  184.              k := 0;
  185.              for i:= 1 to Length(Filename) do
  186.                begin
  187.                  Buffer[k] := ord(Filename[i]);
  188.                  k := k + 1;
  189.                end;
  190.              Buffer[k] := 0;
  191.              (* copy file length to buffer *)
  192.              k := k + 1;
  193.              Str(FileBytes,Temp1);
  194.              for i := 1 to Length(Temp1) do
  195.                begin
  196.                  Buffer[k] := ord(Temp1[i]);
  197.                  k := k + 1;
  198.                end;
  199.              (* pad remainder of buffer *)
  200.              for i := k to 127 do Buffer[i] := 0;
  201.            end (* not empty *)
  202.         end (* Packet = 0 *)
  203.       else
  204.         begin  (* Packet > 0 *)
  205.           (* DATA Packet: use 1K or 128-byte blocks ? *)
  206.           if BatchFlag and (Packet <= Number1K)
  207.             then BlockSize := 1024
  208.             else BlockSize := 128;
  209.           (* compute # bytes to read *)
  210.           if RemainingBytes < BlockSize then ReadSize := RemainingBytes
  211.           else ReadSize := BlockSize;
  212.           (* read next block from disk *)
  213.           BlockRead(Handle,Buffer,ReadSize,Result);
  214.           RemainingBytes := RemainingBytes - Result;
  215.           if Result <> ReadSize then
  216.             begin
  217.               WriteMsg('Unexpected EOF on disk read',1);
  218.               TxyModem := FALSE;
  219.               goto 999;
  220.             end;
  221.           (* pad short buffer with ^Z *)
  222.           if ReadSize < BlockSize then
  223.             for i:= ReadSize to Blocksize do Buffer[i] := $1A;
  224.         end; (* Packet > 0 *)
  225.      (* send this packet *)
  226.      if not TxPacket(Port,Packet,BlockSize,Buffer,NCGbyte) then
  227.        begin
  228.          TxyModem := FALSE;
  229.          goto 999
  230.        end;
  231.      Code := SioDelay(5);
  232.      (* must 'restart' after non null packet 0 *)
  233.      if (not EmptyFlag) and (Packet=0) then Flag := TxStartup(Port,NCGbyte);
  234.    end; (* end -- for(Packet) *)
  235.  (* done if empty packet 0 *)
  236.  if EmptyFlag then
  237.    begin
  238.      WriteMsg('Batch transfer completed',1);
  239.      TxyModem := TRUE;
  240.      goto 999;
  241.    end;
  242.  (* all done. send EOT up to 10 times *)
  243.  close(Handle);
  244.  if not TxEOT(Port) then
  245.    begin
  246.      SayError(Port,'EOT not acknowledged');
  247.      TxyModem := FALSE;
  248.      goto 999;
  249.    end;
  250.  WriteMsg('Transfer completed',1);
  251.  TxyModem := TRUE;
  252. 999: end; (* end -- TxyModem *)
  253.  
  254. function RxyModem(
  255.          Port     : Integer;        (* COM port [0..3] *)
  256.      Var Filename : String12;       (* filename buffer *)
  257.      Var Buffer   : BufferType;     (* 1K byte data buffer *)
  258.          NCGbyte  : Byte;           (* NAK, 'C', or 'G' *)
  259.          BatchFlag: Boolean)        (* get filename from packet 0 *)
  260.        : Boolean;
  261. Label 999;
  262. Var
  263.   i, k    : Integer;
  264.   Handle  : File;         (* file Handle *)
  265.   Packet  : Integer;      (* packet index *)
  266.   Code    : Integer;      (* return code *)
  267.   Flag    : Boolean;
  268.   EOTflag : Boolean;
  269.   Message : String40;
  270.   Temp    : String40;
  271.   Result  : Integer;
  272.   FirstPacket: Word;
  273.   PacketNbr  : Byte;
  274.   FileBytes  : LongInt;
  275.   EmptyFlag  : Boolean;
  276.   BufferSize : Word;
  277.   (* begin *)
  278. begin
  279.   EmptyFlag := FALSE;
  280.   EOTflag := FALSE;
  281.   WriteMsg('XYMODEM Receive: Waiting for Sender ',1);
  282.   (* clear comm port *)
  283.   Code := SioRxFlush(Port);
  284.   (* Send NAKs or 'C's *)
  285.   if not RxStartup(Port,NCGbyte) then
  286.     begin
  287.       RxyModem := FALSE;
  288.       goto 999;
  289.     end;
  290.   (* open file unless BatchFlag is on *)
  291.   if BatchFlag then FirstPacket := 0
  292.   else
  293.     begin (* not BatchFlag *)
  294.       FirstPacket := 1;
  295.       (* open Filename for write *)
  296. {$I-}
  297.       Assign(Handle,Filename);
  298.       Rewrite(Handle,1);
  299. {$I+}
  300.       if IOResult <> 0 then
  301.         begin
  302.           Message := 'Cannot open ' + Filename;
  303.           WriteMsg(Message,1);
  304.           RxyModem := FALSE;
  305.           goto 999;
  306.         end;
  307.     end; (* not BatchFlag *)
  308.   (* get each packet in turn *)
  309.   for Packet := FirstPacket to MaxInt do
  310.     begin
  311.       (* user aborts ? *)
  312.       if KeyPressed then if (Ord(ReadKey) = CAN) then
  313.         begin
  314.            TxCAN(Port);
  315.            WriteMsg('*** Canceled by USER ***',1);
  316.            RxyModem := FALSE;
  317.            goto 999
  318.         end;
  319.       (* issue message *)
  320.       str(Packet,Temp);
  321.       Message := 'Packet ' + Temp;
  322.       WriteMsg(Message,1);
  323.       PacketNbr := Packet AND $00ff;
  324.       (* get next packet *)
  325.       if not RxPacket(Port,Packet,BufferSize,Buffer,NCGbyte,EOTflag) then
  326.         begin
  327.           RxyModem := FALSE;
  328.           goto 999;
  329.         end;
  330.       (* packet 0 ? *)
  331.       if Packet = 0 then
  332.         begin (* Packet = 0 *)
  333.           if Buffer[0] = 0 then
  334.             begin
  335.               WriteMsg('Batch transfer complete',1);
  336.               RxyModem := TRUE;
  337.               goto 999;
  338.             end;
  339.           (* get filename *)
  340.           i := 0;
  341.           k := 1;
  342.           repeat
  343.             Filename[k] := chr(Buffer[i]);
  344.             i := i + 1;
  345.             k := k + 1;
  346.           until Buffer[i] = 0;
  347.           FileName[0] := chr(i);
  348.           (* get file size *)
  349.           i := i + 1;
  350.           k := 1;
  351.           repeat
  352.             Temp[k] := chr(Buffer[i]);
  353.             i := i + 1;
  354.             k := k + 1;
  355.           until Buffer[i] = 0;
  356.           Temp[0] := chr(k - 1);
  357.           Val(Temp,FileBytes,Result);
  358.        end; (* Packet = 0 *)
  359.     (* all done if EOT was received *)
  360.     if EOTflag then
  361.       begin
  362.         close(Handle);
  363.         WriteMsg('Transfer completed',1);
  364.         RxyModem := TRUE;
  365.         goto 999
  366.       end;
  367.     (* process the packet *)
  368.     if Packet = 0 then
  369.       begin
  370.         (* open file using filename in packet 0 *)
  371. {$I-}
  372.         Assign(Handle,Filename);
  373.         Rewrite(Handle,1);
  374. {$I+}
  375.         if IOResult <> 0 then
  376.           begin
  377.             Message := 'Cannot open ' + Filename;
  378.             WriteMsg(Message,1);
  379.             RxyModem := FALSE;
  380.             goto 999;
  381.           end;
  382.         (* must 'restart' after packet 0 *)
  383.         Flag := RxStartup(Port,NCGbyte);
  384.       end
  385.     else (* Packet > 0 [DATA packet] *)
  386.       begin (* write Buffer *)
  387.         BlockWrite(Handle,Buffer,BufferSize)
  388.       end (* end -- else *)
  389.   end; (* end -- for(Packet) *)
  390. 999:end; (* end - RxyModem *)
  391.  
  392. function FetchName(var Filename : String12) : Boolean;
  393. var Text40 : String40;
  394. begin
  395.   FetchName := True;
  396.   if Length(Filename) = 0 then
  397.     begin
  398.       WriteMsg('Enter filename: ',1);
  399.       ReadMsg(Text40,16,20);
  400.       Filename := Text40;
  401.       if Length(FileName) = 0 then FetchName := False;
  402.     end;
  403. end;
  404.  
  405. function XmodemTx(
  406.          Port     : Integer;        (* COM port [0..3] *)
  407.      Var Filename : String12;       (* filename buffer *)
  408.      Var Buffer   : BufferType;     (* 1K data buffer *)
  409.          OneKflag : Boolean)        (* 1K flag *)
  410.        : Boolean;
  411. begin
  412.   if FetchName(Filename) then
  413.     XmodemTx := TxyModem(Port,Filename,Buffer,OneKflag,False)
  414.   else XmodemTx := False;
  415. end;
  416.  
  417. function XmodemRx(
  418.          Port     : Integer;        (* COM port [0..3] *)
  419.      Var Filename : String12;       (* filename buffer *)
  420.      Var Buffer   : BufferType;     (* 1K data buffer *)
  421.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  422.        : Boolean;
  423. begin
  424.   if FetchName(Filename) then
  425.     XmodemRx := RxyModem(Port,Filename,Buffer,NCGbyte,False)
  426.   else XmodemRx := False;
  427. end;
  428.  
  429.  
  430. function YmodemTx(
  431.          Port     : Integer;        (* COM port [0..3] *)
  432.      Var Filespec : String12;       (* file spec buffer *)
  433.      Var Buffer   : BufferType;     (* 1K data buffer *)
  434.          OneKflag : Boolean)        (* 1K flag *)
  435.        : Boolean;
  436. var
  437.   FileNbr  : Integer;
  438.   DirInfo  : SearchRec;
  439.   Filename : String12;
  440. begin
  441.   FileNbr := 0;
  442.   if FetchName(Filespec) then
  443.     repeat
  444.       FileNbr := FileNbr + 1;
  445.       if FileNbr = 1 then FindFirst(Filespec,AnyFile,DirInfo)
  446.       else FindNext(DirInfo);
  447.       if DosError <> 0 then exit;
  448.       Filename := DirInfo.Name;
  449.       YmodemTx := TxyModem(Port,Filename,Buffer,OneKflag,False);
  450.     until False
  451. end;
  452.  
  453. function YmodemRx(
  454.          Port     : Integer;        (* COM port [0..3] *)
  455.      Var Filename : String12;       (* filename buffer *)
  456.      Var Buffer   : BufferType;     (* 1K data buffer *)
  457.          NCGbyte  : Byte)           (* NAK, 'C', or 'G' *)
  458.        : Boolean;
  459. begin
  460.   YmodemRx := True;
  461.   repeat
  462.     WriteMsg('Ready for next file',1);
  463.     Filename := '';
  464.     if not RxyModem(Port,Filename,Buffer,NCGbyte,True) then
  465.     begin
  466.       YmodemRx := False;
  467.       exit
  468.     end
  469.   until KeyPressed or (Length(Filename) = 0)
  470. end;
  471.  
  472. end.