Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBBS/ECO_ZMOD.PAS

Pascal/Delphi Source File | 1992-12-29 | 76.7 KB | 2,693 lines

(*
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   ECO_ZMOD was conceived, designed and written     ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   All Credits to J.R.Louvau, unit conversion and   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   ECO_ZMOD by Floor Naaijkens. Unit was extracted  ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   from various PibTerm routines by Philip Burns.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   Update for combined FOSSIL/RS232 by UltiHouse.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
*)

{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 65520, 0, 655360}
unit eco_zmod;

interface
uses
  eco_lib,

  crt, dos,

  eco_fosl, eco_asyn

  ;



const
  zmodemlogging: boolean = false;

var
  alreadycarrier : boolean;
  filenum        :    word;


  function zmodem_receive(
    path: string; comport: word; baudrate: longint; init: boolean
  ): boolean;


  function zmodem_send(
    pathname: string; lastfile: boolean; comport: word; baudrate: longint;
    init: boolean
  ): boolean;

  procedure z_message(s: string);
  procedure z_setcomport(port: byte; fossiloverride: boolean);
  procedure z_sendcan;







implementation




const
  zbufsize = 1024;


type
  hdrtype = array[0..3] of byte;
  buftype = array[0..zbufsize-1] of byte;

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,
  oldl            :  longint;
  usefossil,
  usecrc32        :  boolean;
  zcps, zerrors   :     word;
  txhdr           :  hdrtype;
  txpos, ztime,
  totalbytes,
  curfsize        :  longint;
  comport         :     byte;




const
  lastsent: byte = 0;
  tpzver = 'ECO-LINK 3.52';

  zport: word = 1;
  zbaud: longint = 0;

  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 }
  enq = 5;
  can = 24;
  xoff = 19;
  xon = 17;
  soh = 1;
  stx = 2;
  eot = 4;
  ack = 6;
  nak = 21;
  cpmeof = 26;

{ byte positions }
  zf0 = 3;
  zf1 = 2;
  zf2 = 1;
  zf3 = 0;
  zp0 = 0;
  zp1 = 1;
  zp2 = 2;
  zp3 = 3;

{ bit masks for zrinit }
  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 }
  tescctl =  64;
  tesc8   = 128;

{ paramaters for zfile }
{ 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...                               }




  procedure z_setcomport(port: byte; fossiloverride: boolean);
  begin
    comport := port; usefossil := fos_present_(comport) and not(fossiloverride);
  end;



  function  __packfil(str: string; size: byte): string;
  var i,ii: byte;
  begin
    if size<15 then size := 15; str := fexpand(str);
    if length(str) <= size then __packfil := str else begin
      while length(str) > size+1 do begin
        i := pos('\',str); inc(i); ii := i; while str[ii]<>'\' do inc(ii);
        inc(ii); delete(str,i,ii-i);
      end; i := pos('\',str); delete(str,i,1); __packfil := str
    end;
  end;




  function __pntstr(n: longint): string;
  var
    tmpnrstr,
    tmpcvtstr   : string;
    tab, i,
    len_numstr,
    len_pnts    :   byte;

  begin
    str(n, tmpnrstr); tab := 0;
    len_numstr := length(tmpnrstr);
    len_pnts := (len_numstr -1) div 3;
    tmpcvtstr[0] := chr(len_numstr + len_pnts);

    tmpcvtstr[len_pnts +len_numstr -tab] := tmpnrstr[len_numstr];
    for i := len_numstr-1 downto 1 do begin
      if ((len_numstr -i) mod 3 =0) then begin
        tmpcvtstr[len_pnts +i -tab] := '.'; inc(tab)
      end;
      tmpcvtstr[len_pnts +i -tab] := tmpnrstr[i];
    end;
    __pntstr := copy(tmpcvtstr, 1, len_numstr +len_pnts);
  end;





  function z_charavail: boolean;
  (* see if there is a character coming in *)
  begin
    if usefossil then z_charavail := fos_avail_(comport) else
      z_charavail := async_buffer_check
  end;



  procedure z_clearinbound;
  (* throw away any pending input to clear the line *)
  var n: integer;
  begin
    if usefossil then fos_kill_in_(comport) else begin
      while (async_carrier_detect) and (async_buffer_check) do
        async_receive_with_timeout(1,n)
    end;
  end;


  procedure z_clearoutbound;
  (* throw away any pending output in the buffer *)
  begin
    if usefossil then fos_flush_(comport) else
      async_flush_output_buffer;
  end;

  procedure z_flushoutbound;
  begin
    if usefossil then fos_kill_out_(comport) else begin
      repeat until (
        (not async_carrier_detect) or
        (async_obuffer_head = async_obuffer_tail)
      )
    end;
  end;


  procedure z_sendbreak;
  (* send a break signal *)
  begin
     if not usefossil then async_send_break
  end;


  procedure z_sendbyte(b: byte);
  (* output one byte *)
  begin
    if usefossil then fos_write_(comport, chr(b)) else async_send(chr(b))
  end;


  function z_receivebyte: integer;
  (* input one byte (n.b.: returns an integer!) *)
  var
     n: integer;
  begin
    if usefossil then z_receivebyte := ord(fos_receive_(comport)) else begin
      async_receive_with_timeout(0,n);
      z_receivebyte := (n and $00ff)
    end;
  end;


  function z_carrier: boolean;
  (* checks for the presence of a carrier *)
  begin
    if usefossil then z_carrier := alreadycarrier or (fos_cd_(comport)) else
      z_carrier := (async_carrier_detect)
  end;


  procedure z_asyncoff;
  var
     i : integer;
     m : integer;
  begin  (* async_close *)
    if not usefossil then begin
      (* read the rbr and reset any pending error conditions. *)
      (* first turn off the divisor access latch bit to allow *)
      (* access to rbr, etc.                                  *)
      inline($fa);  (* disable interrupts *)
      port[uart_lcr + async_base] := port[uart_lcr + async_base] and $7f;
      (* read the line status register to reset any errors *)
      (* it indicates                                      *)
      i := port[uart_lsr + async_base];
      (* read the receiver buffer register in case it *)
      (* contains a character                         *)
      i := port[uart_rbr + async_base];
      (* enable the irq on the 8259 controller *)
      i := port[i8088_imr];  (* get the interrupt mask register *)
      m := (1 shl async_irq) xor $00ff;
      port[i8088_imr] := i and m;
      (* enable out2 on 8250 *)
      i := port[uart_mcr + async_base];
      port[uart_mcr + async_base] := i or $0b;
      (* enable the data ready interrupt on the 8250 *)
      port[uart_ier + async_base] := $0f;
      (* re-enable 8259 *)
      port[$20] := $20;
      inline($fb); (* enable interrupts *)
      if async_open_flag then begin
        (* disable the irq on the 8259 *)
        inline($fa);                 (* disable interrupts *)
        i := port[i8088_imr];        (* get the interrupt mask register *)
        m := 1 shl async_irq;        (* set mask to turn off interrupt  *)
        port[i8088_imr] := i or m;   (* disable the 8250 interrupts *)
        port[uart_ier + async_base] := 0;
          (* disable out2, rts, out1 on the 8250, but *)
          (* possibly leave dtr enabled.              *)
        port[uart_mcr + async_base] := 1;
        inline($fb);                 (* enable interrupts *)
          (* re-initialize our data areas so we know *)
          (* the port is closed                      *)
        async_open_flag := false;
        async_xoff_sent := false;
          (* restore the previous interrupt pointers *)
        setintvec( async_irq + 8 , async_save_iaddr );
          i := port[uart_lsr + async_base];
          (* read the receiver buffer register in case it *)
          (* contains a character                         *)
        i := port[uart_rbr + async_base];
          (* enable the irq on the 8259 controller *)
        i := port[i8088_imr];  (* get the interrupt mask register *)
        m := (1 shl async_irq) xor $00ff;
        port[i8088_imr] := i and m;
          (* enable out2 on 8250 *)
        i := port[uart_mcr + async_base];
        port[uart_mcr + async_base] := i or $0b;
          (* enable the data ready interrupt on the 8250 *)
        port[uart_ier + async_base] := $0f;
          (* re-enable 8259 *)
        port[$20] := $20;
        inline($fb); (* enable interrupts *)
      end;
    end;
  end; { async_close }



  function z_asyncon(zport: word; zbaud: longint): boolean;
  begin
    if usefossil then z_asyncon := fos_present_(comport) else begin
      async_do_cts := false;
      async_do_dsr := false;
      async_do_xonxoff := false;
      async_hard_wired_on := false;
      async_break_length := 500;
      async_init(2048,2048,0,0,0);
      z_asyncon := async_open(zport, zbaud, 'N', 8, 1)
    end;
  end;



(* crctab calculated by mark g. mendel, network systems corporation *)
const
  crctab: array[0..255] of word = (
    $0000,  $1021,  $2042,  $3063,  $4084,  $50a5,  $60c6,  $70e7,
    $8108,  $9129,  $a14a,  $b16b,  $c18c,  $d1ad,  $e1ce,  $f1ef,
    $1231,  $0210,  $3273,  $2252,  $52b5,  $4294,  $72f7,  $62d6,
    $9339,  $8318,  $b37b,  $a35a,  $d3bd,  $c39c,  $f3ff,  $e3de,
    $2462,  $3443,  $0420,  $1401,  $64e6,  $74c7,  $44a4,  $5485,
    $a56a,  $b54b,  $8528,  $9509,  $e5ee,  $f5cf,  $c5ac,  $d58d,
    $3653,  $2672,  $1611,  $0630,  $76d7,  $66f6,  $5695,  $46b4,
    $b75b,  $a77a,  $9719,  $8738,  $f7df,  $e7fe,  $d79d,  $c7bc,
    $48c4,  $58e5,  $6886,  $78a7,  $0840,  $1861,  $2802,  $3823,
    $c9cc,  $d9ed,  $e98e,  $f9af,  $8948,  $9969,  $a90a,  $b92b,
    $5af5,  $4ad4,  $7ab7,  $6a96,  $1a71,  $0a50,  $3a33,  $2a12,
    $dbfd,  $cbdc,  $fbbf,  $eb9e,  $9b79,  $8b58,  $bb3b,  $ab1a,
    $6ca6,  $7c87,  $4ce4,  $5cc5,  $2c22,  $3c03,  $0c60,  $1c41,
    $edae,  $fd8f,  $cdec,  $ddcd,  $ad2a,  $bd0b,  $8d68,  $9d49,
    $7e97,  $6eb6,  $5ed5,  $4ef4,  $3e13,  $2e32,  $1e51,  $0e70,
    $ff9f,  $efbe,  $dfdd,  $cffc,  $bf1b,  $af3a,  $9f59,  $8f78,
    $9188,  $81a9,  $b1ca,  $a1eb,  $d10c,  $c12d,  $f14e,  $e16f,
    $1080,  $00a1,  $30c2,  $20e3,  $5004,  $4025,  $7046,  $6067,
    $83b9,  $9398,  $a3fb,  $b3da,  $c33d,  $d31c,  $e37f,  $f35e,
    $02b1,  $1290,  $22f3,  $32d2,  $4235,  $5214,  $6277,  $7256,
    $b5ea,  $a5cb,  $95a8,  $8589,  $f56e,  $e54f,  $d52c,  $c50d,
    $34e2,  $24c3,  $14a0,  $0481,  $7466,  $6447,  $5424,  $4405,
    $a7db,  $b7fa,  $8799,  $97b8,  $e75f,  $f77e,  $c71d,  $d73c,
    $26d3,  $36f2,  $0691,  $16b0,  $6657,  $7676,  $4615,  $5634,
    $d94c,  $c96d,  $f90e,  $e92f,  $99c8,  $89e9,  $b98a,  $a9ab,
    $5844,  $4865,  $7806,  $6827,  $18c0,  $08e1,  $3882,  $28a3,
    $cb7d,  $db5c,  $eb3f,  $fb1e,  $8bf9,  $9bd8,  $abbb,  $bb9a,
    $4a75,  $5a54,  $6a37,  $7a16,  $0af1,  $1ad0,  $2ab3,  $3a92,
    $fd2e,  $ed0f,  $dd6c,  $cd4d,  $bdaa,  $ad8b,  $9de8,  $8dc9,
    $7c26,  $6c07,  $5c64,  $4c45,  $3ca2,  $2c83,  $1ce0,  $0cc1,
    $ef1f,  $ff3e,  $cf5d,  $df7c,  $af9b,  $bfba,  $8fd9,  $9ff8,
    $6e17,  $7e36,  $4e55,  $5e74,  $2e93,  $3eb2,  $0ed1,  $1ef0
  );



(*
 * updcrc derived from article Copyright (C) 1986 Stephen Satchell.
 *  NOTE: First argument must be in range 0 to 255.
 *        Second argument is referenced twice.
 *
 * Programmers may incorporate any or all code into their programs,
 * giving proper credit within the source. Publication of the
 * source routines is permitted so long as proper credit is given
 * to Stephen Satchell, Satchell Evaluations and Chuck Forsberg,
 * Omen Technology.
 *)
  function updcrc(cp: byte; crc: word): word;
  begin { updcrc }
    updcrc := crctab[((crc shr 8) and 255)] xor (crc shl 8) xor cp
  end;




{ use a type longint variable to store the crc value.                     }
{ initialise the variable to $ffffffff before running the crc routine.    }
{ very important!!!! -> this routine was developed for data communications}
{ and returns the crc bytes in low to high order, not byte reversed!      }
{ to turn the valu into a 'normal' longint, you must reverse the bytes!   }
{ e.g.                                                                    }
{ var                                                                     }
{    l, crc: longint;                                                     }
{    list: array[0..1023] of byte;                                        }
{    counter: integer;                                                    }
{                                                                         }
{ begin                                                                   }
{    crc := $ffffffff;                           (* initialise  *)        }
{    fillchar(list,sizeof(list),1);              (* dummy array *)        }
{    for counter := 0 to (pred(sizeof(list))) do (* run thru    *)        }
{       crc := updc32(buf[counter],crc);         (* finding crc *)        }
{    for counter := 1 to 4 do                    (* reverse     *)        }
{       l := (l shl 8) or byte(crc);             (* the bytes   *)        }
{    (* l now contains the 'normalized' crc *)                            }
{                                                                         }
(* converted to turbo pascal (tm) v4.0 march, 1988 by j.r.louvau       *)
(* copyright (c) 1986 gary s. brown.  you may use this program, or     *)
(* code or tables extracted from it, as desired without restriction.   *)
(*                                                                     *)
(* first, the polynomial itself and its table of feedback terms.  the  *)
(* polynomial is                                                       *)
(* x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x^1+x^0 *)
(* note that we take it "backwards" and put the highest-order term in  *)
(* the lowest-order bit.  the x^32 term is "implied"; the lsb is the   *)
(* x^31 term, etc.  the x^0 term (usually shown as "+1") results in    *)
(* the msb being 1.                                                    *)
(*                                                                     *)
(* note that the usual hardware shift register implementation, which   *)
(* is what we're using (we're merely optimizing it by doing eight-bit  *)
(* chunks at a time) shifts bits into the lowest-order term.  in our   *)
(* implementation, that means shifting towards the right.  why do we   *)
(* do it this way?  because the calculated crc must be transmitted in  *)
(* order from highest-order term to lowest-order term.  uarts transmit *)
(* characters in order from lsb to msb.  by storing the crc this way,  *)
(* we hand it to the uart in the order low-byte to high-byte; the uart *)
(* sends each low-bit to hight-bit; and the result is transmission bit *)
(* by bit from highest- to lowest-order term without requiring any bit *)
(* shuffling on our part.  reception works similarly.                  *)
(*                                                                     *)
(* the feedback terms table consists of 256, 32-bit entries.  notes:   *)
(*                                                                     *)
(*     the table can be generated at runtime if desired; code to do so *)
(*     is shown later.  it might not be obvious, but the feedback      *)
(*     terms simply represent the results of eight shift/xor opera-    *)
(*     tions for all combinations of data and crc register values.     *)
(*                                                                     *)
(*     the values must be right-shifted by eight bits by the "updcrc"  *)
(*     logic; the shift must be unsigned (bring in zeroes).  on some   *)
(*     hardware you could probably optimize the shift in assembler by  *)
(*     using byte-swap instructions.                                   *)
(*     polynomial $edb88320                                            *)
(*                                                                     *)


const
  crc_32_tab: array[0..255] of longint = (
   $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535,
   $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd,
   $e7b82d07, $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d,
   $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec,
   $14015c4f, $63066cd9, $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,
   $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,
   $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59, $26d930ac,
   $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
   $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab,
   $b6662d3d, $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,
   $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb,
   $086d3d2d, $91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,
   $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, $8bbeb8ea,
   $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65, $4db26158, $3ab551ce,
   $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,
   $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
   $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409,
   $ce61e49f, $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,
   $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739,
   $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
   $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, $8708a3d2, $1e01f268,
   $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7, $fed41b76, $89d32be0,
   $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8,
   $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
   $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,
   $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703,
   $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7,
   $b5d0cf31, $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, $026d930a,
   $9c0906a9, $eb0e363f, $72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae,
   $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
   $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777, $88085ae6,
   $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
   $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d,
   $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5,
   $47b2cf7f, $30b5ffe9, $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,
   $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,
   $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
  );


  function updc32(octet: byte; crc: longint) : longint;
  begin { updc32 }
    updc32 := crc_32_tab[byte(crc xor longint(octet))] xor (
      (crc shr 8) and $00ffffff
    )
  end;



  function z_openfile(var f: file; pathname: string): boolean;
  begin {$i-}
    assign(f,pathname); reset(f,1); z_openfile := (ioresult = 0)
  end; {$i+}



  function z_makefile(var f: file; pathname: string): boolean;
  begin {$I-}
     assign(f,pathname);
     rewrite(f,1);
     z_makefile := (ioresult = 0)
  end; {$I+}



  procedure z_closefile(var f: file);
  begin {$I-}
    close(f); if (ioresult <> 0) then { ignore this error }
  end; {$I+}



  function z_seekfile(var f: file; fpos: longint): boolean;
  begin {$I-}
    seek(f,fpos); z_seekfile := (ioresult = 0)
  end; {$I+}


  function z_writefile(var f: file; var buff; bytes: word): boolean;
  begin {$I-}
    blockwrite(f,buff,bytes); z_writefile := (ioresult = 0)
  end; {$I+}


  function z_readfile(var f: file; var buff; btoread: word; var bread: word): boolean;
  begin {$I-}
    blockread(f,buff,btoread,bread); z_readfile := (ioresult = 0)
  end; {$I+}


  function z_findfile(
    pathname: string; var name: string; var size, time: longint
  ): boolean;
  var sr: searchrec;
  begin {$I-}
    findfirst(pathname+'*', anyfile, sr);
    if (doserror <> 0) or (ioresult <> 0) then begin
      z_findfile := false; exit
    end;
    name := sr.name; size := sr.size; time := sr.time; z_findfile := true
  end; {$I+}



  procedure z_setftime(var f: file; time: longint);
  begin {$I-}
    setftime(f,time); if (ioresult <> 0) then {null}
  end; {$I+}



  function z_settimer: longint;
  var
     l: longint;
     h,m,s,x: word;

  begin
    gettime(h,m,s,x);
    l := longint(h) * 3600; inc(l, longint(m) * 60); inc(l, longint(s));
    z_settimer := l
  end;



  const
    c1970 = 2440588;
    d0    =    1461;
    d1    =  146097;
    d2    = 1721119;



  procedure gregoriantojuliandn(
    year, month, day : integer; var juliandn : longint
  );

  var
    century,
    xyear    : longint;

  begin {gregoriantojuliandn}
    if month <= 2 then begin dec(year); inc(month, 12) end;
    dec(month, 3); century := year div 100; xyear := year mod 100;
    century := (century * d1) shr 2; xyear := (xyear * d0) shr 2;
    juliandn := ((((month * 153) + 2) div 5) + day) + d2 + xyear + century;
  end; {gregoriantojuliandn}



  procedure juliandntogregorian(
    juliandn : longint; var year, month, day : integer
  );

  var
    temp,
    xyear   : longint;
    yyear,
    ymonth,
    yday    : integer;

  begin {juliandntogregorian}
    temp := (((juliandn - d2) shl 2) - 1); xyear := (temp mod d1) or 3;
    juliandn := temp div d1; yyear := (xyear div d0);
    temp := ((((xyear mod d0) + 4) shr 2) * 5) - 3;
    ymonth := temp div 153;
    if ymonth >= 10 then begin inc(yyear); dec(ymonth, 12) end;
    ymonth := ymonth + 3; yday := temp mod 153; yday := (yday + 5) div 5;
    year := yyear + (juliandn * 100); month := ymonth; day := yday;
  end; {juliandntogregorian}



  function z_tounixdate(fdate: longint): string;
  var
     dt: datetime;
     secspast, datenum, dayspast: longint;
     s: string;

  begin
     unpacktime(fdate,dt);
     gregoriantojuliandn(dt.year,dt.month,dt.day,datenum);
     dayspast := datenum - c1970;
     secspast := dayspast * 86400;
     secspast := secspast + dt.hour * 3600 + dt.min * 60 + dt.sec;
     s := '';
     while (secspast <> 0) and (length(s) < 255) do begin
       s := chr((secspast and 7) + $30) + s;
       secspast := (secspast shr 3)
     end;
     s := '0' + s;
     z_tounixdate := s
  end;



  function z_fromunixdate(s: string): longint;
  var
     dt: datetime;
     secspast, datenum: longint;
     n: word;
  begin
     secspast := longint(0);
     for n := 1 to length(s) do
        secspast := (secspast shl 3) + ord(s[n]) - $30;
     datenum := (secspast div 86400) + c1970;
     juliandntogregorian(datenum,integer(dt.year),integer(dt.month),integer(dt.day));
     secspast := secspast mod 86400;
     dt.hour := secspast div 3600;
     secspast := secspast mod 3600;
     dt.min := secspast div 60;
     dt.sec := secspast mod 60;
     packtime(dt,secspast);
     z_fromunixdate := secspast
  end;




  function rtos(r: real; width, decimals: word): string;
  var s: string;
  begin
    if r <> 0 then str(r: width: decimals, s) else s := '';
    if (ioresult <> 0) then s := '' else
    while (length(s) > 0) and (s[1] = ' ') do delete(s,1,1);
    rtos := s
  end;




  function itos(r: longint; width: word): string;
  var s: string;
  begin
    str(r: width, s);
    if (ioresult <> 0) then s := '' else
      while (length(s) > 0) and (s[1] = ' ') do delete(s,1,1);
    itos := s
  end;



  function pitos(r: longint; width: word): string;
  var
    s : string;
    i :   byte;

  begin
    str(r: width, s);
    if (ioresult <> 0) then s := '' else begin
      i := 1; while (i < length(s)) and (s[i] = ' ') do s[i] := '0'; inc(i);
    end;
    pitos := s;
  end;



const
  fore  : byte = lightgray;
  back  : byte = black;
  bfore : byte = black;
  bback : byte = green;

var
  x1, x2, x3, x4,
  y1, y2, oldx, oldy : byte;




  {====================================}
  procedure z_openwindow(title, action: string);
  var
     p, q     : pointer;
     n, pads,
     bytes    :    word;
     st       :  string;

  begin
    x1 := 10;
    x2 := x1 + 61;
    x3 := x1 + 17;
    x4 := x1 + 36;
    y1 := 4;
    y2 := y1 + 17;
    oldx := wherex; oldy := wherey;
    __bandwin(false, x1, y1, x2, y2, bfore, bback, sh_default, bt_double);
    if usefossil then st := '(USING FOSSIL)' else st := '(DIRECT RS232)';
    __betwscn(x1, x2, y1, bfore, bback,'[ ' + action + ' ' + title + ' ' + st + ' ]');
    __write(x1 + 1, y1 + 01, bfore, bback, ' File name    :');
    __write(x1 + 1, y1 + 02, bfore, bback, ' File size    :');
    __write(x1 + 1, y1 + 03, bfore, bback, ' File blocks  :');
    __write(x1 + 1, y1 + 04, bfore, bback, ' Block check  :');
    __write(x1 + 1, y1 + 05, bfore, bback, ' Transfertime :');
    __write(x1 + 1, y1 + 06, bfore, bback, ' Current BYTE :');
    __write(x1 + 1, y1 + 07, bfore, bback, ' Total bytes  :');
    __write(x1 + 1, y1 + 08, bfore, bback, ' Current BLCK :');
    __write(x1 + 1, y1 + 09, bfore, bback, ' Total blocks :');
    __write(x1 + 1, y1 + 10, bfore, bback, ' Block size   :');
    __write(x1 + 1, y1 + 11, bfore, bback, ' Error count  :');
    __write(x1 + 1, y1 + 12, bfore, bback, ' Last frame   :');
    __write(x1 + 1, y1 + 13, bfore, bback, ' Chrs per sec.:');
    __write(x1 + 1, y1 + 14, bfore, bback, ' Efficiency   :');
    {---}
    __write(x1 + 2, y2 - 1,  bfore, bback, __rep(x4-x1-3,'░'));
    __vert(x4, y1 + 1, bfore, bback, __rep(y2 - y1 - 1, '│'));
  end;




  procedure z_showname(filename: string);
  begin
    if (length(filename) > 14) then filename[0] := #14;
    __write(x3, y1 + 1, bfore, bback, filename);
  end;


  procedure z_showsize(l: longint);
  begin
    __write(x3, y1 + 02, bfore, bback,
      __pntstr(l) + ' ' + itos(l div 1024, 5) + 'K'
    );
    if (l mod 128 <> 0) then l := (l div 128) + 1 else l := (l div 128);
    __write(x3, y1 + 03, bfore, bback, __pntstr(l));
  end;



  procedure z_showcheck(is32: boolean);
  begin
    if (is32) then __write(
      x3, y1 + 04, bfore, bback, 'CRC32'
    ) else __write(
      x3, y1 + 04, bfore, bback, 'CRC16'
    )
  end;



  function getxfrtime(fsize, zbaud: longint): string;
  var
    hours,
    mins,
    secs : byte;
    bits : real;

  begin
    bits := ((fsize * 10.0) / zbaud) / 60;      {              all seconds }
    secs := round((bits - trunc(bits)) * 60);   {             seconds only }
    mins := trunc(bits);                        { cut seconds from minutes }
    hours := 0;
    if mins > 60 then begin hours := mins div 60; mins := mins div 60 end;
    getxfrtime := pitos(hours, 2) + ':' + pitos(mins, 2) + '.' + pitos(secs, 2)
  end;


  procedure z_showtransfertime(fsize, zbaud: longint);
  begin
    if zbaud = 0 then __write(
      x3, y1 + 05, bfore, bback, '0 min.'
    ) else __write(x3, y1 + 05, bfore, bback, getxfrtime(fsize, zbaud));
  end;



  procedure z_showtransfertimesofar(fsize, fdone, zbaud: longint);
  var
    hours,
    mins,
    secs : byte;
    bits : real;

  begin
    if zbaud = 0 then __write(
      x3, y1 + 05, bfore, bback, '0 min.'
    ) else begin
      bits := ((fdone * 10.0) / zbaud) / 60;      {              all seconds }
      secs := round((bits - trunc(bits)) * 60);   {             seconds only }
      mins := trunc(bits);                        { cut seconds from minutes }
      hours := 0;
      if mins > 60 then begin hours := mins div 60; mins := mins div 60 end;

      __write(x1+2, y1 + 15, bfore, bback, 'Xfr time: ' +
        pitos(hours, 2) + ':' + pitos(mins, 2) + '.' + pitos(secs, 2) + '  '
      );

      bits := (((fsize-fdone) * 10.0) / zbaud) / 60; { all seconds yet to do }
      secs := round((bits - trunc(bits)) * 60);   {             seconds only }
      mins := trunc(bits);                        { cut seconds from minutes }
      hours := 0;
      if mins > 60 then begin hours := mins div 60; mins := mins div 60 end;
      __write(x1+24, y1 + 15, bfore, bback, '(' +
        pitos(hours, 2) + ':' + pitos(mins, 2) + '.' + pitos(secs, 2) + ')  '
      );

    end;
  end;



  procedure z_message(s: string);
  begin
    __attrib(x4+2, y2-3, x2-1, y2-1, bfore, bback);
    __copyscn(x4+2, y1+2, x2-1, y2-1, x4+2, y1+1);
    __write(x4+2, y2-1, bfore, bback, __rep(x2-x4-2, ' '));
    if (copy(s, 1, 3) = 'ERR') or (copy(s, 2, 3) = 'ERR') then
      __write(x4+2, y2-1, 14, 1, copy(s, 1, x2-x4-2)) else
      __write(x4+2, y2-1, 15, bback, copy(s, 1, x2-x4-2));
  end;


  procedure z_frame(n: integer);
  var st: string;
  begin
    if (n < -3) or (n > 20) then n := 20;
    case n of
       -3 : st := 'ZNOCARRIER';
       -2 : st := 'ZTIMEOUT  ';
       -1 : st := 'ZERROR    ';
       0  : st := 'ZRQINIT   ';
       1  : st := 'ZRINIT    ';
       2  : st := 'ZSINIT    ';
       3  : st := 'ZACK      ';
       4  : st := 'ZFILE     ';
       5  : st := 'ZSKIP     ';
       6  : st := 'ZNAK      ';
       7  : st := 'ZABORT    ';
       8  : st := 'ZFIN      ';
       9  : st := 'ZRPOS     ';
       10 : st := 'ZDATA     ';
       11 : st := 'ZEOF      ';
       12 : st := 'ZFERR     ';
       13 : st := 'ZCRC      ';
       14 : st := 'ZCHALLENGE';
       15 : st := 'ZCOMPL    ';
       16 : st := 'ZCAN      ';
       17 : st := 'ZFREECNT  ';
       18 : st := 'ZCOMMAND  ';
       19 : st := 'ZSTDERR   ';
       20 : st := 'ZUNKNOWN  '
    end;
    __write(x3, y1+12, bfore, bback, st);
  end;



  {@ UPDATE ALL "WICHTIGE" INFORMATION }
  procedure z_showloc(l: longint);
  var
    r        :    real;
    tmpl, tt : longint;

  begin
    if fsize > 0 then r := (l / fsize) * (x4-x1-3);
    if fsize > 0 then __write(x1 +2, y2 -1, bfore, bback, __rep(trunc(r), '█'));
    z_showtransfertimesofar(fsize, l, zbaud);
    if (l / fsize) * 100 >= 15 then __write(x1 +3, y2 -1, bback, bfore,
      itos(trunc((l / fsize) * 100), 3) + '%'
    );
    __write(x3, y1 + 06, bfore, bback,
      __pntstr(l) + ' ' + itos(l div 1024, 5) + 'K'
    );
    __write(x3, y1 + 07, bfore, bback,
      __pntstr(totalbytes) + ' ' + itos(totalbytes div 1024, 5) + 'K'
    );

    if (z_settimer - ztime) <> 0 then zcps := l div (z_settimer - ztime);
    if (l mod 128 <> 0) then l := (l div 128) + 1 else l := (l div 128);
    if (totalbytes mod 128 <> 0) then tt := (totalbytes div 128) + 1 else
      tt := (totalbytes div 128);
    __write(x3, y1+08, bfore, bback, __pntstr(l) + '  ');
    __write(x3, y1+09, bfore, bback, __pntstr(tt) + '  ');
    __write(x3, y1 + 13, bfore, bback, itos(zcps, 5) + ' cps  ');
    if zbaud > 0 then __write(x3, y1 + 14, bfore, bback,
      itos(trunc(((zcps * 10) / zbaud) * 100), 3) + ' % '
    );
    tmpl := abs(l - oldl) * 128;
    __write(x3, y1 + 10, bfore, bback, itos(tmpl, 5) + '       ');
    oldl := l;
  end;



  procedure z_errors(w: word);
  begin
    __write(x3, y1+11, bfore, bback, itos(w,14));
  end;





(***************************************************)
(* all zmodem direction-independent routines       *)
(***************************************************)

  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 8 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 begin {got 2nd can}
      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 z_getzdl := c xor $40 else {make sure it was a valid escape}
          z_getzdl := zerror
      end
    end { case }
  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(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 begin  {this is the polynomial value}
      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 if (readkey = #27) then begin { operator panic }
      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 begin
agn2:
        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 = 00;

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; { case }
      end; { if }
      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));  {full dplx, overlay i/o and crc32}
      txhdr[zf0] := canfdx or canovio or canfc32 or canbrk;
      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 { case }
    end; { not zcarrier }
    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);
    curfsize := 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 ****)

    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');
        if (zconv = zcresum) then __logapp('File is already complete.') else
          __logapp('No resume command was given.');
        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);
    if zmodemlogging then __logapp('Receiving: ' +
      fname + ' ' + __pntstr(curfsize) + ' ' + getxfrtime(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');
      if zmodemlogging then __logapp('Aborted from keyboard...');
      z_sendcan;
      rz_savetodisk := zerror;
      exit
    end;
    if (not z_writefile(outfile,secbuf,rxcount)) then begin
      z_message('Disk write error');
      if zmodemlogging then __logapp('Disk write error.');
      rz_savetodisk := zerror
    end else rz_savetodisk := zok;
    inc(rxbytes, rxcount);
    inc(totalbytes, 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; oldl := 0;
    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; inc(filenum);
    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; { rec file }





  function rz_receivebatch: integer;
  var
    s: string;
    c: integer;
    done: boolean;

  begin
    z_message('Receiving...');
    done := false; filenum := 1;
    while (not done) do begin
      if not (z_carrier) then begin
        rz_receivebatch := zerror;
        exit
      end;
      __write(x1 + 2, y2 - 1, bfore, bback, __rep(x4-x1-3,'░'));
      z_message('Receiving file #' + itos(filenum, 3));
      if zmodemlogging then __logapp('Receiving file #' + itos(filenum, 3));
      __attrib(x3+1, y1+1, x4-1, y2-2, bback, bback);
      c := rz_receivefile;
      if (z_settimer - ztime) <> 0 then
        zcps := fsize div (z_settimer - ztime);
      z_frame(c);
      z_setftime(outfile,ftime);
      z_closefile(outfile);
      str(zcps:4, s);
      z_message(s+' cps');
      if zmodemlogging then __logapp(s + ' cps.');
      __write(x3, y1 + 13, bfore, bback, s +' cps');
      if zbaud > 0 then __write(x3, y1 + 14, bfore, bback,
        itos(trunc(((zcps * 10) / zbaud) * 100), 3)
      );
      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;
    init: boolean
  ): boolean;
  var i: integer;
  begin
    zbaud := baudrate; zport := comport; totalbytes := 0;
    z_openwindow(tpzver, 'Receiving');
    z_message('Initializing...');
    if init then if (not z_asyncon(comport,baudrate)) then begin
      z_message('Unable to open:');
      z_message(
        'Port: COM' + itos(comport, 1) + ' Baud: ' + itos(baudrate, 5)
      );
      delay(2000); 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');
      if init then z_asyncoff;
      zmodem_receive := true
    end else begin
      z_clearoutbound;
      z_message('Sending CAN');
      z_sendcan;
      z_message('Restoring async params');
      if init then z_asyncoff;
      zmodem_receive := false;
    end
  end;




(***************************************************)
(* send file 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
    __write(x1 + 2, y2 - 1, bfore, bback, __rep(x4-x1-3,'░')); inc(filenum);
    z_message('Sending file #' + itos(filenum, 3)); oldl := 0;
    if zmodemlogging then __logapp('Sending file #' + itos(filenum, 3));
    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);
    z_message('Sending data header');
    sz_sendbinaryheader(zdata,txhdr);
    z_message('Sending file data...');
    repeat
      if (keypressed) then if (readkey = #27) then begin
        z_message('Aborted from keyboard.');
        if zmodemlogging then __logapp('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!');
        if zmodemlogging then __logapp('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);
      inc(txpos, blkred);
      inc(totalbytes, 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?');
            if zmodemlogging then __logapp('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 begin
oops:
          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');
        if zmodemlogging then __logapp('Aborted from keyboard');
        sz_sendfile := zerror;
        exit
      end;
      if (not z_carrier) then begin
        z_message('Lost carrier.');
        if zmodemlogging then __logapp('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.');
               if zmodemlogging then __logapp('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;
    init: boolean
  ): boolean;
  var
    s: string;
    n: integer;

  begin
    zerrors := 0; totalbytes := 0; zbaud := baudrate; zport := comport;
    z_openwindow(tpzver, 'Sending');
    if init then if (not z_asyncon(comport,baudrate)) then begin
      z_message('Unable to open port'); delay(2000);
      zmodem_send := false; exit
    end;
    if (not z_carrier) then begin
      z_message('Lost carrier'); delay(2000); if init then 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;
      if lastfile then if init then z_asyncoff; zmodem_send := false; exit
    end;
    z_message(__packfil(pathname, x2-x4-2));
    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
      if init then 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; if init then z_asyncoff;
      zmodem_send := false; exit
    end;
    n := sz_sendfile;
    if (z_settimer - ztime) <> 0 then
      zcps := (fsize div (z_settimer - ztime));
    z_closefile(infile); z_frame(n);
    z_message(itos(zcps, 4) + ' cps');
    if zmodemlogging then __logapp(itos(zcps, 4) + ' cps');
    if lastfile then begin
      if n = zok then sz_endsend else ; {z_sendcan;}
      {no: receive after this will fault then as well}
      if init then z_asyncoff;
    end;
    zmodem_send := true
  end;


begin
  totalbytes := 0; filenum := 0; oldl := 0;
end.