Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/turbopas/tpzsfz.arc/TPZ.PAS

Pascal/Delphi Source File | 1988-09-18 | 50KB | 1,883 lines

UNIT TPZ;
INTERFACE
USES Crt, Dos, TPZasync, TPZVideo, TPZFiles, TPZunix, TPZcrc;

FUNCTION Zmodem_Receive(path: STRING; comport: WORD; baudrate: LONGINT): BOOLEAN;
FUNCTION Zmodem_Send(pathname: STRING; lastfile: BOOLEAN; comport: WORD; baudrate: LONGINT): BOOLEAN;

IMPLEMENTATION

CONST
   TPZVER = 'TPZ [Zmodem] 2.1ß';
   ZBUFSIZE = 1024;
   zport: WORD = 1;
   zbaud: LONGINT = 0;

TYPE
   hdrtype = ARRAY[0..3] OF BYTE;
   buftype = ARRAY[0..1023] 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
   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;
   usecrc32: BOOLEAN;
   zcps, zerrors: WORD;
   txpos: LONGINT;
   txhdr: hdrtype;
   ztime: LONGINT;

CONST
   lastsent: BYTE = 0;

FUNCTION Z_SetTimer: LONGINT;
VAR
   l: LONGINT;
   h,m,s,x: WORD;
BEGIN
   GetTime(h,m,s,x);
   l := LONGINT(h) * 3600;
   l := l + LONGINT(m) * 60;
   l := l + LONGINT(s);
   Z_SetTimer := l
END;

FUNCTION Z_FileCRC32(VAR f: FILE): LONGINT;
VAR
   fbuf: buftype;
   crc: LONGINT;
   bread, n: INTEGER;
BEGIN {$I-}
   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; {$I+}

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
   n: INTEGER;
BEGIN
   REPEAT
      IF (NOT Z_Carrier) THEN
      BEGIN
         Z_GetByte := RCDO; { nobody to talk to }
         Exit
      END;
      IF (Z_CharAvail) THEN
      BEGIN
         Z_GetByte := Z_ReceiveByte; { got character }
         Exit
      END;
      Dec(tenths);              { dec. the count    }
      Delay(100)                { pause 1/10th sec. }
   UNTIL (tenths <= 0);
   Z_GetByte := ZTIMEOUT        { timed out }
END;

FUNCTION Z_qk_read: INTEGER;
(* Just like Z_GetByte, but timeout value is in *)
(* global var rxtimeout.                        *)
BEGIN
   Z_qk_read := Z_GetByte(rxtimeout)
END;


FUNCTION Z_TimedRead: INTEGER;
(* A Z_qk_read, that strips parity and *)
(* ignores XON/XOFF characters.        *)
VAR
   done: BOOLEAN;
   c: INTEGER;
BEGIN
   done := FALSE;
   REPEAT
      c := Z_qk_read AND $FF7F                { strip parity }
   UNTIL (c < 0) OR (NOT (Lo(c) IN [17,19])); { wait for other than XON/XOFF }
   Z_TimedRead := c
END;

PROCEDURE Z_SendCan;
(* Send a zmodem CANcel sequence to the other guy *)
(* 8 CANs and 8 backspaces                        *)
VAR
   n: BYTE;
BEGIN
   Z_ClearOutbound; { spare them the junk }
   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: INTEGER;
BEGIN
   n := 0;
   WHILE (n < ZBUFSIZE) AND (p[n] <> 0) DO
   BEGIN
      CASE p[n] OF
         221 : Z_SendBreak;
         222 : Delay(2000)
         ELSE
            Z_SendByte(p[n])
      END;
      Inc(n)
   END
END;

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   }
   IF (NOT Z_Carrier) THEN
      Z_ClearOutbound
END;

FUNCTION Z_PullLongFromHeader(VAR hdr: hdrtype): LONGINT;
(* Stuffs a longint into a header variable - N.B. - bytes are REVERSED! *)
VAR
   l: LONGINT;
BEGIN
   l := hdr[ZP3];               { hard coded for efficiency }
   l := (l SHL 8) OR hdr[ZP2];
   l := (l SHL 8) OR hdr[ZP1];
   l := (l SHL 8) OR hdr[ZP0];
   Z_PullLongFromHeader := l
END;

PROCEDURE Z_PutLongIntoHeader(l: LONGINT);
(* Reverse of above *)
BEGIN
   txhdr[ZP0] := BYTE(l);
   txhdr[ZP1] := BYTE(l SHR 8);
   txhdr[ZP2] := BYTE(l SHR 16);
   txhdr[ZP3] := BYTE(l SHR 24)
END;

FUNCTION Z_GetZDL: INTEGER;
(* Gets a byte and processes for ZMODEM escaping or CANcel sequence *)
VAR
   c, d: INTEGER;
BEGIN
   IF (NOT Z_Carrier) THEN
   BEGIN
      Z_GetZDL := RCDO;
      Exit
   END;
   c := Z_qk_read;
   IF (c <> ZDLE) THEN
   BEGIN
      Z_GetZDL := c;
      Exit
   END;   {got ZDLE or 1st CAN}
   c := Z_qk_read;
   IF (c = CAN) THEN  {got 2nd CAN}
   BEGIN
      c := Z_qk_read;
      IF (c = CAN) THEN {got 3rd CAN}
      BEGIN
         c := Z_qk_read;
         IF (c = CAN) THEN {got 4th CAN}
            c := Z_qk_read
      END
   END;
   { 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
   END
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                  {get the 4 bytes}
   BEGIN
      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(zerrors);
      Z_Errors(zerrors);
      Z_GetHexHeader := ZERROR;
      Exit
   END;
   IF (Z_GetByte(1) = 13) THEN           {throw away CR/LF}
      c := Z_GetByte(1);
   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(zerrors);
      Z_Errors(zerrors);
      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   {this is the polynomial value}
   BEGIN
      Inc(zerrors);
      Z_Errors(zerrors);
      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
   n := zbaud * 2;                    {A guess at the # of garbage characters}
   cancount := 5;                     {to expect.                            }
   usecrc32 := FALSE;                 {assume 16 bit until proven otherwise  }
again:
   IF (KeyPressed) THEN               {check for operator panic}
      IF (ReadKey = #27) THEN         {in the form of ESCape   }
      BEGIN
         Z_SendCan;                              {tell the other end,   }
         Z_message('Cancelled from keyboard');  {the operator,         }
         Z_GetHeader := ZCAN;                   {and the rest of the   }
         Exit                                   {routines to forget it.}
      END;
   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(1);
              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(zerrors);
            Z_Errors(zerrors);
            Z_message('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;

FUNCTION RZ_ReceiveDa32(VAR buf: buftype; blength: INTEGER): INTEGER;
(* Get a 32 bit CRC data block *)
LABEL
   crcfoo;
VAR
   c, d, n: INTEGER;
   crc: LONGINT;
   done: boolean;
BEGIN
   usecrc32 := TRUE;
   crc := $FFFFFFFF;
   rxcount := 0;
   done := FALSE;
   REPEAT
      c := Z_GetZDL;
      IF (Hi(c) <> 0) THEN
      BEGIN
crcfoo:  CASE c OF
            GOTCRCE,
            GOTCRCG,
            GOTCRCQ,
            GOTCRCW: BEGIN
                        d := c;
                        crc := UpdC32(Lo(c),crc);
                        FOR n := 0 TO 3 DO
                        BEGIN
                           c := Z_GetZDL;
                           IF (Hi(c) <> 0) THEN
                              GOTO crcfoo;
                           crc := UpdC32(Lo(c),crc)
                        END;
                        IF (crc <> $DEBB20E3) THEN
                        BEGIN
                           Inc(zerrors);
                           Z_Errors(zerrors);
                           RZ_ReceiveDa32 := ZERROR
                        END
                        ELSE
                           RZ_ReceiveDa32 := d;
                        DONE := TRUE
                     END;
            GOTCAN: BEGIN
                       RZ_ReceiveDa32 := ZCAN;
                       DONE := TRUE
                    END;
            ZTIMEOUT: BEGIN
                         RZ_ReceiveDa32 := c;
                         DONE := TRUE
                      END;
            RCDO: BEGIN
                     RZ_ReceiveDa32 := c;
                     done := TRUE
                  END
            ELSE
            BEGIN
               Z_message('Debris');
               Z_ClearInbound;
               RZ_ReceiveDa32 := c;
               DONE := TRUE
            END
         END
      END;
      IF (NOT done) THEN
      BEGIN
         Dec(blength);
         IF (blength < 0) THEN
         BEGIN
            Z_message('Long packet');
            RZ_ReceiveDa32 := ZERROR;
            done := TRUE
         END;
         buf[INTEGER(rxcount)] := Lo(c);
         Inc(rxcount);
         crc := UpdC32(Lo(c),crc)
      END
   UNTIL done
END;

FUNCTION RZ_ReceiveData(VAR buf: buftype; blength: INTEGER): INTEGER;
(* get a 16 bit CRC data block *)
LABEL
   crcfoo;
VAR
   c, d: INTEGER;
   crc: WORD;
   done: boolean;
BEGIN
   IF (rxframeind = ZBIN32) THEN
   BEGIN
      Z_ShowCheck(TRUE);
      RZ_ReceiveData := RZ_ReceiveDa32(buf,blength);
      Exit
   END;
   Z_ShowCheck(FALSE);
   crc := 0;
   rxcount := 0;
   done := FALSE;
   REPEAT
      c := Z_GetZDL;
      IF (Hi(c) <> 0) THEN
      BEGIN
crcfoo:  CASE c OF
            GOTCRCE,
            GOTCRCG,
            GOTCRCQ,
            GOTCRCW: BEGIN
                        d := c;
                        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);
                        IF (crc <> 0) THEN
                        BEGIN
                           Inc(zerrors);
                           Z_Errors(zerrors);
                           RZ_ReceiveData := ZERROR;
                           done := TRUE
                        END;
                        RZ_ReceiveData := d;
                        DONE := TRUE
                     END;
            GOTCAN: BEGIN
                       Z_Message('Got CANned');
                       RZ_ReceiveData := ZCAN;
                       DONE := TRUE
                    END;
            ZTIMEOUT: BEGIN
                         RZ_ReceiveData := c;
                         DONE := TRUE
                      END;
            RCDO: BEGIN
                     Z_Message('Lost carrier');
                     RZ_ReceiveData := c;
                     done := TRUE
                  END
            ELSE
            BEGIN
               Z_message('Debris');
               Z_ClearInbound;
               RZ_ReceiveData := c;
               DONE := TRUE
            END
         END
      END;
      IF (NOT done) THEN
      BEGIN
         Dec(blength);
         IF (blength < 0) THEN
         BEGIN
            Z_message('Long packet');
            RZ_ReceiveData := ZERROR;
            done := TRUE
         END;
         buf[INTEGER(rxcount)] := Lo(c);
         Inc(rxcount);
         crc := UpdCrc(Lo(c),crc)
      END
   UNTIL done
END;

PROCEDURE RZ_AckBibi;
(* ACKnowledge the other ends request to terminate cleanly *)
VAR
   n: INTEGER;
BEGIN
   Z_PutLongIntoHeader(rxpos);
   n := 4;
   Z_ClearInbound;
   REPEAT
      Z_SendHexHeader(ZFIN,txhdr);
      CASE Z_GetByte(20) OF
         ZTIMEOUT,
         RCDO: Exit;
         79: BEGIN
                IF (Z_GetByte(10) = 79) THEN
                   {null};
                Z_ClearInbound;
                Exit
             END
         ELSE
            Z_ClearInbound;
            Dec(n)
      END
   UNTIL (n <= 0)
END;

FUNCTION RZ_InitReceiver: INTEGER;
LABEL
   again;
VAR
   c, n, errors: INTEGER;
BEGIN
   FillChar(attn,SizeOf(attn),0);
   zerrors := 0;
   FOR n := 10 DOWNTO 0 DO
   BEGIN
      IF (NOT Z_Carrier) THEN
      BEGIN
         Z_Message('Lost carrier');
         RZ_InitReceiver := ZERROR;
         Exit
      END;
      Z_PutLongIntoHeader(LONGINT(0));
      txhdr[ZF0] := CANFDX OR CANOVIO OR CANFC32 OR CANBRK; {Full dplx, overlay I/O and CRC32}
      Z_SendHexHeader(tryzhdrtype,txhdr);
      IF (tryzhdrtype = ZSKIP) THEN
         tryzhdrtype := ZRINIT;
again:
         c := Z_GetHeader(rxhdr);
         Z_Frame(c);
         CASE c OF
         ZFILE: BEGIN
                   zconv := rxhdr[ZF0];
                   tryzhdrtype := ZRINIT;
                   c := RZ_ReceiveData(secbuf,ZBUFSIZE);
                   Z_Frame(c);
                   IF (c = GOTCRCW) THEN
                   BEGIN
                      RZ_InitReceiver := ZFILE;
                      Exit
                   END;
                   Z_SendHexHeader(ZNAK,txhdr);
                   GOTO again
                END;
         ZSINIT: BEGIN
                   c := RZ_ReceiveData(attn,ZBUFSIZE);
                   Z_Frame(c);
                   IF (c = GOTCRCW) THEN
                       Z_SendHexHeader(ZACK,txhdr)
                    ELSE
                       Z_SendHexHeader(ZNAK,txhdr);
                    GOTO again
                 END;
         ZFREECNT: BEGIN
                      Z_PutLongIntoHeader(DiskFree(0));
                      Z_SendHexHeader(ZACK,txhdr);
                      GOTO again
                   END;
         ZCOMMAND: BEGIN
                      c := RZ_ReceiveData(secbuf,ZBUFSIZE);
                      Z_Frame(c);
                      IF (c = GOTCRCW) THEN
                      BEGIN
                         Z_PutLongIntoHeader(LONGINT(0));
                         REPEAT
                            Z_SendHexHeader(ZCOMPL,txhdr);
                            Inc(errors)
                         UNTIL (errors > 10) OR (Z_GetHeader(rxhdr) = ZFIN);
                         RZ_AckBibi;
                         RZ_InitReceiver := ZCOMPL;
                         Exit
                      END;
                      Z_SendHexHeader(ZNAK,txhdr);
                      GOTO again
                   END;
         ZCOMPL,
         ZFIN: BEGIN
                  RZ_InitReceiver := ZCOMPL;
                  Exit
               END;
         ZCAN,
         RCDO: BEGIN
                  RZ_InitReceiver := c;
                  Exit
               END
      END
   END;
   Z_message('Timeout');
   RZ_InitReceiver := ZERROR
END;

FUNCTION RZ_GetHeader: INTEGER;
VAR
   e, p, n, i: INTEGER;
   multiplier: LONGINT;
   s: STRING;
   ttime, tsize: LONGINT;
   tname: STRING;
BEGIN
   isbinary := TRUE;    {Force the issue!}
   fsize := LONGINT(0);
   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;

(**** 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);

(**** 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 ****)

   IF (Z_FindFile(zrxpath+fname,tname,tsize,ttime)) THEN
   BEGIN
      IF (zconv = ZCRESUM) AND (fsize > tsize) THEN
      BEGIN
         filestart := tsize;
         IF (NOT Z_OpenFile(outfile,zrxpath + fname)) THEN
         BEGIN
            Z_message('Error opening '+fname);
            RZ_GetHeader := ZERROR;
            Exit
         END;
         IF (NOT Z_SeekFile(outfile,tsize)) THEN
         BEGIN
            Z_Message('Error positioning file');
            RZ_GetHeader := ZERROR;
            Exit
         END;
         Z_Message('Recovering')
      END
      ELSE
      BEGIN
         Z_ShowName(fname);
         Z_Message('File is already complete');
         RZ_GetHeader := ZSKIP;
         Exit
      END
   END
   ELSE
   BEGIN
      filestart := 0;
      IF (NOT Z_MakeFile(outfile,zrxpath + fname)) THEN
      BEGIN
         Z_message('Unable to create '+fname);
         RZ_GetHeader := ZERROR;
         Exit
      END
   END;
   Z_ShowName(fname);
   Z_ShowSize(fsize);
   Z_ShowTransferTime(fsize,zbaud);
   RZ_GetHeader := ZOK
END;

FUNCTION RZ_SaveToDisk(VAR rxbytes: LONGINT): INTEGER;
BEGIN
   IF (KeyPressed) THEN
      IF (ReadKey = #27) THEN
      BEGIN
         Z_message('Aborted from keyboard');
         Z_SendCan;
         RZ_SaveToDisk := ZERROR;
         Exit
      END;
   IF (NOT Z_WriteFile(outfile,secbuf,rxcount)) THEN
   BEGIN
      Z_Message('Disk write error');
      RZ_SaveToDisk := ZERROR
   END
   ELSE
      RZ_SaveToDisk := ZOK;
   rxbytes := rxbytes + rxcount
END;

FUNCTION RZ_ReceiveFile: INTEGER;
LABEL
   err, nxthdr, moredata;
VAR
   c, n: INTEGER;
   rxbytes: LONGINT;
   sptr: STRING;
   done: BOOLEAN;
BEGIN
   zerrors := 0;
   done := FALSE;
   eofseen := FALSE;
   c := RZ_GetHeader;
   IF (c <> ZOK) THEN
   BEGIN
      IF (c = ZSKIP) THEN
         tryzhdrtype := ZSKIP;
      RZ_ReceiveFile := c;
      Exit
   END;
   c := ZOK;
   n := 10;
   rxbytes := filestart;
   rxpos := filestart;
   ztime := Z_SetTimer;
   zcps := 0;
   REPEAT
      Z_PutLongIntoHeader(rxbytes);
      Z_SendHexHeader(ZRPOS,txhdr);
nxthdr:
      c := Z_GetHeader(rxhdr);
      Z_Frame(c);
      CASE c OF
         ZDATA: BEGIN
                   IF (rxpos <> rxbytes) THEN
                   BEGIN
                      Dec(n);
                      Inc(zerrors);
                      Z_Errors(zerrors);
                      IF (n < 0) THEN
                         GOTO err;
                      Z_message('Bad position');
                      Z_PutString(attn)
                   END
                   ELSE
                   BEGIN
moredata:
                      c := RZ_ReceiveData(secbuf,ZBUFSIZE);
                      Z_Frame(c);
                      CASE c OF
                         ZCAN,
                         RCDO: GOTO err;
                         ZERROR: BEGIN
                                    Dec(n);
                                    Inc(zerrors);
                                    Z_Errors(zerrors);
                                    IF (n < 0) THEN
                                        GOTO err;
                                    Z_PutString(attn)
                                 END;
                         ZTIMEOUT: BEGIN
                                      Dec(n);
                                      IF (n < 0) THEN
                                         GOTO err
                                   END;
                         GOTCRCW: BEGIN
                                     n := 10;
                                     c := RZ_SaveToDisk(rxbytes);
                                     IF (c <> ZOK) THEN
                                     BEGIN
                                        RZ_ReceiveFile := c;
                                        Exit
                                     END;
                                     Z_ShowLoc(rxbytes);
                                     Z_PutLongIntoHeader(rxbytes);
                                     Z_SendHexHeader(ZACK,txhdr);
                                     GOTO nxthdr
                                  END;
                         GOTCRCQ: BEGIN
                                     n := 10;
                                     c := RZ_SaveToDisk(rxbytes);
                                     IF (c <> ZOK) THEN
                                     BEGIN
                                        RZ_ReceiveFile := c;
                                        Exit
                                     END;
                                     Z_ShowLoc(rxbytes);
                                     Z_PutLongIntoHeader(rxbytes);
                                     Z_SendHexHeader(ZACK,txhdr);
                                     GOTO moredata
                                  END;
                         GOTCRCG: BEGIN
                                     n := 10;
                                     c := RZ_SaveToDisk(rxbytes);
                                     IF (c <> ZOK) THEN
                                     BEGIN
                                        RZ_ReceiveFile := c;
                                        Exit
                                     END;
                                     Z_ShowLoc(rxbytes);
                                     GOTO moredata
                                  END;
                         GOTCRCE: BEGIN
                                     n := 10;
                                     c := RZ_SaveToDisk(rxbytes);
                                     IF (c <> ZOK) THEN
                                     BEGIN
                                        RZ_ReceiveFile := c;
                                        Exit
                                     END;
                                     Z_ShowLoc(rxbytes);
                                     GOTO nxthdr
                                  END
                      END {case}
                   END
                END; {case of ZDATA}
         ZNAK,
         ZTIMEOUT: BEGIN
                      Dec(n);
                      IF (n < 0) THEN
                         GOTO err;
                      Z_ShowLoc(rxbytes)
                   END;
         ZFILE: BEGIN
                   c := RZ_ReceiveData(secbuf,ZBUFSIZE);
                   Z_Frame(c)
                END;
         ZEOF: IF (rxpos = rxbytes) THEN
               BEGIN
                  RZ_ReceiveFile := c;
                  Exit
               END
               ELSE
                  GOTO nxthdr;
         ZERROR: BEGIN
                    Dec(n);
                    IF (n < 0) THEN
                       GOTO err;
                    Z_ShowLoc(rxbytes);
                    Z_PutSTring(attn)
                 END
         ELSE
         BEGIN
            c := ZERROR;
            GOTO err
         END
      END {case}
   UNTIL (NOT done);
err:
   RZ_ReceiveFile := ZERROR
END;

FUNCTION RZ_ReceiveBatch: INTEGER;
VAR
   s: STRING;
   c: INTEGER;
   done: BOOLEAN;
BEGIN
   Z_Message('Receiving...');
   done := FALSE;
   WHILE (NOT done) DO
   BEGIN
      IF NOT (Z_Carrier) THEN
      BEGIN
         RZ_ReceiveBatch := ZERROR;
         Exit
      END;
      c := RZ_ReceiveFile;
      zcps := fsize DIV (Z_SetTimer - ztime);
      Z_Frame(c);
      Z_SetFTime(outfile,ftime);
      Z_CloseFile(outfile);
      Str(zcps:4,s);
      Z_Message(s+' cps');
      CASE c OF
         ZEOF,
         ZSKIP: BEGIN
                   c := RZ_InitReceiver;
                   Z_Frame(c);
                   CASE c OF
                      ZFILE: {null};
                      ZCOMPL: BEGIN
                                 RZ_AckBibi;
                                 RZ_ReceiveBatch := ZOK;
                                 Exit
                              END;
                      ELSE
                      BEGIN
                         RZ_ReceiveBatch := ZERROR;
                         Exit
                      END
                   END
                END
         ELSE
         BEGIN
            RZ_ReceiveBatch := c;
            Exit
         END
      END {case}
   END {while}
END;


FUNCTION Zmodem_Receive(path: STRING; comport: WORD; baudrate: LONGINT): BOOLEAN;
VAR
   i: INTEGER;
BEGIN
   zbaud := baudrate;
   zport := comport;
   Z_OpenWindow(TPZVER);
   Z_Message('Initializing...');
   IF (NOT Z_AsyncOn(comport,baudrate)) THEN
   BEGIN
      ClrScr;
      WRITELN('Unable to open:');
      WRITELN('Port: ',comport);
      WRITELN('Baud: ',baudrate);
      Delay(2000);
      Z_CloseWindow;
      Zmodem_Receive := FALSE;
      Exit
   END;
   zrxpath := path;
   IF (zrxpath[Length(zrxpath)] <> '\') AND (zrxpath <> '') THEN
      zrxpath := zrxpath + '\';
   rxtimeout := 100;
   tryzhdrtype := ZRINIT;
   i := RZ_InitReceiver;
   IF (i = ZCOMPL) OR ((i = ZFILE) AND ((RZ_ReceiveBatch) = ZOK)) THEN
   BEGIN
      Z_Message('Restoring async params');
      Z_AsyncOff;
      Z_CloseWindow;
      Zmodem_Receive := TRUE
   END
   ELSE
   BEGIN
      Z_ClearOutbound;
      Z_Message('Sending CAN');
      Z_SendCan;
      Z_Message('Restoring async params');
      Z_AsyncOff;
      Z_CloseWindow;
      Zmodem_Receive := FALSE;
   END
END;


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



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


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_SendBinaryHead32(htype: BYTE; VAR hdr: hdrtype);
VAR
   crc: LONGINT;
   n: INTEGER;
BEGIN
   Z_SendByte(ZPAD);
   Z_SendByte(ZDLE);
   Z_SendByte(ZBIN32);
   SZ_Z_SendByte(htype);
   crc := UpdC32(htype,$FFFFFFFF);
   FOR n := 0 TO 3 DO
   BEGIN
      SZ_Z_SendByte(hdr[n]);
      crc := UpdC32(hdr[n],crc)
   END;
   crc := (NOT crc);
   FOR n := 0 TO 3 DO
   BEGIN
      SZ_Z_SendByte(BYTE(crc));
      crc := (crc SHR 8)
   END;
   IF (htype <> ZDATA) THEN
      Delay(500)
END;

PROCEDURE SZ_SendBinaryHeader(htype: BYTE; VAR hdr: hdrtype);
VAR
   crc: WORD;
   n: INTEGER;
BEGIN
   IF (usecrc32) THEN
   BEGIN
      SZ_SendBinaryHead32(htype,hdr);
      Exit
   END;
   Z_SendByte(ZPAD);
   Z_SendByte(ZDLE);
   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));
   IF (htype <> ZDATA) THEN
      Delay(500)
END;

PROCEDURE SZ_SendDa32(VAR buf: buftype; blength: INTEGER; frameend: BYTE);
VAR
   crc: LONGINT;
   t: INTEGER;
BEGIN
   crc := $FFFFFFFF;
   FOR t := 0 TO (blength - 1) DO
   BEGIN
      SZ_Z_SendByte(buf[t]);
      crc := UpdC32(buf[t],crc)
   END;
   crc := UpdC32(frameend,crc);
   crc := (NOT crc);
   Z_SendByte(ZDLE);
   Z_SendByte(frameend);
   FOR t := 0 TO 3 DO
   BEGIN
      SZ_Z_SendByte(BYTE(crc));
      crc := (crc SHR 8)
   END;
   BEGIN
      Z_SendByte(17);
      Delay(500)
   END
END;

PROCEDURE SZ_SendData(VAR buf: buftype; blength: INTEGER; frameend: BYTE);
VAR
   crc: WORD;
   t: INTEGER;
BEGIN
   IF (usecrc32) THEN
   BEGIN
      SZ_SendDa32(buf,blength,frameend);
      Exit
   END;
   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));
   IF (frameend = ZCRCW) THEN
   BEGIN
      Z_SendByte(17);
      Delay(500)
   END
END;


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);
                  Z_ClearOutbound;
                  Exit
               END;
         ZCAN,
         RCDO,
         ZFERR,
         ZTIMEOUT: Exit
      END {case}
   UNTIL (done)
END;

FUNCTION SZ_GetReceiverInfo: INTEGER;
VAR
   rxflags, n, c: INTEGER;
BEGIN
   Z_Message('Getting info.');
   FOR n := 1 TO 10 DO
   BEGIN
      c := Z_GetHeader(rxhdr);
      Z_Frame(c);
      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];
                    usecrc32 := ((rxhdr[ZF0] AND CANFC32) <> 0);
                    Z_ShowCheck(usecrc32);
                    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;
   done: BOOLEAN;
BEGIN
   num_errs := 7;
   done := FALSE;
   REPEAT
      c := Z_GetHeader(rxhdr);
      Z_Frame(c);
      Z_ClearInbound;
      CASE c OF
         ZTIMEOUT: BEGIN
                      Dec(num_errs);
                      IF (num_errs < 0) THEN
                      BEGIN
                         SZ_SyncWithReceiver := ZERROR;
                         Exit
                      END
                   END;
         ZCAN,
         ZABORT,
         ZFIN,
         RCDO: BEGIN
                  SZ_SyncWithReceiver := ZERROR;
                  Exit
               END;
         ZRPOS: BEGIN
                   IF (NOT Z_SeekFile(infile,rxpos)) THEN
                   BEGIN
                      Z_Message('File seek error');
                      SZ_SyncWithReceiver := ZERROR;
                      Exit
                   END;
                   Z_Message('Repositioning...');
                   Z_ShowLoc(rxpos);
                   txpos := rxpos;
                   SZ_SyncWithReceiver := c;
                   Exit
                END;
         ZSKIP,
         ZRINIT,
         ZACK: BEGIN
                  SZ_SyncWithReceiver := c;
                  Exit
               END
         ELSE
         BEGIN
            Z_Message('I dunno what happened!');
            SZ_SendBinaryHeader(ZNAK,txhdr)
         END
      END {case}
   UNTIL (done)
END;


FUNCTION SZ_SendFileData: INTEGER;
LABEL
   waitack, somemore, oops;
VAR
   c, e: INTEGER;
   newcnt, blklen, blkred, maxblklen, goodblks, goodneeded: WORD;
BEGIN
   Z_Message('Sending file...');
   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;
   ztime := Z_SetTimer;
somemore:
   IF (Z_CharAvail) THEN
   BEGIN
WaitAck:
      c := SZ_SyncWithReceiver;
      Z_Frame(c);
      CASE c OF
         ZSKIP: BEGIN
                   SZ_SendFileData := ZSKIP;
                   Exit
                END;
         ZACK: {null};
         ZRPOS: BEGIN
                   Inc(zerrors);
                   Z_Errors(zerrors);
                   IF ((blklen SHR 2) > 32) THEN
                      blklen := (blklen SHR 2)
                   ELSE
                      blklen := 32;
                   goodblks := 0;
                   goodneeded := (goodneeded SHL 1) OR 1
                END;
         ZRINIT: BEGIN
                    SZ_SendFileData := ZOK;
                    Exit
                 END
         ELSE
         BEGIN
            SZ_SendFileData := ZERROR;
            Exit
         END
      END {case};
      WHILE (Z_CharAvail) DO
      BEGIN
         CASE (Z_GetByte(1)) OF
            CAN,
            ZPAD: GOTO waitack;
            RCDO: BEGIN
                     SZ_SendFileData := ZERROR;
                     Exit
                  END
         END {case}
      END
   END; {if char avail}
   newcnt := rxbuflen;
   Z_PutLongIntoHeader(txpos);
   SZ_SendBinaryHeader(ZDATA,txhdr);
   Z_Message('Sending data header');
   REPEAT
      IF (KeyPressed) THEN
         IF (ReadKey = #27) THEN
         BEGIN
            Z_Message('Aborted from keyboard');
            Z_SendCan;
            GOTO oops
         END;
      IF (NOT Z_Carrier) THEN
         GOTO oops;
      IF (NOT Z_ReadFile(infile,txbuf,blklen,blkred)) THEN
      BEGIN
         Z_Message('Error reading disk');
         Z_SendCan;
         GOTO oops
      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);
      txpos := txpos + blkred;
      Z_ShowLoc(txpos);
      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;
      IF (e = ZCRCW) THEN
         GOTO waitack;
      WHILE (Z_CharAvail) DO
      BEGIN
         CASE Z_GetByte(1) OF
            CAN,
            ZPAD: BEGIN
                     Z_Message('Trouble?');
                     Z_ClearOutbound;
                     SZ_SendData(txbuf,0,ZCRCE);
                     GOTO waitack
                  END;
            RCDO: BEGIN
                     SZ_SendFileData := ZERROR;
                     Exit
                  END
         END {case}
      END {while}
   UNTIL (e <> ZCRCG);
   REPEAT
      Z_PutLongIntoHeader(txpos);
      Z_Message('Sending EOF');
      SZ_SendBinaryHeader(ZEOF,txhdr);
      c := SZ_SyncWithReceiver;
      CASE c OF
         ZACK: {null};
         ZRPOS: GOTO somemore;
         ZRINIT: BEGIN
                    SZ_SendFileData := ZOK;
                    Exit
                 END;
         ZSKIP: BEGIN
                   SZ_SendFileData := c;
                   Exit
                END
         ELSE
oops:    BEGIN
            SZ_SendFileData := ZERROR;
            Exit
         END
      END {case}
   UNTIL (c <> ZACK)
END;

FUNCTION SZ_SendFile: INTEGER;
VAR
   c: INTEGER;
   done: BOOLEAN;
BEGIN
   zerrors := WORD(0);
   done := FALSE;
   REPEAT
      IF (KeyPressed) THEN
         IF (ReadKey = #27) THEN
         BEGIN
            Z_SendCan;
            Z_Message('Aborted from keyboard');
            SZ_SendFile := ZERROR;
            Exit
         END;
      IF (NOT Z_Carrier) THEN
      BEGIN
         Z_Message('Lost carrier');
         SZ_SendFile := ZERROR;
         Exit
      END;
      FillChar(txhdr,4,0);
      txhdr[ZF0] := ZCRESUM; {recover}
      SZ_SendBinaryHeader(ZFILE,txhdr);
      SZ_SendData(txbuf,ZBUFSIZE,ZCRCW);
      REPEAT
         c := Z_GetHeader(rxhdr);
         Z_Frame(c);
         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
                         Z_Message('File positioning error');
                         Z_SendHexHeader(ZFERR,txhdr);
                         SZ_SendFile := ZERROR;
                         Exit
                      END;
                      Z_Message('Setting start position');
                      Z_ShowLoc(rxpos);
                      strtpos := rxpos;
                      txpos := rxpos;
                      SZ_SendFile := SZ_SendFileData;
                      Exit
                   END
         END {case}
      UNTIL (c <> ZRINIT)
   UNTIL (done)
END;

FUNCTION Zmodem_Send(pathname: STRING; lastfile: BOOLEAN; comport: WORD; baudrate: LONGINT): BOOLEAN;

VAR
   s: STRING;
   n: INTEGER;
BEGIN
   zerrors := 0;
   zbaud := baudrate;
   zport := comport;
   Z_OpenWindow(TPZVER);
   IF (NOT Z_AsyncOn(comport,baudrate)) THEN
   BEGIN
      Z_Message('Unable to open port');
      Delay(2000);
      Z_CloseWindow;
      Zmodem_Send := FALSE;
      Exit
   END;
   IF (NOT Z_Carrier) THEN
   BEGIN
      Z_Message('Lost carrier');
      Delay(2000);
      Z_CloseWindow;
      Z_AsyncOff;
      Zmodem_Send := FALSE;
      Exit
   END;
   IF (NOT Z_FindFile(pathname,fname,fsize,ftime)) THEN
   BEGIN
      Z_Message('Unable to find/open file');
      SZ_EndSend;
      Z_CloseWindow;
      Z_AsyncOff;
      Zmodem_Send := FALSE;
      Exit
   END;
   Z_ShowName(fname);
   Z_ShowSize(fsize);
   Z_ShowTransferTime(fsize,zbaud);
   Str(fsize,s);
   s := (fname + #0 + s + ' ');
   s := s + Z_ToUnixDate(ftime);
   n := Length(s);
   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));
   IF (zbaud > 0) THEN
      rxtimeout := INTEGER(614400 DIV zbaud)
   ELSE
      rxtimeout := 100;
   IF (rxtimeout < 100) THEN
      rxtimeout := 100;
   attn[0] := Ord('r');
   attn[1] := Ord('z');
   attn[3] := 13;
   attn[4] := 0;
   Z_PutString(attn);
   FillChar(attn,SizeOf(attn),0);
   Z_PutLongIntoHeader(LONGINT(0));
   Z_Message('Sending ZRQINIT');
   Z_SendHexHeader(ZRQINIT,txhdr);
   IF (SZ_GetReceiverInfo = ZERROR) THEN
   BEGIN
      Z_CloseWindow;
      Z_AsyncOff;
      Zmodem_Send := FALSE;
      Exit
   END;
   IF (NOT Z_OpenFile(infile,pathname)) THEN
   IF (IOresult <> 0) THEN
   BEGIN
      Z_Message('Failure to open file');
      Z_SendCan;
      Z_CloseWindow;
      Z_AsyncOff;
      Zmodem_Send := FALSE;
      Exit
   END;
   n := SZ_SendFile;
   zcps := (fsize DIV (Z_SetTimer - ztime));
   Z_CloseFile(infile);
   Z_Frame(n);
   Str(zcps:4,s);
   Z_Message(s+' cps');
   IF (n = ZOK) AND (lastfile) THEN
      SZ_EndSend
   ELSE
      Z_SendCan;
   Z_CloseWindow;
   Z_AsyncOff;
   Zmodem_Send := TRUE
END;
END.