ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PCL4P30.ZIP/XYMODEM.PAS

Pascal/Delphi Source File | 1992-01-18 | 10.0 KB | 341 lines

(*********************************************)
(*                                           *)
(*  This program is donated to the Public    *)
(*  Domain by MarshallSoft Computing, Inc.   *)
(*  It is provided as an example of the use  *)
(*  of the Personal Communications Library.  *)
(*                                           *)
(*********************************************)

{$DEFINE DEBUG}

unit xymodem;

interface

uses xypacket,term_io,PCL4P;

function TxyModem(
         Port     : Integer;     (* COM port [0..3] *)
     Var Filename : String20;    (* filename buffer *)
     Var Buffer   : BufferType;  (* 1024 byte data buffer *)
         OneKflag : Boolean;     (* use 1K blocks when possible *)
         BatchFlag: Boolean)     (* send filename in packet 0 *)
       : Boolean;

function RxyModem(
         Port     : Integer;        (* COM port [0..3] *)
     Var Filename : String20;       (* filename buffer *)
     Var Buffer   : BufferType;     (* 1024 byte data buffer *)
         CRCflag  : Boolean;        (* if TRUE, use CRC instead of checksum *)
         BatchFlag: Boolean)        (* if TRUE, get filename from packet 0 *)
       : Boolean;

implementation

Const ONESECOND = 18;

function TxyModem(
         Port     : Integer;     (* COM port [0..3] *)
     Var Filename : String20;    (* filename buffer *)
     Var Buffer   : BufferType;  (* 1024 byte data buffer *)
         OneKflag : Boolean;     (* use 1K blocks when possible *)
         BatchFlag: Boolean)     (* send filename in packet 0 *)
       : Boolean;
Label 999;
Var
  i, k   : Integer;
  Code   : Integer;
  Flag   : Boolean;
  Handle : File;
  c      : Char;
  Packet     : Integer;
  PacketType : Char;
  PacketNbr  : Byte;
  BlockSize  : Word;
  ReadSize   : Word;
  FirstPacket: Word;
  EOTflag  : Boolean;
  CheckSum : Word;
  Number1K : Word;       (* total # 1K ( 8 records ) packets *)
  Number128 : Word;      (* total # 128 byte ( 1 record ) packets *)
  CRCflag : Boolean;
  FileBytes : LongInt;
  RemainingBytes : LongInt;
  EmptyFlag : Boolean;
  Message  : String40;
  Temp1 : String20;
  Temp2 : String20;
  Result : Word;
begin
 (* begin *)
 Number128 := 0;
 Number1K := 0;
 CRCflag := FALSE;
 EmptyFlag := FALSE;
 EOTflag := FALSE;
 if BatchFlag then
   begin
     if (Length(Filename)=0) then EmptyFlag := TRUE;
   end;
 if not EmptyFlag then
   begin (* not EmptyFlag *)
     (*EmptyFlag := FALSE;*)
{$I-}
     Assign(Handle,Filename);
     Reset(Handle,1);
{$I+}
     if IOResult <> 0 then
       begin
         Message := 'Cannot open ' + Filename;
         WriteMsg(Message,1);
         TxyModem := FALSE;
         goto 999;
       end;
   end; (* not EmptyFlag *)
 WriteMsg('XYMODEM send: waiting for receiver ',1);
 (* compute # blocks *)
 if EmptyFlag then
   begin (* empty file *)
     Number128 := 0;
     Number1K := 0
   end
 else
   begin (* file not empty *)
     FileBytes := FileSize(Handle);
     RemainingBytes := FileBytes;
     if OneKflag
       then Number1K := FileBytes div 1024
       else Number1K := 0;
     Number128 := 1 + (FileBytes - 1 - 1024 * Number1K) div 128;
     Str(Number1K,Temp1);
     Str(Number128,Temp2);
     Message := Temp1+' 1K & '+Temp2+' 128-byte packets';
     WriteMsg(Message,1);
   end;
 (* clear comm port [there may be several NAKs queued up] *)
 Code := SioRxFlush(Port);
 (* get receivers start up NAK or 'C' *)
 if not TxStartup(Port,CRCflag) then
   begin
     TxyModem := FALSE;
     goto 999;
   end;
 (* loop over all packets *)
 if BatchFlag
   then FirstPacket := 0
   else FirstPacket := 1;
 (* transmit each packet in turn *)
 for Packet := FirstPacket to Number1K+Number128 do
   begin (* issue message *)
     str(Packet,Temp1);
     Message := 'Packet ' + Temp1;
     WriteMsg(Message,1);
     (* load up Buffer *)
     if Packet=0 then
       begin (* packet = 0 *)
         if EmptyFlag then Buffer[0] := 0
         else
           begin (* not empty *)
             (* copy filename to buffer *)
             BlockSize := 128;
             k := 0;
             for i:= 1 to Length(Filename) do
               begin
                 Buffer[k] := ord(Filename[i]);
                 k := k + 1;
               end;
             Buffer[k] := 0;
             (* copy file length to buffer *)
             k := k + 1;
             Str(FileBytes,Temp1);
             for i := 1 to Length(Temp1) do
               begin
                 Buffer[k] := ord(Temp1[i]);
                 k := k + 1;
               end;
             (* pad remainder of buffer *)
             for i := k to 127 do Buffer[i] := 0;
           end (* not empty *)
        end (* Packet = 0 *)
      else
        begin  (* Packet > 0 *)
          (* DATA Packet: use 1K or 128-byte blocks ? *)
          if BatchFlag and (Packet <= Number1K)
            then BlockSize := 1024
            else BlockSize := 128;
          (* compute # bytes to read *)
          if RemainingBytes < BlockSize then ReadSize := RemainingBytes
          else ReadSize := BlockSize;
          (* read next block from disk *)
          BlockRead(Handle,Buffer,ReadSize,Result);
          RemainingBytes := RemainingBytes - Result;
          if Result <> ReadSize then
            begin
              WriteMsg('Unexpected EOF on disk read',1);
              TxyModem := FALSE;
              goto 999;
            end;
          (* pad short buffer with ^Z *)
          if ReadSize < BlockSize then
            for i:= ReadSize to Blocksize do Buffer[i] := $1A;
        end; (* Packet > 0 *)
     (* send this packet *)
     if not TxPacket(Port,Packet,BlockSize,Buffer,CRCflag) then
       begin
         TxyModem := FALSE;
         goto 999
       end;
     Code := SioDelay(5);
     (* must 'restart' after non null packet 0 *)
     if (not EmptyFlag) and (Packet=0) then Flag := TxStartup(Port,CRCflag);
   end; (* end -- for(Packet) *)
 (* done if empty packet 0 *)
 if EmptyFlag then
   begin
     WriteMsg('Batch transfer completed',1);
     TxyModem := TRUE;
     goto 999;
   end;
 (* all done. send EOT up to 10 times *)
 close(Handle);
 if not TxEOT(Port) then
   begin
     SayError(Port,'EOT not acknowledged');
     TxyModem := FALSE;
     goto 999;
   end;
 WriteMsg('Transfer completed',1);
 TxyModem := TRUE;
999: end; (* end -- TxyModem *)

function RxyModem(
         Port     : Integer;        (* COM port [0..3] *)
     Var Filename : String20;       (* filename buffer *)
     Var Buffer   : BufferType;     (* 1024 byte data buffer *)
         CRCflag  : Boolean;        (* use CRC instead of checksum *)
         BatchFlag: Boolean)        (* get filename from packet 0 *)
       : Boolean;
Label 999;
Var
  i, k    : Integer;
  Handle  : File;         (* file Handle *)
  Packet  : Integer;      (* packet index *)
  Code    : Integer;      (* return code *)
  Flag    : Boolean;
  EOTflag : Boolean;
  Message : String40;
  Temp    : String40;
  Result  : Integer;
  FirstPacket: Word;
  PacketNbr  : Byte;
  FileBytes  : LongInt;
  EmptyFlag  : Boolean;
  BufferSize : Word;
  (* begin *)
begin
  EmptyFlag := FALSE;
  EOTflag := FALSE;
  WriteMsg('XYMODEM Receive: Waiting for Sender ',1);
  (* clear comm port *)
  Code := SioRxFlush(Port);
  (* Send NAKs or 'C's *)
  if not RxStartup(Port,CRCflag) then
    begin
      RxyModem := FALSE;
      goto 999;
    end;
  (* open file unless BatchFlag is on *)
  if BatchFlag then FirstPacket := 0
  else
    begin (* not BatchFlag *)
      FirstPacket := 1;
      (* open Filename for write *)
{$I-}
      Assign(Handle,Filename);
      Rewrite(Handle,1);
{$I+}
      if IOResult <> 0 then
        begin
          Message := 'Cannot open ' + Filename;
          WriteMsg(Message,1);
          RxyModem := FALSE;
          goto 999;
        end;
    end; (* not BatchFlag *)
  (* get each packet in turn *)
  for Packet := FirstPacket to MaxInt do
    begin (* issue message *)
      str(Packet,Temp);
      Message := 'Packet ' + Temp;
      WriteMsg(Message,1);
      PacketNbr := Packet AND $00ff;
      (* get next packet *)
      if not RxPacket(Port,Packet,BufferSize,Buffer,CRCflag,EOTflag) then
        begin
          RxyModem := FALSE;
          goto 999;
        end;
      (* packet 0 ? *)
      if Packet = 0 then
        begin (* Packet = 0 *)
          if Buffer[0] = 0 then
            begin
              WriteMsg('Batch transfer complete',1);
              RxyModem := TRUE;
              goto 999;
            end;
          (* get filename *)
          i := 0;
          k := 1;
          repeat
            Filename[k] := chr(Buffer[i]);
            i := i + 1;
            k := k + 1;
          until Buffer[i] = 0;
          FileName[0] := chr(i);
          (* get file size *)
          i := i + 1;
          k := 1;
          repeat
            Temp[k] := chr(Buffer[i]);
            i := i + 1;
            k := k + 1;
          until Buffer[i] = 0;
          Temp[0] := chr(k - 1);
          Val(Temp,FileBytes,Result);
       end; (* Packet = 0 *)
    (* all done if EOT was received *)
    if EOTflag then
      begin
        close(Handle);
        WriteMsg('Transfer completed',1);
        RxyModem := TRUE;
        goto 999
      end;
    (* process the packet *)
    if Packet = 0 then
      begin
        (* open file using filename in packet 0 *)
{$I-}
        Assign(Handle,Filename);
        Rewrite(Handle,1);
{$I+}
        if IOResult <> 0 then
          begin
            Message := 'Cannot open ' + Filename;
            WriteMsg(Message,1);
            RxyModem := FALSE;
            goto 999;
          end;
        (* must 'restart' after packet 0 *)
        Flag := RxStartup(Port,CRCflag);
      end
    else (* Packet > 0 [DATA packet] *)
      begin (* write Buffer *)
        BlockWrite(Handle,Buffer,BufferSize)
      end (* end -- else *)
  end; (* end -- for(Packet) *)
999:end; (* end - RxyModem *)

end.