ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TPZNEWG.ZIP/TPZ.U

Text File | 1990-05-18 | 61.1 KB | 2,320 lines

UNIT TPZ;

(*                           ZMODEM für Turbo-Pascal                           *)
(*                                                                             *)
(*                       Copywrite (c) by Stefan Graf 1990                     *)
(*                                                                             *)
(* Datenübertragung über die serielle Schnittstelle mit dem ZMODEM-Protokoll.  *)
(* Als Grundlage diente der Sourcecode TPZ.PAS von Philip R. Burn's PIPTERM.   *)
(* Die Unit ist in vielen Teilen überarbeitet und auf hohe Transferraten       *)
(* getrimmt worden.                                                            *)
(* In diversen Test's wurde mit 115200 Baud eine Übertragungsrate von mehr als *)
(* 5 kByte's pro Sekunde erreicht.                                             *)
(*                                                                             *)
(* Das Handling der ser. Schnittstelle erfolgt über die Unit SERIELLINTERFACE. *)
(*                                                                             *)
(* Die Transferroutinen erzeugen selber keinerlei Statusmeldungen. Diese über- *)
(* nehmen zwei, vom Benutzter zu erstellende parameterlose PROCEDUREN, die     *)
(* den aktuellen Status des Transfer's ausgeben. Diese Daten werden in der     *)
(* Variablen der Unit TRANSDATA abgelegt.                                      *)

INTERFACE

  CONST
    ProgramVersion = '2.22ß';


  VAR
    MakeCRC32,               (* TRUE, wenn 32-Bit-CRC benutzt werden darf  *)
    RecoverAllow : BOOLEAN;  (* TRUE, wenn das File-Recover zugelassen ist *)

(* Empfangen eines File mit dem ZMODEM-Protokoll *)

PROCEDURE ZmodemReceive (    path       : STRING;     (* Path für das File                      *)
                             baudrate   : LONGINT;    (* Aktuelle Baudrate auf der Telefonseite *)
                             kanal      : WORD;       (* Handlernummer für SeriellInterface     *)
                             startproc,               (* Adresse der Start-Anzeige-Procedure    *)
                             dispproc   : POINTER;    (* Adresse der Transfer-Anzeige-Procedure *)
                         VAR fehlerflag : BOOLEAN);   (* TRUE, wenn ein Fehler aufgetreten ist  *)

(* Senden eines Files mit dem ZMODEM-Protokoll *)

PROCEDURE ZmodemSend    (    pathname   : STRING;     (* Path und Filename                      *)
                             baudrate   : LONGINT;    (* Aktuelle Baudrate auf der Telefonseite *)
                             lastfile   : BOOLEAN;    (* TRUE, wenn keine weitere Übertragung   *)
                             kanal      : WORD;       (* Handlernummer für SeriellInterface     *)
                             startproc,               (* Adresse der Start-Anzeige-Procedure    *)
                             dispproc   : POINTER;    (* Adresse der Transfer-Anzeige-Procedure *)
                         VAR fehler     : WORD);      (* Bei Fehler in der Übertragung <> 0     *)


IMPLEMENTATION

  USES Crt,Dos,SeriellInterface,TransData,TPZFiles,TPZunix,TPZcrc;

CONST
   ZBUFSIZE = 1024;

   zbaud: LONGINT = 0;

   txtimeout = 10 * 18;

TYPE
   hdrtype = ARRAY[0..3] OF BYTE;
   buftype = ARRAY[0..ZBUFSIZE] OF BYTE;

CONST
   ZPAD = 42;  { '*' }
   ZDLE = 24;  { ^X  }
   ZDLEE = 88;
   ZBIN = 65;  { 'A' }
   ZHEX = 66;  { 'B' }
   ZBIN32 = 67;{ 'C' }
   ZRQINIT = 0;
   ZRINIT = 1;
   ZSINIT = 2;
   ZACK = 3;
   ZFILE = 4;
   ZSKIP = 5;
   ZNAK = 6;
   ZABORT = 7;
   ZFIN = 8;
   ZRPOS = 9;
   ZDATA = 10;
   ZEOF = 11;
   ZFERR = 12;
   ZCRC = 13;
   ZCHALLENGE = 14;
   ZCOMPL = 15;
   ZCAN = 16;
   ZFREECNT = 17;
   ZCOMMAND = 18;
   ZSTDERR = 19;
   ZCRCE = 104; { 'h' }
   ZCRCG = 105; { 'i' }
   ZCRCQ = 106; { 'j' }
   ZCRCW = 107; { 'k' }
   ZRUB0 = 108; { 'l' }
   ZRUB1 = 109; { 'm' }
   ZOK = 0;
   ZERROR = -1;
   ZTIMEOUT = -2;
   RCDO = -3;
   FUBAR = -4;
   GOTOR = 256;
   GOTCRCE = 360; { 'h' OR 256 }
   GOTCRCG = 361; { 'i' "   "  }
   GOTCRCQ = 362; { 'j' "   "  }
   GOTCRCW = 363; { 'k' "   "  }
   GOTCAN = 272;  { CAN OR  "  }

{ xmodem paramaters }

CONST
   ENQ = 5;
   CAN = 24;
   XOFF = 19;
   XON = 17;
   SOH = 1;
   STX = 2;
   EOT = 4;
   ACK = 6;
   NAK = 21;
   CPMEOF = 26;

{ byte positions }
CONST
   ZF0 = 3;
   ZF1 = 2;
   ZF2 = 1;
   ZF3 = 0;
   ZP0 = 0;
   ZP1 = 1;
   ZP2 = 2;
   ZP3 = 3;

{ bit masks for ZRINIT }
CONST
   CANFDX = 1;    { can handle full-duplex          (yes for PC's)}
   CANOVIO = 2;   { can overlay disk and serial I/O (ditto)       }
   CANBRK = 4;    { can send a break - True but superfluous       }
   CANCRY = 8;    { can encrypt/decrypt - not defined yet         }
   CANLZW = 16;   { can LZ compress - not defined yet             }
   CANFC32 = 32;  { can use 32 bit crc frame checks - true        }
   ESCALL = 64;   { escapes all control chars. NOT implemented    }
   ESC8 = 128;    { escapes the 8th bit. NOT implemented          }

{ bit masks for ZSINIT }
CONST
   TESCCTL = 64;
   TESC8 = 128;

{ paramaters for ZFILE }
CONST
{ ZF0 }
   ZCBIN = 1;
   ZCNL = 2;
   ZCRESUM = 3;
{ ZF1 }
   ZMNEW = 1;   {I haven't implemented these as of yet - most are}
   ZMCRC = 2;   {superfluous on a BBS - Would be nice from a comm}
   ZMAPND = 3;  {programs' point of view however                 }
   ZMCLOB = 4;
   ZMSPARS = 5;
   ZMDIFF = 6;
   ZMPROT = 7;
{ ZF2 }
   ZTLZW = 1;   {encryption, compression and funny file handling }
   ZTCRYPT = 2; {flags - My docs (03/88) from OMEN say these have}
   ZTRLE = 3;   {not been defined yet                            }
{ ZF3 }
   ZCACK1 = 1;  {God only knows...                               }

VAR
   {$IFDEF TPZLog}                (* Für Testzwecke kann man durch Setzen der    *)
     tpzlog     : FILE OF CHAR;   (* Definition TPZLog ein Protokoll aller ge-   *)
   {$ENDIF}                       (* sendeten und empfangenen Zeichen erzeugten. *)

   TimeCounter  : LONGINT ABSOLUTE $40:$6C;

   modemkanal   : WORD;

   rxpos        : LONGINT; {file position received from Z_GetHeader}
   rxhdr        : hdrtype;    {receive header var}
   rxtimeout,
   rxtype,
   rxframeind   : INTEGER;
   attn         : buftype;
   secbuf       : buftype;
   fname        : STRING;
   fmode        : INTEGER;
   ftime,
   fsize        : LONGINT;
   send32crc    : BOOLEAN;  (* TRUE, wenn 32-Bit-CRC benutzt werden darf *)
   zcps,
   zerrors      : WORD;
   txpos        : LONGINT;
   txhdr        : hdrtype;
   ztime        : LONGINT;

   zstartproc,
   zdispproc    : POINTER;

CONST
   lastsent: BYTE = 0;


(*************************************************************************)

(* Schnelles Aufrufen einer Procedure auf die der POINTER <proc> zeigt *)

PROCEDURE CallUserProcedure (proc : POINTER);

BEGIN
  InLine ($FF/$5E/< proc);
END;


(*************************************************************************)

(* Dem Modem die Empfangsbereitschaft anzeigen. *)
(* Dies geschiet durch Setzen der RTS-Leitung.  *)

Procedure ModemRun (kanal : WORD);

BEGIN
  RequestToSend (kanal,On);
END; (* of ModemRun *)


(*************************************************************************)

(* Dem Modem anzeigen, dass zur zeit keine Zeichen verarbeitet.    *)
(* werden können. Diese geschiet durch Rücksetzen der RTS-Leitung. *)

Procedure ModemStop (kanal : WORD);

BEGIN
  RequestToSend (kanal,Off);
END; (* of ModemStop *)


(*************************************************************************)

(* Berechnen der CRC-Summe eines Files *)

FUNCTION Z_FileCRC32 (VAR f: FILE): LONGINT;

VAR
   fbuf  : buftype;

   crc   : LONGINT;

   n,
   bread : INTEGER;

BEGIN
   crc := $FFFFFFFF;
   Seek(f,0);
   IF (IOresult <> 0) THEN
      {null};
   REPEAT
      BlockRead(f,fbuf,ZBUFSIZE,bread);
      FOR n := 0 TO (bread - 1) DO crc := UpdC32 (fbuf [n],crc)
   UNTIL (bread < ZBUFSIZE) OR (IOresult <> 0);
   Seek(f,0);
   IF (IOresult <> 0) THEN
      {null};
   Z_FileCRC32 := crc
END;


(*************************************************************************)

FUNCTION Z_GetByte (tenths : INTEGER) : INTEGER;

(* Reads a byte from the modem - Returns RCDO if *)
(* no carrier, or ZTIMEOUT if nothing received   *)
(* within 'tenths' of a second.                  *)

  VAR
    c    : INTEGER;

    time : LONGINT;

BEGIN
  IF ReceiverReady (modemkanal) THEN BEGIN
    c := ORD (SeriellRead (modemkanal));
    {$IFDEF TPZLog}
       Write (tpzlog,CHAR (c));
    {$ENDIF}
    Z_GetByte:=c;
  END  (* of IF THEN *)
  ELSE BEGIN
    time:=TimeCounter + tenths;
    REPEAT
      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
         Z_GetByte := RCDO; { nobody to talk to }
         Exit;
      END  (* of IF THEN *)
      ELSE IF ReceiverReady (modemkanal) THEN BEGIN
         c := ORD (SeriellRead (modemkanal));
         {$IFDEF TPZLog}
           Write (tpzlog,CHAR (c));
         {$ENDIF}
         Z_GetByte:=c;
         Exit;
      END;

    UNTIL (TimeCounter > time);

    Z_GetByte := ZTIMEOUT        { timed out }
  END;  (* of ELSE *)
END;


(*************************************************************************)

FUNCTION Z_qk_read : INTEGER;

(* Just like Z_GetByte, but timeout value is in *)
(* global var rxtimeout.                        *)

  VAR
    stop : BOOLEAN;

    ch   : CHAR;

    c    : INTEGER;

    time : LONGINT;

BEGIN
  IF ReceiverReady (modemkanal) THEN BEGIN
    c:=ORD (SeriellRead (modemkanal));
    {$IFDEF TPZLog}
      Write (tpzlog,CHAR (c));
    {$ENDIF}
    Z_qk_read:=c;
  END  (* of IF THEN *)
  ELSE BEGIN
    time:=TimeCounter + rxtimeout;
    stop:=FALSE;
    REPEAT
      IF ReceiverReady (modemkanal) THEN BEGIN
        ch:=SeriellRead (modemkanal);
        {$IFDEF TPZLog}
          Write (tpzlog,ch);
        {$ENDIF}
        stop:=TRUE;
      END;  (* of IF *)
    UNTIL stop OR (TimeCounter > time) OR NOT (CarrierDetector (modemkanal));

    IF (TimeCounter > time) THEN
      c:=ZTIMEOUT
    ELSE IF NOT (CarrierDetector (modemkanal)) THEN
      c:=RCDO
    ELSE c:=ORD (ch);
    Z_qk_read := c;
  END;  (* of ELSE *)
END;

(*************************************************************************)

FUNCTION Z_TimedRead : INTEGER;

(* A Z_qk_read, that strips parity and *)
(* ignores XON/XOFF characters.        *)

VAR
   stop : BOOLEAN;

   ch   : CHAR;

   c    : INTEGER;

   time : LONGINT;

BEGIN
   time:=TimeCounter + rxtimeout;
   stop:=FALSE;
   REPEAT
     IF ReceiverReady (modemkanal) THEN BEGIN
       ch:=SeriellRead (modemkanal);
       {$IFDEF TPZLog}
         Write (tpzlog,ch);
       {$ENDIF}
       IF (ch <> CHR (XON)) AND (ch <> CHR (XOFF)) THEN stop:=TRUE;
     END;  (* of IF *)
   UNTIL stop OR (TimeCounter > time) OR NOT (CarrierDetector (modemkanal));

   IF (TimeCounter > time) THEN
     c:=ZTIMEOUT
   ELSE IF NOT (CarrierDetector (modemkanal)) THEN
     c:=RCDO
   ELSE c:=ORD (ch);
   Z_TimedRead := c
END;


(*************************************************************************)

(* Senden des Zeichen in <c>.                  *)
(* Es wird gewartet, bis das Modem bereit ist. *)

PROCEDURE Z_SendByte (c : INTEGER);

  VAR
    time : LONGINT;

BEGIN
  IF NOT (SeriellStatus (modemkanal)) THEN BEGIN
    time:=TimeCounter + txtimeout;
    REPEAT
    UNTIL SeriellStatus (modemkanal) OR (TimeCounter > time);
  END;  (* of IF *)

  SeriellWrite (modemkanal,CHAR (c));
END;  (* of Z_SendByte *)


(*************************************************************************)

PROCEDURE Z_SendCan;

(* Send a zmodem CANcel sequence to the other guy *)
(* 8 CANs and 8 backspaces                        *)

  VAR
    n: BYTE;

BEGIN
  ClearSeriellBuffer (modemkanal);
  FOR n := 1 TO 8 DO BEGIN
    Z_SendByte (CAN);
    Delay (100)        { the pause seems to make reception of the sequence }
  END;                 { more reliable                                     }

  FOR n := 1 TO 10 DO Z_SendByte (8)
END;


(*************************************************************************)

PROCEDURE Z_PutString (VAR p: buftype);

(* Outputs an ASCII-Z type string (null terminated) *)
(* Processes meta characters 221 (send break) and   *)
(* 222 (2 second delay).                            *)

  VAR
    n : WORD;

BEGIN
  n := 0;
  WHILE (n < ZBUFSIZE) AND (p [n] <> 0) DO BEGIN
    CASE p [n] OF
       221 : SendBreak (modemkanal);
       222 : Delay (2000)
      ELSE   Z_SendByte (p [n])
    END;
    INC (n)
  END;  (* of WHILE *)
END;  (* of Z_PutString *)


(*************************************************************************)

PROCEDURE Z_PutHex (b: BYTE);

(* Output a byte as two hex digits (in ASCII) *)
(* Uses lower case to avoid confusion with    *)
(* escaped control characters.                *)

CONST
   hex: ARRAY[0..15] OF CHAR = '0123456789abcdef';

BEGIN
   Z_SendByte (ORD (hex[b SHR 4]));  { high nybble }
   Z_SendByte (ORD (hex[b AND $0F])) { low nybble  }
END;

(*************************************************************************)

PROCEDURE Z_SendHexHeader (htype : BYTE ; VAR hdr : hdrtype);

(* Sends a zmodem hex type header *)

VAR
   crc : WORD;
   n,
   i   : INTEGER;

BEGIN
   Z_SendByte (ZPAD);                  { '*' }
   Z_SendByte (ZPAD);                  { '*' }
   Z_SendByte (ZDLE);                  { 24  }
   Z_SendByte (ZHEX);                  { 'B' }
   Z_PutHex (htype);

   crc := UpdCrc(htype,0);

   FOR n := 0 TO 3 DO BEGIN
      Z_PutHex (hdr [n]);
      crc := UpdCrc (hdr [n],crc)
   END;

   crc := UpdCrc (0,crc);
   crc := UpdCrc (0,crc);

   Z_PutHex (Lo (crc SHR 8));
   Z_PutHex (Lo (crc));

   Z_SendByte (13);                    { make it readable to the other end }
   Z_SendByte (10);                    { just in case                      }

   IF (htype <> ZFIN) AND (htype <> ZACK) THEN
      Z_SendByte (17);                 { Prophylactic XON to assure flow   }

END;


(*************************************************************************)

FUNCTION Z_PullLongFromHeader (VAR hdr : hdrtype) : LONGINT;

  TYPE
    longarray = ARRAY [0..3] OF BYTE;

  VAR
    l       : LONGINT;

    longptr : longarray ABSOLUTE l;

BEGIN
   longptr [0]:=hdr [ZP0];
   longptr [1]:=hdr [ZP1];
   longptr [2]:=hdr [ZP2];
   longptr [3]:=hdr [ZP3];

   Z_PullLongFromHeader := l
END;


(*************************************************************************)

PROCEDURE Z_PutLongIntoHeader (l : LONGINT);

  TYPE
    longarray = ARRAY [0..3] OF BYTE;

  VAR
    longptr : longarray ABSOLUTE l;

BEGIN
  txhdr [ZP0]:=longptr [0];
  txhdr [ZP1]:=longptr [1];
  txhdr [ZP2]:=longptr [2];
  txhdr [ZP3]:=longptr [3];
END;


(*************************************************************************)

FUNCTION Z_GetZDL : INTEGER;

(* Gets a byte and processes for ZMODEM escaping or CANcel sequence *)

  VAR
     c,
     d  : INTEGER;

BEGIN
   c := Z_qk_read;
   IF (c <> ZDLE) THEN BEGIN
     Z_GetZDL := c;
   END                                        {got ZDLE or 1st CAN}
   ELSE BEGIN
     c := Z_qk_read;
     IF (c = CAN) THEN BEGIN                  {got 2nd CAN}
       c := Z_qk_read;
       IF (c = CAN) THEN BEGIN                {got 3rd CAN}
         c := Z_qk_read;
         IF (c = CAN) THEN c := Z_qk_read;    {got 4th CAN}
       END;  (* of IF *)
     END;  (* of IF *)
                                              { Flags set in high byte }
     CASE c OF
          CAN : Z_GetZDL := GOTCAN;           {got 5th CAN}
        ZCRCE,                                {got a frame end marker}
        ZCRCG,
        ZCRCQ,
        ZCRCW : Z_GetZDL := (c OR GOTOR);
        ZRUB0 : Z_GetZDL := $007F;            {got an ASCII DELete}
        ZRUB1 : Z_GetZDL := $00FF             {any parity         }
        ELSE BEGIN
           IF (c < 0) THEN
              Z_GetZDL := c
           ELSE IF ((c AND $60) = $40) THEN   {make sure it was a valid escape}
              Z_GetZDL := c XOR $40
           ELSE Z_GetZDL := ZERROR
        END;  (* of ELSE *)
     END;  (* of CASE *)
   END;  (* of ELSE *)
END;


(*************************************************************************)

FUNCTION Z_GetHex: INTEGER;
(* Get a byte that has been received as two ASCII hex digits *)
VAR
   c, n: INTEGER;

BEGIN
   n := Z_TimedRead;
   IF (n < 0) THEN BEGIN
      Z_GetHex := n;
      Exit
   END;
   n := n - $30;                     {build the high nybble}
   IF (n > 9) THEN n := n - 39;
   IF (n AND $FFF0 <> 0) THEN BEGIN
      Z_GetHex := ZERROR;
      Exit
   END;
   c := Z_TimedRead;
   IF (c < 0) THEN BEGIN
      Z_GetHex := c;
      Exit
   END;
   c := c - $30;                     {now the low nybble}
   IF (c > 9) THEN c := c - 39;
   IF (c AND $FFF0 <> 0) THEN BEGIN
      Z_GetHex := ZERROR;
      Exit
   END;
   Z_GetHex := (n SHL 4) OR c        {Insert tab 'A' in slot 'B'...}
END;


(*************************************************************************)

FUNCTION Z_GetHexHeader(VAR hdr: hdrtype): INTEGER;

(* Receives a zmodem hex type header *)

  VAR
    crc : WORD;
    c,
    n   : INTEGER;

BEGIN
   c := Z_GetHex;
   IF (c < 0) THEN BEGIN
      Z_GetHexHeader := c;
      Exit
   END;

   rxtype := c;                        {get the type of header}
   crc := UpdCrc (rxtype,0);

   FOR n := 0 To 3 DO BEGIN            {get the 4 bytes}
      c := Z_GetHex;
      IF (c < 0) THEN BEGIN
         Z_GetHexHeader := c;
         Exit
      END;
      hdr[n] := Lo (c);
      crc := UpdCrc (Lo (c),crc)
   END;

   c := Z_GetHex;
   IF (c < 0) THEN BEGIN
      Z_GetHexHeader := c;
      Exit
   END;
   crc := UpdCrc (Lo (c),crc);

   c := Z_GetHex;
   IF (c < 0) THEN BEGIN
      Z_GetHexHeader := c;
      Exit
   END;
   crc := UpdCrc (Lo (c),crc);             {check the CRC}

   IF (crc <> 0) THEN BEGIN
      INC (TransferError);
      Z_GetHexHeader := ZERROR;
      Exit
   END;

   IF (Z_GetByte (2) = 13) THEN           {throw away CR/LF}
      c := Z_GetByte (2);
   Z_GetHexHeader := rxtype
END;


(*************************************************************************)

FUNCTION Z_GetBinaryHeader (VAR hdr: hdrtype) : INTEGER;

(* Same as above, but binary with 16 bit CRC *)

VAR
   crc : WORD;
   c,
   n   : INTEGER;

BEGIN
   c := Z_GetZDL;
   IF (c < 0) THEN BEGIN
      Z_GetBinaryHeader := c;
      Exit
   END;

   rxtype := c;
   crc := UpdCrc (rxtype,0);

   FOR n := 0 To 3 DO BEGIN
      c := Z_GetZDL;
      IF (Hi(c) <> 0) THEN BEGIN
         Z_GetBinaryHeader := c;
         Exit
      END;
      hdr[n] := Lo (c);
      crc := UpdCrc (Lo (c),crc)
   END;

   c := Z_GetZDL;
   IF (Hi (c) <> 0) THEN BEGIN
      Z_GetBinaryHeader := c;
      Exit
   END;
   crc := UpdCrc(Lo(c),crc);

   c := Z_GetZDL;
   IF (Hi(c) <> 0) THEN BEGIN
      Z_GetBinaryHeader := c;
      Exit
   END;
   crc := UpdCrc(Lo(c),crc);

   IF (crc <> 0) THEN BEGIN
      INC (TransferError);
      Exit
   END;
   Z_GetBinaryHeader := rxtype
END;


(*************************************************************************)

FUNCTION Z_GetBinaryHead32(VAR hdr: hdrtype): INTEGER;
(* Same as above but with 32 bit CRC *)
VAR
   crc: LONGINT;
   c, n: INTEGER;
BEGIN
   c := Z_GetZDL;
   IF (c < 0) THEN BEGIN
      Z_GetBinaryHead32 := c;
      Exit
   END;

   rxtype := c;
   crc := UpdC32 (rxtype,$FFFFFFFF);

   FOR n := 0 To 3 DO BEGIN
      c := Z_GetZDL;
      IF (Hi (c) <> 0) THEN BEGIN
         Z_GetBinaryHead32 := c;
         Exit
      END;
      hdr[n] := Lo (c);
      crc := UpdC32 (Lo (c),crc)
   END;

   FOR n := 0 To 3 DO BEGIN
      c := Z_GetZDL;
      IF (Hi (c) <> 0) THEN BEGIN
         Z_GetBinaryHead32 := c;
         Exit
      END;
      crc := UpdC32 (Lo (c),crc)
   END;

   IF (crc <> $DEBB20E3) THEN BEGIN   {this is the polynomial value}
      INC (TransferError);
      Z_GetBinaryHead32 := ZERROR;
      Exit
   END;

   Z_GetBinaryHead32 := rxtype
END;


(*************************************************************************)

FUNCTION Z_GetHeader (VAR hdr: hdrtype): INTEGER;

(* Use this routine to get a header - it will figure out  *)
(* what type it is getting (hex, bin16 or bin32) and call *)
(* the appropriate routine.                               *)

LABEL
   gotcan, again, agn2, splat, done;  {sorry, but it's actually eisier to}

VAR                                   {follow, and lots more efficient   }
   c, n, cancount: INTEGER;           {this way...                       }

BEGIN
   IF (zbaud > $3FFF) THEN
     n:=$7FFF
   ELSE n := zbaud * 2;               {A guess at the # of garbage characters}

   cancount:= 5;                      {to expect.                            }
   send32crc:=FALSE;                  {assume 16 bit until proven otherwise  }

again:

   IF (KeyPressed) THEN BEGIN                       {check for operator panic}
     IF (ReadKey = #27) THEN BEGIN                  {in the form of ESCape   }
       Z_SendCan;                                   {tell the other end,     }
       TransferMessage:='Cancelled from keyboard';  {the operator,           }
       Z_GetHeader := ZCAN;                         {and the rest of the     }
       Exit                                         {routines to forget it.  }
     END;  (* of IF *)
   END;  (* of IF *)

   rxframeind := 0;
   rxtype := 0;
   c := Z_TimedRead;

   CASE c OF
          ZPAD : {we want this! - all headers begin with '*'.} ;
          RCDO,
      ZTIMEOUT : GOTO done;
           CAN : BEGIN
gotcan:
                   DEC (cancount);
                   IF (cancount < 0) THEN BEGIN
                     c := ZCAN;
                     GOTO done
                   END;
                   c := Z_GetByte (2);
                   CASE c OF
                     ZTIMEOUT : GOTO again;
                        ZCRCW : BEGIN
                                  c := ZERROR;
                                  GOTO done
                                END;
                         RCDO : GOTO done;
                          CAN : BEGIN
                                  DEC (cancount);
                                  IF (cancount < 0) THEN BEGIN
                                    c := ZCAN;
                                    GOTO done
                                  END;
                                  GOTO again
                                END
                         ELSE   {fallthru}
              END {case}
           END {can}
      ELSE
agn2: BEGIN
         DEC (n);
         IF (n < 0) THEN BEGIN
            INC (TransferError);
            TransferMessage:='Header is FUBAR';
            Z_GetHeader := ZERROR;
            Exit
         END;

         IF (c <> CAN) THEN cancount := 5;

         GOTO again
      END
   END;           {only falls thru if ZPAD - anything else is trash}
   cancount := 5;
splat:
   c := Z_TimedRead;
   CASE c OF
          ZDLE : {this is what we want!} ;
          ZPAD : GOTO splat;   {junk or second '*' of a hex header}
          RCDO,
      ZTIMEOUT : GOTO done
          ELSE   GOTO agn2
   END; {only falls thru if ZDLE}
   c := Z_TimedRead;

   CASE c OF
       ZBIN32 : BEGIN
                  rxframeind := ZBIN32;          {using 32 bit CRC}
                  c := Z_GetBinaryHead32 (hdr)
                END;
         ZBIN : BEGIN
                  rxframeind := ZBIN;            {bin with 16 bit CRC}
                  c := Z_GetBinaryHeader (hdr)
                END;
         ZHEX : BEGIN
                  rxframeind := ZHEX;            {hex}
                  c := Z_GetHexHeader (hdr)
                END;
          CAN : GOTO gotcan;
         RCDO,
     ZTIMEOUT : GOTO done
         ELSE   GOTO agn2
   END; {only falls thru if we got ZBIN, ZBIN32 or ZHEX}

   rxpos := Z_PullLongFromHeader (hdr);       {set rxpos just in case this}
done:                                         {header has file position   }
   Z_GetHeader := c                           {info (i.e.: ZRPOS, etc.   )}
END;


(***************************************************)
(* RECEIVE FILE ROUTINES                           *)
(***************************************************)

CONST
   ZATTNLEN = 32;  {max length of attention string}
   lastwritten: BYTE = 0;

VAR
   t           : LONGINT;
   rzbatch     : BOOLEAN;
   outfile     : FILE;     {this is the file}
   tryzhdrtype : BYTE;
   rxcount     : INTEGER;
   filestart   : LONGINT;
   isbinary,
   eofseen     : BOOLEAN;
   zconv       : BYTE;
   zrxpath     : STRING;


(*************************************************************************)

(* Empfangen von Datenblöcken mit 16 o. 32-Bit-CRC *)

FUNCTION RZ_ReceiveData (VAR buf : buftype ; blength : INTEGER) : INTEGER;

  LABEL
    crcfoo;

  VAR
    c,
    d          : INTEGER;

    n,
    crc        : WORD;

    crc32      : LONGINT;

    done,
    badcrc,
    uses32crc  : boolean;

BEGIN
   IF (rxframeind = ZBIN32) THEN BEGIN
     crc32:=$FFFFFFFF;
     uses32crc:=TRUE;
     TransferCheck:='CRC-32';
   END  (* of IF THEN *)
   ELSE BEGIN
     crc:=0;
     uses32crc:=FALSE;
     TransferCheck:='CRC-16';
   END;  (* of ELSE *)

   rxcount := 0;
   done:=FALSE;

   REPEAT
      c := Z_GetZDL;

      IF (Hi (c) <> 0) THEN BEGIN
         IF KeyPressed THEN BEGIN
           IF (ReadKey = #27) THEN BEGIN
             Z_SendCan;
             TransferMessage:='Cancelled from keyboard';
             RZ_ReceiveData := ZCAN;
             Exit;
           END;  (* of IF *)
         END;  (* of IF *)

         done:=TRUE;
crcfoo:
         CASE c OF
            GOTCRCE,
            GOTCRCG,
            GOTCRCQ,
            GOTCRCW: BEGIN
                        d:=c;
                        IF uses32crc THEN BEGIN
                          crc32:=UpdC32 (Lo (c),crc32);
                          FOR n:=0 TO 3 DO BEGIN
                            c := Z_GetZDL;
                            IF (Hi (c) <> 0) THEN GOTO crcfoo;
                            crc32:=UpdC32 (Lo (c),crc32)
                          END;
                          badcrc:=(crc32 <> $DEBB20E3);
                        END  (* of IF THEN *)
                        ELSE BEGIN
                          crc := UpdCrc (Lo (c),crc);
                          c:=Z_GetZDL;
                          IF (Hi (c) <> 0) THEN GOTO crcfoo;
                          crc := UpdCrc (Lo (c),crc);
                          c:=Z_GetZDL;
                          IF (Hi (c) <> 0) THEN GOTO crcfoo;
                          crc := UpdCrc (Lo (c),crc);

                          badcrc:=(crc <> 0);
                        END;  (* of ELSE *)

                        IF badcrc THEN BEGIN
                          INC (TransferError);
                          RZ_ReceiveData := ZERROR;
                        END  (* of IF THEN *)
                        ELSE RZ_ReceiveData := d;
                     END;
            GOTCAN : BEGIN
                       TransferMessage:='Got CANned';
                       RZ_ReceiveData := ZCAN;
                     END;
          ZTIMEOUT : BEGIN
                       TransferMessage:='Timeout';
                       RZ_ReceiveData := c;
                     END;
              RCDO : BEGIN
                       TransferMessage:='Lost carrier';
                       RZ_ReceiveData := c;
                     END
              ELSE   BEGIN
                       TransferMessage:='Debris';
                       ClearSeriellBuffer (modemkanal);
                       RZ_ReceiveData := c;
                     END
         END;  (* of CASE *)
      END  (* of IF THEN *)
      ELSE BEGIN
         DEC (blength);
         IF (blength < 0) THEN BEGIN
           TransferMessage:='Long packet';
           RZ_ReceiveData := ZERROR;
           done:=TRUE;
         END  (* of IF THEN *)
         ELSE BEGIN
           buf [INTEGER (rxcount)]:=Lo (c);
           INC (rxcount);
           IF uses32crc THEN
             crc32:= UpdC32 (Lo (c),crc32)
           ELSE crc := UpdCrc (Lo (c),crc);
         END;  (* of ELSE *)
      END;  (* of ELSE *)
   UNTIL done;
END;


(*************************************************************************)

PROCEDURE RZ_AckBibi;

(* ACKnowledge the other ends request to terminate cleanly *)

  VAR
    n : INTEGER;

BEGIN
   Z_PutLongIntoHeader (rxpos);
   n := 4;
   ClearSeriellBuffer (modemkanal);
   REPEAT
      Z_SendHexHeader (ZFIN,txhdr);
      CASE Z_GetByte (2) OF
         ZTIMEOUT,
             RCDO : Exit;
               79 : BEGIN
                      ClearSeriellBuffer (modemkanal);
                      n:=0;
                    END
             ELSE   BEGIN
                      ClearSeriellBuffer (modemkanal);
                      DEC (n)
                    END;
      END;  (* of CASE *)
   UNTIL (n <= 0);
END;


(*************************************************************************)

FUNCTION RZ_InitReceiver: INTEGER;

  VAR
     c,
     n,
     errors : INTEGER;

     stop,
     again  : BOOLEAN;

BEGIN
   FillChar (attn,SizeOf (attn),0);

   n:=10;
   stop:=FALSE;

   WHILE (n > 0) AND NOT (stop) DO BEGIN
     IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
       TransferMessage:='Lost carrier';
       RZ_InitReceiver := ZERROR;
       Exit
     END;

     Z_PutLongIntoHeader (LONGINT (0));

     txhdr [ZF0]:=CANFDX OR CANOVIO OR CANBRK;         (* Full dplx, overlay I/O *)
     IF MakeCRC32 THEN BEGIN                           (* 32-Bit-CRC zulassen    *)
       txhdr [ZF0]:=txhdr [ZF0] OR CANFC32;
     END;  (* of IF *)

     Z_SendHexHeader (tryzhdrtype,txhdr);

     IF (tryzhdrtype = ZSKIP) THEN
        tryzhdrtype := ZRINIT;

        again:=FALSE;
        REPEAT
          c := Z_GetHeader (rxhdr);
          CASE c OF
             ZFILE : BEGIN
                       zconv:=rxhdr [ZF0];
                       tryzhdrtype:=ZRINIT;

                       c := RZ_ReceiveData (secbuf,ZBUFSIZE);

                       IF (c = GOTCRCW) THEN BEGIN
                         RZ_InitReceiver := ZFILE;
                         stop:=TRUE;
                       END  (* of IF THEN *)
                       ELSE BEGIN
                         Z_SendHexHeader (ZNAK,txhdr);
                         again:=TRUE;
                       END;  (* of ELSE *)
                     END;
            ZSINIT : BEGIN
                       c := RZ_ReceiveData (attn,ZBUFSIZE);
                       IF (c = GOTCRCW) THEN
                           Z_SendHexHeader (ZACK,txhdr)
                       ELSE Z_SendHexHeader (ZNAK,txhdr);
                       again:=TRUE;
                     END;
          ZFREECNT : BEGIN
                       Z_PutLongIntoHeader (DiskFree (0));
                       Z_SendHexHeader (ZACK,txhdr);
                       again:=TRUE;
                    END;
         ZCOMMAND : BEGIN
                       c := RZ_ReceiveData (secbuf,ZBUFSIZE);
                       IF (c = GOTCRCW) THEN BEGIN
                          Z_PutLongIntoHeader (LONGINT (0));
                          errors:=0;
                          REPEAT
                             Z_SendHexHeader (ZCOMPL,txhdr);
                             INC (errors)
                          UNTIL (errors > 10) OR (Z_GetHeader(rxhdr) = ZFIN);
                          RZ_AckBibi;
                          RZ_InitReceiver := ZCOMPL;
                          stop:=TRUE;
                       END  (* of IF THEN *)
                       ELSE BEGIN
                         Z_SendHexHeader (ZNAK,txhdr);
                         again:=TRUE;
                       END;  (* of ELSE *)
                    END;
           ZCOMPL,
             ZFIN : BEGIN
                      RZ_InitReceiver := ZCOMPL;
                      stop:=TRUE;
                    END;
             ZCAN,
             RCDO : BEGIN
                      RZ_InitReceiver := c;
                      stop:=TRUE;
                    END
       END;  (* of CASE *)
     UNTIL NOT (again) OR stop;

     DEC (n);
   END;  (* of WHILE *)

   IF NOT (stop) THEN BEGIN
     TransferMessage:='Timeout';
     RZ_InitReceiver := ZERROR;
   END;  (* of IF *)
END;


(*************************************************************************)

FUNCTION RZ_GetHeader: INTEGER;

  VAR
    returncode,
    e,
    p,
    n,
    i          : INTEGER;

    makefile   : BOOLEAN;

    multiplier : LONGINT;

    s,
    tname      : STRING;

    ttime,
    tsize      : LONGINT;

BEGIN
   isbinary := TRUE;    {Force the issue!}

   p := 0;
   s := '';
   WHILE (p < 255) AND (secbuf [p] <> 0) DO BEGIN
     s := s + UpCase (Chr (secbuf [p]));
     INC (p)
   END;
   INC (p);

   (* get rid of drive & path specifiers *)

   WHILE (Pos (':',s) > 0) DO Delete (s,1,Pos (':',s));
   WHILE (Pos ('\',s) > 0) DO Delete (s,1,Pos ('\',s));
   fname := s;

   TransferName:=fname;

(**** done with name ****)

   fsize := LONGINT (0);
   WHILE (p < ZBUFSIZE) AND (secbuf[p] <> $20) AND (secbuf[p] <> 0) DO BEGIN
      fsize := (fsize *10) + Ord(secbuf[p]) - $30;
      INC (p)
   END;
   INC (p);

   TransferSize:=fsize;

(**** done with size ****)

   s := '';
   WHILE (p < ZBUFSIZE) AND (secbuf [p] IN [$30..$37]) DO BEGIN
      s := s + Chr (secbuf[p]);
      INC (p)
   END;
   INC (p);
   ftime := Z_FromUnixDate (s);

(**** done with time ****)

   TransferMessage:='receive data';
   returncode:=ZOK;
   makefile:=FALSE;

   IF RecoverAllow AND (Z_FindFile (zrxpath + fname,tname,tsize,ttime)) THEN BEGIN
      IF (ttime = ftime) THEN BEGIN
        IF (zconv = ZCRESUM) AND (fsize = tsize) THEN BEGIN
           TransferCount:=fsize;
           TransferMessage:='File is already complete';
           returncode := ZSKIP;
        END  (* of IF THEN *)
        ELSE IF (fsize > tsize) THEN BEGIN
           filestart:=tsize;
           TransferCount:=tsize;

           IF (NOT Z_OpenFile (outfile,zrxpath + fname)) THEN BEGIN
              TransferMessage:='Error opening ' + fname;
              returncode := ZERROR;
           END  (* of IF THEN *)
           ELSE BEGIN
             IF (NOT Z_SeekFile (outfile,tsize)) THEN BEGIN
               TransferMessage:='Error positioning file';
               returncode := ZERROR;
             END  (* of IF THEN *)
             ELSE FileAddition:=RecoverFile;
           END;  (* of ELSE *)
        END  (* of ELSE IF THEN *)
        ELSE BEGIN
          makefile:=TRUE;
          FileAddition:=ReplaceFile;
        END;  (* of ELSE *)
      END  (* of IF THEN *)
      ELSE BEGIN
        makefile:=TRUE;
        FileAddition:=ReplaceFile;
      END;  (* of ELSE *)
   END
   ELSE BEGIN
     makefile:=TRUE;
     FileAddition:=NewFile;
   END;  (* of ELSE *)

   IF makefile THEN BEGIN
     filestart:=0;
     TransferCount:=0;
     IF (NOT Z_MakeFile(outfile,zrxpath + fname)) THEN BEGIN
       TransferMessage:='Unable to create ' + fname;
       returncode := ZERROR;
     END;  (* of IF THEN *)
   END;  (* of IF *)

   RZ_GetHeader := returncode;
END;  (* of RZ_GetHeader *)


(*************************************************************************)

FUNCTION RZ_SaveToDisk (VAR rxbytes : LONGINT) : INTEGER;

BEGIN
   ModemStop (modemkanal);
   IF (NOT Z_WriteFile (outfile,secbuf,rxcount)) THEN BEGIN
     TransferMessage:='Disk write error';
     RZ_SaveToDisk := ZERROR
   END
   ELSE RZ_SaveToDisk := ZOK;
   ModemRun (modemkanal);
   INC (rxbytes,rxcount);
END;


(*************************************************************************)

FUNCTION RZ_ReceiveFile : INTEGER;

  LABEL
    err, nxthdr, moredata;

  VAR
    c,
    n       : INTEGER;

    rxbytes : LONGINT;

    sptr    : STRING;

    done    : BOOLEAN;

    numstr  : STRING [10];


  (***********************************************************************)

  FUNCTION SaveDataBlock : INTEGER;

    VAR
      c : INTEGER;

  BEGIN
    n := 10;
    c := RZ_SaveToDisk (rxbytes);
    TransferBytes:=rxbytes - TransferCount;
    SaveDataBlock:=c;
  END;  (* of SaveDataBlock *)


  (***********************************************************************)

BEGIN
   done := TRUE;
   eofseen := FALSE;

   c := RZ_GetHeader;

   IF (c <> ZOK) THEN BEGIN
     IF (c = ZSKIP) THEN tryzhdrtype := ZSKIP;
     RZ_ReceiveFile := c;
     IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);
     Exit
   END;

   c := ZOK;
   n := 10;
   rxbytes := filestart;
   rxpos := filestart;
   ztime := TimeCounter DIV 18;
   zcps := 0;

   TransferCount:=rxbytes;
   TransferBytes:=0;
   TransferTotalTime:=(TransferSize - filestart) DIV (zbaud DIV 10);
   TransferMessage:='receive data';

   IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);

   REPEAT
      Z_PutLongIntoHeader (rxbytes);
      Z_SendHexHeader (ZRPOS,txhdr);

nxthdr:

      c := Z_GetHeader (rxhdr);

      CASE c OF
         ZDATA: BEGIN
                   IF (rxpos <> rxbytes) THEN BEGIN
                     DEC (n);
                     INC (TransferError);
                     IF (n < 0) THEN GOTO err;
                     TransferMessage:='Bad position';
                     Z_PutString (attn)
                   END  (* of IF THEN *)
                   ELSE BEGIN
moredata:
                      IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

                      c := RZ_ReceiveData (secbuf,ZBUFSIZE);
                      TransferBlockSize:=rxcount;

                      CASE c OF
                             ZCAN,
                             RCDO : GOTO err;
                           ZERROR : BEGIN
                                      DEC (n);
                                      INC (TransferError);
                                      Str (TransferCount + TransferBytes,numstr);
                                      TransferMessage:=numstr + ' : Bad CRC';
                                      IF (n < 0) THEN GOTO err;
                                    END;
                         ZTIMEOUT : BEGIN
                                      DEC (n);
                                      INC (TransferError);
                                      Str (TransferCount + TransferBytes,numstr);
                                      TransferMessage:=numstr + ' : Timeout';
                                      IF (n < 0) THEN GOTO err
                                    END;
                          GOTCRCW : BEGIN
                                      c:=SaveDataBlock;
                                      IF (c <> 0) THEN Exit;

                                      Z_PutLongIntoHeader (rxbytes);
                                      Z_SendHexHeader (ZACK,txhdr);

                                      GOTO nxthdr;
                                    END;
                          GOTCRCQ : BEGIN
                                      c:=SaveDataBlock;
                                      IF (c <> 0) THEN Exit;

                                      Z_PutLongIntoHeader (rxbytes);
                                      Z_SendHexHeader (ZACK,txhdr);

                                      GOTO moredata;
                                    END;
                          GOTCRCG : BEGIN
                                      c:=SaveDataBlock;
                                      IF (c <> 0) THEN Exit;

                                      GOTO moredata;
                                    END;
                          GOTCRCE : BEGIN
                                      c:=SaveDataBlock;
                                      IF (c <> 0) THEN Exit;

                                      GOTO nxthdr;
                                    END;
                      END {case}
                   END;  (* of IF *)
                END; {case of ZDATA}
         ZNAK,
         ZTIMEOUT: BEGIN
                     DEC (n);
                     IF (n < 0) THEN GOTO err;
                     TransferBytes:=rxbytes - TransferCount;
                   END;
           ZFILE : c := RZ_ReceiveData (secbuf,ZBUFSIZE);
            ZEOF : IF (rxpos = rxbytes) THEN BEGIN
                     RZ_ReceiveFile := c;
                     Exit
                   END
                   ELSE GOTO nxthdr;
          ZERROR : BEGIN
                     DEC (n);
                     IF (n < 0) THEN GOTO err;
                     TransferBytes:=rxbytes - TransferCount;
                     Z_PutString (attn)
                  END
           ELSE   BEGIN
                    c := ZERROR;
                    GOTO err
                  END
      END; {case}

      IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

   UNTIL (NOT done);

err:

   IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

   RZ_ReceiveFile := ZERROR
END;


(*************************************************************************)

FUNCTION RZ_ReceiveBatch : INTEGER;

  VAR
    s    : STRING;
    c    : INTEGER;
    done : BOOLEAN;

BEGIN
   done := FALSE;

   WHILE NOT (done) DO BEGIN

      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
        RZ_ReceiveBatch := ZERROR;
        Exit
      END;

      c := RZ_ReceiveFile;

      Z_CloseFile (outfile);
      Reset (outfile);
      IF (IOResult = 0) THEN BEGIN
        SetFTime (outfile,ftime);
        Close (outfile);
      END;  (* of IF *)

      CASE c OF
         ZEOF,
         ZSKIP : BEGIN
                   c := RZ_InitReceiver;
                   CASE c OF
                       ZFILE : BEGIN
                                 TransferCount:=0;
                                 TransferBytes:=0;
                                 TransferError:=0;
                                 TransferCheck:='';
                                 TransferMessage:='';
                                 TransferTime:=TimeCounter;
                                 TransferMessage:='Wait for File';
                                 FileAddition:=NewFile;
                               END;
                      ZCOMPL : BEGIN
                                 RZ_AckBibi;
                                 RZ_ReceiveBatch := ZOK;
                                 TransferMessage:='Transfer complet';
                                 Exit
                               END;
                        ELSE   BEGIN
                                 RZ_ReceiveBatch := ZERROR;
                                 Exit
                               END
                   END;  (* of CASE *)
                 END
          ELSE   BEGIN
                   RZ_ReceiveBatch := c;
                   Exit
                  END
      END;  {case}

      IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

   END;  {while}
END;


(*************************************************************************)

PROCEDURE ZmodemReceive;

VAR
   i: INTEGER;

BEGIN
   TransferCount:=0;
   TransferError:=0;
   TransferBlockSize:=0;
   TransferCheck:='';
   TransferMessage:='';

   zstartproc:=startproc;
   zdispproc:=dispproc;

   IF (kanal <> 0) THEN BEGIN
     IF (baudrate <> 0) THEN
       zbaud := baudrate
     ELSE zbaud:=GetBaudrate (kanal);

     modemkanal:=kanal;
     zrxpath := path;
     IF (zrxpath [Length (zrxpath)] <> '\') AND (zrxpath <> '') THEN zrxpath:=zrxpath + '\';

     rxtimeout := 10 * 18;
     tryzhdrtype := ZRINIT;

     {$IFDEF TPZLog}
       Assign (tpzlog,'TPZR.LOG');
       Rewrite (tpzlog);
     {$ENDIF}

     i := RZ_InitReceiver;

     TransferTime:=TimeCounter;

     IF (i = ZCOMPL) OR ((i = ZFILE) AND (RZ_ReceiveBatch = ZOK)) THEN BEGIN
       fehlerflag := TRUE
     END
     ELSE BEGIN
       Z_SendCan;
       fehlerflag := FALSE;
     END;

     {$IFDEF TPZLog}
       Close (tpzlog);
     {$ENDIF}

   END  (* of IF THEN *)
   ELSE BEGIN
     TransferMessage:='no seriell port';
     fehlerflag:=FALSE;
   END;  (* of ELSE *)

   IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
END;


(*######### SEND ROUTINES #####################################*)

VAR
   infile     : FILE;
   strtpos    : LONGINT;
   rxbuflen   : INTEGER;
   txbuf      : buftype;
   blkred     : INTEGER;

   fheaderlen : WORD;


PROCEDURE SZ_Z_SendByte(b: BYTE);

BEGIN
  IF ((b AND $7F) IN [16,17,19,24]) OR (((b AND $7F) = 13) AND ((lastsent AND $7F) = 64)) THEN BEGIN
    Z_SendByte (ZDLE);
    lastsent := (b XOR 64)
  END
  ELSE lastsent := b;
  Z_SendByte (lastsent)
END;


(*************************************************************************)

PROCEDURE SZ_SendBinaryHeader (htype : BYTE ; VAR hdr : hdrtype);

  VAR
    crc   : WORD;

    crc32 : LONGINT;

    n     : INTEGER;

BEGIN
  Z_SendByte (ZPAD);
  Z_SendByte (ZDLE);

  IF send32crc THEN BEGIN
    Z_SendByte (ZBIN32);
    SZ_Z_SendByte (htype);

    crc32 := UpdC32 (htype,$FFFFFFFF);

    FOR n := 0 TO 3 DO BEGIN
       SZ_Z_SendByte (hdr [n]);
       crc32:=UpdC32 (hdr [n],crc32)
    END;

    crc32:=NOT (crc32);

    FOR n := 0 TO 3 DO BEGIN
      SZ_Z_SendByte (BYTE (crc32));
      crc32 := (crc32 SHR 8)
    END;

  END  (* of IF THEN *)
  ELSE BEGIN
    Z_SendByte (ZBIN);
    SZ_Z_SendByte (htype);

    crc := UpdCrc (htype,0);

    FOR n := 0 TO 3 DO BEGIN
       SZ_Z_SendByte (hdr [n]);
       crc:=UpdCrc (hdr [n],crc)
    END;

    crc := UpdCrc (0,crc);
    crc := UpdCrc (0,crc);

    SZ_Z_SendByte (Lo (crc SHR 8));
    SZ_Z_SendByte (Lo (crc));
  END;  (* of ELSE *)

  IF (htype <> ZDATA) THEN Delay (500)
END;


(*************************************************************************)

PROCEDURE SZ_SendData (VAR buf : buftype ; blength : INTEGER ; frameend : BYTE);

  VAR
    crc   : WORD;

    crc32 : LONGINT;

    t     : INTEGER;

BEGIN
  IF send32crc THEN BEGIN
    crc32 := $FFFFFFFF;

    FOR t := 0 TO (blength - 1) DO BEGIN
      SZ_Z_SendByte (buf [t]);
      crc32 := UpdC32 (buf [t],crc32)
    END;

    crc32 := UpdC32 (frameend,crc32);
    crc32 := (NOT crc32);

    Z_SendByte (ZDLE);
    Z_SendByte (frameend);

    FOR t := 0 TO 3 DO BEGIN
      SZ_Z_SendByte (BYTE (crc32));
      crc32 := (crc32 SHR 8)
    END;  (* of FOR *)
  END  (* of IF THEN *)
  ELSE BEGIN
    crc := 0;

    FOR t := 0 TO (blength - 1) DO BEGIN
      SZ_Z_SendByte (buf [t]);
      crc := UpdCrc (buf [t],crc)
    END;

    crc := UpdCrc(frameend,crc);

    Z_SendByte (ZDLE);
    Z_SendByte (frameend);

    crc := UpdCrc (0,crc);
    crc := UpdCrc (0,crc);

    SZ_Z_SendByte (Lo (crc SHR 8));
    SZ_Z_SendByte (Lo (crc));

  END;  (* of ELSE *)

  IF (frameend = ZCRCW) THEN BEGIN
    Z_SendByte (17);
    Delay (500)
  END;  (* of IF *)

END;  (* of SZ_SendData *)


(*************************************************************************)

PROCEDURE SZ_EndSend;

  VAR
    done : BOOLEAN;

BEGIN
   done := FALSE;
   REPEAT
      Z_PutLongIntoHeader (txpos);
      SZ_SendBinaryHeader (ZFIN,txhdr);
      CASE Z_GetHeader (rxhdr) OF
             ZFIN : BEGIN
                      Z_SendByte (Ord ('O'));
                      Z_SendByte (Ord ('O'));
                      Delay (500);
                      Exit
                    END;
             ZCAN,
             RCDO,
            ZFERR,
         ZTIMEOUT : Exit
      END {case}
   UNTIL (done);
END;


(*************************************************************************)

FUNCTION SZ_GetReceiverInfo: INTEGER;

  VAR
    n,
    c,
    rxflags : INTEGER;

BEGIN
   FOR n := 1 TO 10 DO BEGIN
      c := Z_GetHeader (rxhdr);
      CASE c OF
         ZCHALLENGE: BEGIN
                       Z_PutLongIntoHeader (rxpos);
                       Z_SendHexHeader (ZACK,txhdr)
                     END;
           ZCOMMAND: BEGIN
                       Z_PutLongIntoHeader (LONGINT (0));
                       Z_SendHexHeader (ZRQINIT,txhdr)
                     END;
             ZRINIT: BEGIN
                       rxbuflen := (WORD (rxhdr [ZP1]) SHL 8) OR rxhdr [ZP0];
                       send32crc:=MakeCRC32 AND ((rxhdr [ZF0] AND CANFC32) <> 0);
                       IF send32crc THEN
                         TransferCheck:='CRC-32'
                       ELSE TransferCheck:='CRC-16';
                       SZ_GetReceiverInfo := ZOK;
                       Exit
                     END;
           ZCAN,
           RCDO,
           ZTIMEOUT: BEGIN
                       SZ_GetReceiverInfo := ZERROR;
                       Exit
                     END
           ELSE      IF (c <> ZRQINIT) OR (rxhdr [ZF0] <> ZCOMMAND) THEN Z_SendHexHeader (ZNAK,txhdr)
      END {case}
   END; {for}
   SZ_GetReceiverInfo := ZERROR
END;


(*************************************************************************)

FUNCTION SZ_SyncWithReceiver: INTEGER;

  VAR
    c,
    num_errs : INTEGER;

    numstr   : STRING [10];

    done     : BOOLEAN;

BEGIN
   num_errs := 7;
   done := FALSE;

   REPEAT
      c := Z_GetHeader (rxhdr);
      ClearSeriellBuffer (modemkanal);
      CASE c OF
         ZTIMEOUT : BEGIN
                      DEC (num_errs);
                      IF (num_errs < 0) THEN BEGIN
                        TransferMessage:='Timeout';
                        SZ_SyncWithReceiver := ZERROR;
                        Exit
                      END
                    END;
             ZCAN,
           ZABORT,
             ZFIN,
             RCDO : BEGIN
                      TransferMessage:='Abord';
                      SZ_SyncWithReceiver := ZERROR;
                      Exit
                    END;
            ZRPOS : BEGIN
                      IF NOT (Z_SeekFile (infile,rxpos)) THEN BEGIN
                        TransferMessage:='File seek error';
                        SZ_SyncWithReceiver := ZERROR;
                      END  (* of IF THEN *)
                      ELSE BEGIN
                        Str (rxpos,numstr);
                        TransferMessage:=numstr + ' : Bad CRC';
                        txpos := rxpos;
                        SZ_SyncWithReceiver := c;
                      END;  (* of ELSE *)
                      Exit
                    END;
            ZSKIP,
           ZRINIT,
             ZACK : BEGIN
                      TransferMessage:='Wait for file';
                      SZ_SyncWithReceiver := c;
                      Exit
                    END
             ELSE   BEGIN
                      TransferMessage:='I dunno what happened';
                      SZ_SendBinaryHeader (ZNAK,txhdr)
                    END
      END {case}
   UNTIL (done)
END;


(*************************************************************************)

FUNCTION SZ_SendFileData: INTEGER;

LABEL
   waitack, somemore;

VAR
   c,e        : INTEGER;

   newcnt,
   blklen,
   blkred,
   maxblklen,
   goodblks,
   goodneeded : WORD;

   ch         : CHAR;

   stop,
   chflag     : BOOLEAN;

BEGIN
   goodneeded := 1;

   IF (zbaud < 300) THEN
      maxblklen := 128
   ELSE maxblklen := (WORD (zbaud) DIV 300) * 256;

   IF (maxblklen > ZBUFSIZE) THEN maxblklen:=ZBUFSIZE;
   IF (rxbuflen > 0) AND (rxbuflen < maxblklen) THEN maxblklen:=rxbuflen;

   blklen := maxblklen;

   TransferBlockSize:=blklen;

   ztime := TimeCounter DIV 18;

somemore:

   stop:=FALSE;

   REPEAT
     SeriellCheckRead (modemkanal,ch,chflag);
     IF chflag THEN BEGIN
       IF (ch = CHR (XOFF)) OR (ch = CHR (XON)) THEN BEGIN
         ch:=SeriellRead (modemkanal);
         {$IFDEF TPZLog}
           Write (tpzlog,CHAR (c));
         {$ENDIF}
       END  (* of IF THEN *)
       ELSE stop:=TRUE;
     END  (* of IF THEN *)
     ELSE stop:=TRUE;
   UNTIL stop;

   IF chflag THEN BEGIN

WaitAck:

      c := SZ_SyncWithReceiver;

      CASE c OF
          ZSKIP : BEGIN
                    SZ_SendFileData := ZSKIP;
                    Exit
                  END;
           ZACK : {null};
          ZRPOS : BEGIN
                    INC (TransferError);
                    IF ((blklen SHR 2) > 32) THEN
                       blklen := (blklen SHR 2)
                    ELSE blklen := 32;
                    goodblks := 0;
                    goodneeded := (goodneeded SHL 1) OR 1;
                    TransferBlockSize:=blklen;
                  END;
         ZRINIT : BEGIN
                    SZ_SendFileData := ZOK;
                    Exit
                  END
           ELSE   BEGIN
                    SZ_SendFileData := ZERROR;
                    Exit
                  END
      END {case};

      WHILE ReceiverReady (modemkanal) DO BEGIN
         CASE Z_GetByte (2) OF
            CAN,
            ZPAD: GOTO waitack;
            RCDO: BEGIN
                    SZ_SendFileData := ZERROR;
                    Exit
                  END
         END {case}
      END;  (* of WHILE *)
   END; {if char avail}

   newcnt:=rxbuflen;
   Z_PutLongIntoHeader (txpos);
   SZ_SendBinaryHeader (ZDATA,txhdr);

   REPEAT
      IF (KeyPressed) THEN BEGIN
        IF (ReadKey = #27) THEN BEGIN
          TransferMessage:='Aborted from keyboard';
          SZ_SendFileData := ZERROR;
          Exit
        END;
      END;  (* of IF *)

      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
        TransferMessage:='Carrier lost';
        SZ_SendFileData := ZERROR;
        Exit;
      END;  (* of IF *)

      IF NOT (Z_ReadFile (infile,txbuf,blklen,blkred)) THEN BEGIN
        TransferMessage:='Error reading disk';
        SZ_SendFileData := ZERROR;
        Exit
      END;

      IF (blkred < blklen) THEN
        e := ZCRCE
      ELSE IF (rxbuflen <> 0) AND ((newcnt - blkred) <= 0) THEN BEGIN
        newcnt := (newcnt - blkred);
        e := ZCRCW
      END
      ELSE e := ZCRCG;

      SZ_SendData (txbuf,blkred,e);
      INC (txpos,blkred);

      INC (goodblks);
      IF (blklen < maxblklen) AND (goodblks > goodneeded) THEN BEGIN
        IF ((blklen SHL 1) < maxblklen) THEN
          blklen := (blklen SHL 1)
        ELSE blklen := maxblklen;
        goodblks := 0
      END;  (* of IF *)

      TransferBlockSize:=blklen;
      TransferBytes:=txpos - TransferCount;

      IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

      IF (e = ZCRCW) THEN GOTO waitack;

      WHILE ReceiverReady (modemkanal) DO BEGIN
         CASE Z_GetByte (2) OF
            CAN,
            ZPAD : BEGIN
                     TransferMessage:='Trouble';
                     SZ_SendData (txbuf,0,ZCRCE);
                     GOTO waitack
                   END;
            RCDO : BEGIN
                     SZ_SendFileData := ZERROR;
                     Exit
                   END
         END; {case}
      END; (* of WHILE *)

   UNTIL (e <> ZCRCG);

   stop:=FALSE;
   REPEAT
      Z_PutLongIntoHeader (txpos);
      SZ_SendBinaryHeader (ZEOF,txhdr);
      c := SZ_SyncWithReceiver;
      CASE c OF
           ZACK : stop:=TRUE;
          ZRPOS : GOTO somemore;
         ZRINIT : BEGIN
                    SZ_SendFileData := ZOK;
                    TransferMessage:='Transfer complet';
                    stop:=TRUE;
                  END;
          ZSKIP : BEGIN
                    SZ_SendFileData := c;
                    TransferMessage:='Skip file';
                    stop:=TRUE;
                  END
         ELSE     BEGIN
                    SZ_SendFileData := ZERROR;
                    stop:=TRUE;
                  END
      END; {case}

      IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);

   UNTIL (c <> ZACK)
END;


(*************************************************************************)

FUNCTION SZ_SendFile : INTEGER;

  VAR
    c    : INTEGER;
    done : BOOLEAN;

BEGIN
   TransferError:=0;
   TransferBytes:=0;

   done := FALSE;

   REPEAT
      IF (KeyPressed) THEN BEGIN
        IF (ReadKey = #27) THEN BEGIN
          TransferMessage:='Aborted from keyboard';
          SZ_SendFile := ZERROR;
          Exit
        END;
      END;  (* of IF *)

      IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
        TransferMessage:='Lost carrier';
        SZ_SendFile := ZERROR;
        Exit
      END;

      FillChar (txhdr,4,0);

      txhdr [ZF0] := ZCRESUM;                       (* Recover zulassen *)

      SZ_SendBinaryHeader (ZFILE,txhdr);

      SZ_SendData (txbuf,fheaderlen,ZCRCW);

      Delay (500);

      REPEAT
         c := Z_GetHeader (rxhdr);
         CASE c OF
            ZCAN,
            RCDO,
            ZTIMEOUT,
            ZFIN,
            ZABORT: BEGIN
                       SZ_SendFile := ZERROR;
                       Exit
                    END;
            ZRINIT : {null - this will cause a loopback};
              ZCRC : BEGIN
                       Z_PutLongIntoHeader (Z_FileCRC32 (infile));
                       Z_SendHexHeader (ZCRC,txhdr)
                     END;
             ZSKIP : BEGIN
                       SZ_SendFile := c;
                       Exit
                     END;
             ZRPOS : BEGIN
                       IF (NOT Z_SeekFile (infile,rxpos)) THEN BEGIN
                          TransferMessage:='File positioning error';
                          Z_SendHexHeader (ZFERR,txhdr);
                          SZ_SendFile := ZERROR;
                          Exit
                       END;

                       IF (rxpos = 0) THEN FileAddition:=NewFile ELSE FileAddition:=RecoverFile;

                       TransferCount:=rxpos;
                       IF (zstartproc <> NIL) THEN CallUserProcedure (zstartproc);
                       strtpos := rxpos;
                       txpos := rxpos;
                       SZ_SendFile := SZ_SendFileData;
                       Exit;
                    END
         END {case}
      UNTIL (c <> ZRINIT);
   UNTIL (done);
END;


(*************************************************************************)

PROCEDURE ZmodemSend;

VAR
   s: STRING;
   n: INTEGER;

BEGIN
   TransferError := 0;
   TransferTime:=0;
   TransferCount:=0;
   TransferBytes:=0;
   TransferName:='';
   TransferCheck:='';
   TransferSize:=0;
   TransferBlockSize:=0;
   TransferMessage:='';
   FileAddition:=NewFile;

   zstartproc:=startproc;
   zdispproc:=dispproc;

   IF (kanal <> 0) THEN BEGIN
     IF (baudrate <> 0) THEN
       zbaud := baudrate
     ELSE zbaud:=GetBaudrate (kanal);

     modemkanal:=kanal;
     IF NOT (CarrierDetector (modemkanal)) THEN BEGIN
       TransferMessage:='Lost carrier';
       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
       fehler:=103;
       Exit
     END;

     IF (NOT Z_FindFile(pathname,fname,fsize,ftime)) THEN BEGIN
       TransferMessage:='Unable to find/open file';
       IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
       fehler:=10;
       Exit
     END;

     TransferName:=fname;
     TransferSize:=fsize;
     TransferTotalTime:=fsize DIV (zbaud DIV 10);

     Str (fsize,s);
     s:=fname + #0 + s + ' ';
     s:=s + Z_ToUnixDate (ftime);
     FOR n:=1 TO Length (s) DO BEGIN
       IF (s [n] IN ['A'..'Z']) THEN s [n]:=Chr (Ord (s [n]) + $20)
     END;


     FillChar (txbuf,ZBUFSIZE,0);
     Move (s [1],txbuf [0],Length (s));
     fheaderlen:=Length (s);

     IF (zbaud > 0) THEN
        rxtimeout := INTEGER ((614400 DIV zbaud) * 10) DIV 18
     ELSE rxtimeout := 180;
     IF (rxtimeout < 180) THEN rxtimeout := 180;

     attn [0] := Ord('r');
     attn [1] := Ord('z');
     attn [3] := 13;
     attn [4] := 0;

     {$IFDEF TPZLog}
       Assign (tpzlog,'TPZS.LOG');
       Rewrite (tpzlog);
     {$ENDIF}

     Z_PutString (attn);
     FillChar (attn,SizeOf (attn),0);
     Z_PutLongIntoHeader (LONGINT (0));

     TransferTime:=TimeCounter;

     Z_SendHexHeader (ZRQINIT,txhdr);

     IF (SZ_GetReceiverInfo = ZERROR) THEN BEGIN
       fehler:=102;
     END  (* of IF THEN *)
     ELSE BEGIN
       IF NOT (Z_OpenFile (infile,pathname)) THEN BEGIN
         IF (IOresult <> 0) THEN BEGIN
           TransferMessage:='Failure to open file';
           Z_SendCan;
           fehler:=101;
         END;  (* of IF *)
       END  (* of IF THEN *)
       ELSE BEGIN
         n := SZ_SendFile;
         Z_CloseFile (infile);

         CASE n OF
           ZSKIP : fehler:=9;
             ZOK : fehler:=0;
            ZCAN : fehler:=8;
         END;  (* of CASE *)

         IF (n = ZERROR) THEN
           Z_SendCan
         ELSE IF lastfile THEN SZ_EndSend;

       END;  (* of ELSE *)

     END;  (* of ELSE *)

     {$IFDEF TPZLog}
       Close (tpzlog);
     {$ENDIF}

   END  (* of IF THEN *)
   ELSE BEGIN
     TransferMessage:='no seriell port';
     fehler:=105;
   END;  (* of ELSE *)

   IF (zdispproc <> NIL) THEN CallUserProcedure (zdispproc);
END;


(*************************************************************************)

BEGIN
  MakeCRC32:=TRUE;
  RecoverAllow:=TRUE;
END.