Unit m_Protocol_Zmodem;

{$I M_OPS.PAS}

{.$DEFINE ZDEBUG}

Interface

Uses
  DOS,
  m_CRC,
  m_DateTime,
  m_FileIO,
  m_Strings,
  m_Input,
  m_Socket_Class,
  m_Protocol_Base,
  m_Protocol_Queue;

Const
  ZBufSize    = 1024;  // 1024 only maybe 8k ZEDZAP someday
  ZAttnLen    = 32;
  RxTimeOut   : Word = 500;
  StatusCheck : Word = 50;
  StatusTimer : LongInt = 0;

Type
  ZHdrType = Array[0..3] of Byte;
  ZBufType = Array[0..ZBUFSIZE - 1] of Byte;

  TProtocolZmodem = Class(TProtocolBase)
    UseCRC32   : Boolean;
    EscapeAll  : Boolean;
    LastSent   : Byte;
    Attn       : String[ZAttnLen];
    TxHdr      : ZHdrType;
    TxBuf      : ZBufType;
    RxBuf      : ZBufType;
    RxFrameIdx : SmallInt;
    RxType     : Byte;
    TxPos      : LongInt;
    RxPos      : LongInt;
    RxHdr      : ZHdrType;
    RxBufLen   : SmallInt;
    WrkFile    : File;
    RxBytes    : LongInt;
    RxCount    : LongInt;

    Constructor Create (Var C: TSocketClass; Var Q: TProtocolQueue); Override;
    Destructor  Destroy; Override;

    Procedure   QueueReceive; Virtual;
    Procedure   QueueSend; Virtual;
    Function    ZInitReceiver        : SmallInt;
    Function    ZGetByte             : SmallInt;
    Function    ZDLRead              : SmallInt;
    Function    ZGetHex              : SmallInt;
    Function    ZSendFile            : SmallInt;
    Function    ZInitSender          : SmallInt;
    Function    ZReceiveFile         : SmallInt;
    Procedure   ZPutHex                (B: Byte);
    Procedure   ZPutLong               (Pos: LongInt);
    Procedure   ZSendHexHeader         (FrameType: Byte);
    Function    ZGetHeader             (Var Hdr: ZHdrType) : SmallInt;
    Function    ZReceiveHexHeader      (Var Hdr: ZHdrType) : SmallInt;
    Function    ZReceiveBinaryHeader   (Var Hdr: ZHdrType) : SmallInt;
    Function    ZReceiveBinaryHeader32 (Var Hdr: ZHdrType) : SmallInt;
    Function    ZGetLong               (Var Hdr: ZHdrType) : LongInt;
    Procedure   ZSendBinaryHeader      (FrameType: Byte);
    Procedure   SendEscaped            (B: SmallInt);
    Procedure   ZSendData              (BufSize : SmallInt; FrameEnd : Byte);
    Function    ZReceiveData           (Var Buf: ZBufType; Len: SmallInt): SmallInt;
    Procedure   ZAckBiBi;
    Procedure   ZEndSender;
    Procedure   DoAbortSequence;
  End;

Implementation

Const
  CANBRK     = 4;
  EscAll     = $0040;
  ZABORT     = 7;
  ZRQINIT    = 0;
  ZPAD       = 42;
  ZDLE       = 24;
  ZHEX       = 66;
  ZACK       = 3;
  ZFIN       = 8;
  ZERROR     = -1;
  ZTIMEOUT   = -2;
  RCDO       = -3;
  ZBIN32     = 67;
  XON        = 17;
  XOFF       = 19;
  CAN        = 24;
  ZCAN       = 16;
  CDLE       = 16;
  ZBIN       = 65;
  GOTCAN     = 272;
  ZCRCE      = 104;
  ZCRCG      = 105;
  ZCRCQ      = 106;
  ZCRCW      = 107;
  GOTOR      = 256;
  ZRUB0      = 108;
  ZRUB1      = 109;
  ZP0        = 0;
  ZP1        = 1;
  ZP2        = 2;
  ZP3        = 3;
  CANFDX     = 1;
  CANOVIO    = 2;
  CANBREAK   = 4;
  CANFC32    = 32;
  ZCHALLENGE = 14;
  ZRINIT     = 1;
  ZF0        = 3;
  ZOK        = 0;
  ZSKIP      = 5;
  ZCRESUM    = 3;
  ZDATA      = 10;
  ZFILE      = 4;
  ZRPOS      = 9;
  ZEOF       = 11;
  ZCOMMAND   = 18;
  ZNAK       = 6;
  GOTCRCE    = 360;
  GOTCRCG    = 361;
  GOTCRCQ    = 362;
  GOTCRCW    = 363;
  ZSINIT     = 2;
  ZFREECNT   = 17;
  ZCOMPL     = 15;
  cDleHi     = cDle + $80;
  cXonHi     = Xon + $80;
  cXoffHi    = Xoff + $80;

  CancelStr : String = #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8;

{$IFDEF ZDEBUG}
Function HeaderType (B: SmallInt) : String;
Begin
  Case B of
    ZERROR  : Result := 'ZERROR';
    RCDO    : Result := 'RCDO';
    ZTIMEOUT: Result := 'ZTIMEOUT';
    ZBIN    : Result := 'ZBIN';
    ZBIN32  : Result := 'ZBIN32';
    ZHEX    : Result := 'ZHEX';
    CAN     : Result := 'CAN';
    ZRQINIT : Result := 'ZRQINIT';
    ZEOF    : Result := 'ZEOF';
    ZFILE   : Result := 'ZFILE';
    ZRPOS   : Result := 'ZRPOS';
    ZRINIT  : Result := 'ZRINIT';
    ZSINIT  : Result := 'ZSINIT';
    ZFREECNT: Result := 'ZFREECNT';
    ZCOMMAND: Result := 'ZCOMMAND';
    ZCOMPL  : Result := 'ZCOMPL';
    ZFIN    : Result := 'ZFIN';
    ZCAN    : Result := 'ZCAN';
    ZDATA   : Result := 'ZDATA';
    GOTCRCE : Result := 'GOTCRCE';
    GOTCRCG : Result := 'GOTCRCG';
    GOTCRCQ : Result := 'GOTCRCQ';
    GOTCRCW : Result := 'GOTCRCW';
  Else
    Result := 'UNKNOWN:' + strI2S(Ord(B));
  End;
End;
{$ENDIF}

{$IFDEF ZDEBUG}
Procedure ZLOG (Str: String);
Var
  T : Text;
Begin
  Assign (T, 'zlog.txt');
  {$I-} Append(T); {$I+}

  If IoResult <> 0 Then ReWrite(T);

  WriteLn(T, Str);

  Close(T);
End;
{$ENDIF}

Constructor TProtocolZmodem.Create (Var C: TSocketClass; Var Q: TProtocolQueue);
Begin
  Inherited Create (C, Q);

  Status.Protocol := 'Zmodem';
  LastSent        := 0;
  EscapeAll       := False;
  Attn            := '';
End;

Destructor TProtocolZmodem.Destroy;
Begin
  Inherited Destroy;
End;

Procedure TProtocolZmodem.ZPutLong (Pos : LongInt);
Begin
  TxHdr[ZP0] := Byte(Pos);
  TxHdr[ZP1] := Byte(Pos SHR 8);
  TxHdr[ZP2] := Byte(Pos SHR 16);
  TxHdr[ZP3] := Byte(Pos SHR 24);
End;

Procedure TProtocolZmodem.ZPutHex (B: Byte);
Const
  Digits : Array[0..15] of Char = '0123456789abcdef';
Begin
  Client.BufWriteChar (Digits[B SHR 4]);
  Client.BufWriteChar (Digits[B AND $0F]);
End;

Procedure TProtocolZmodem.ZSendHexHeader (FrameType: Byte);
Var
  CRC   : SmallInt;
  Count : Byte;
Begin
  Client.BufWriteChar (Char(ZPAD));
  Client.BufWriteChar (Char(ZPAD));
  Client.BufWriteChar (Char(ZDLE));
  Client.BufWriteChar (Char(ZHEX));

  ZPutHex (FrameType);

  CRC := Crc16(FrameType, 0);

  For Count := 0 to 3 Do Begin
    ZPutHex (TxHdr[Count]);
    CRC := Crc16(TxHdr[Count], CRC);
  End;

  CRC := Crc16(0, CRC);
  CRC := Crc16(0, CRC);

  ZPutHex (Lo(SmallInt(CRC SHR 8)));
  ZPutHex (Lo(CRC));

  Client.BufWriteChar (#13);
  Client.BufWriteChar (#10);

  If (FrameType <> ZFIN) And (FrameType <> ZACK) Then
    Client.BufWriteChar (Char(XON));

  Client.BufFlush;
End;

Function TProtocolZmodem.ZGetByte : SmallInt;
Begin
  While Connected Do Begin
    Result := ReadByteTimeOut(RxTimeOut);

    If Result < 0 Then Begin
      Result := ZTIMEOUT;
      Exit;
    End;

    Result := Result AND $007F;

    Case Result of
      XON,
      XOFF : Continue;
    Else
      Exit;
    End;
  End;

  Result := RCDO;
End;

Function TProtocolZmodem.ZDLRead : SmallInt;
Begin
  Result := ReadByteTimeOut(RxTimeOut);

  If Result <> CAN Then Exit;

  Result := ReadByteTimeOut(RxTimeOut);

  If Result = CAN Then Begin
    Result := ReadByteTimeOut(RxTimeOut);
    If Result = CAN Then Begin
      Result := ReadByteTimeOut(RxTimeOut);
      If Result = CAN Then
        Result := ReadByteTimeOut(RxTimeOut);
    End
  End;

  Case Result of
    CAN    : Result := GOTCAN;
    ZCRCE,
    ZCRCG,
    ZCRCQ,
    ZCRCW  : Result := (Result OR 256);
    ZRUB0  : Result := $007F;
    ZRUB1  : Result := $00FF;
  Else
    If Result > 0 Then
      If ((Result AND $60) = $40) Then
        Result := Result XOR $40
      Else
        Result := ZERROR;
  End;
End;

Function TProtocolZmodem.ZReceiveBinaryHeader (Var Hdr: ZHdrType) : SmallInt;
Var
  C   : SmallInt;
  N   : SmallInt;
  CRC : Word;
Begin
  C := ZDLRead;

  If C < 0 Then Begin
    ZReceiveBinaryHeader := C;
    Exit;
  End;

  RxType := C;
  CRC    := Crc16(RxType, 0);

  For N := 0 To 3 Do Begin
    C := ZDLRead;

    If Hi(C) <> 0 Then Begin
      ZReceiveBinaryHeader := C;
      Exit;
    End;

    Hdr[N] := Lo(C);
    CRC    := Crc16(Lo(C), CRC);
  End;

  C := ZDLRead;

  If Hi(C) <> 0 Then Begin
    ZReceiveBinaryHeader := C;
    Exit;
  End;

  CRC := Crc16(Lo(C), CRC);

  C := ZDLRead;

  If Hi(C) <> 0 Then Begin
    ZReceiveBinaryHeader := C;
    Exit;
  End;

  CRC := Crc16(Lo(C), CRC);

  If CRC <> 0 Then Begin
    {$IFDEF ZDEBUG} ZLog('ZReceiveBinaryHeader -> CRC error'); {$ENDIF}

    ZReceiveBinaryHeader := ZERROR;
    Exit;
  End;

  ZReceiveBinaryHeader := RxType;
End;

Function TProtocolZmodem.ZReceiveBinaryHeader32 (Var Hdr: ZHdrType) : SmallInt;
Var
  C    : SmallInt;
  Loop : Byte;
  CRC  : LongInt;
Begin
  C := ZDLRead;

  If C < 0 Then Begin
    ZReceiveBinaryHeader32 := C;
    Exit;
  End;

  RxType := C;
  CRC    := Crc32(RxType, LongInt($FFFFFFFF));

  For Loop := 0 To 3 Do Begin
    C := ZDLRead;

    If Hi(C) <> 0 Then Begin
      ZReceiveBinaryHeader32 := C;
      Exit;
    End;

    Hdr[Loop] := Lo(C);
    CRC       := Crc32(Lo(C), CRC);
  End;

  For Loop := 0 To 3 Do Begin
    C := ZDLRead;

    If Hi(C) <> 0 Then Begin
      ZReceiveBinaryHeader32 := C;
      Exit;
    End;

    CRC := Crc32(Lo(C), CRC);
  End;

  If CRC <> LongInt($DEBB20E3) Then Begin
    {$IFDEF ZDEBUG} ZLog('ZReceieveBinaryHeader32 -> CRC error'); {$ENDIF}

    ZReceiveBinaryHeader32 := ZERROR;
    Exit;
  End;

  ZReceiveBinaryHeader32 := RxType;
End;

Procedure TProtocolZmodem.SendEscaped (B: SmallInt);
Var
  C1 : Char;
  C2 : Char;
Begin
  If (EscapeAll) And ((B AND $60) = 0) Then Begin
    Client.BufWriteChar(Char(ZDLE));
    LastSent := B XOR $40;
  End Else If (B and $11) = 0 Then
    LastSent := B
  Else Begin
    C1 := Char(B and $7F);
    C2 := Char(LastSent and $7F);

    Case B of
      Xon,
      Xoff,
      cDle,
      cXonHi,
      cXoffHi,
      cDleHi,
      ZDle    : Begin
                  Client.BufWriteChar(Char(ZDLE));
                  LastSent := B xor $40;
                End;
      255     : Begin
                  Client.BufWriteChar(Char(ZDLE));
                  LastSent := ZRUB1;
                End;
    Else
      If ((C1 = #13) and (C2 = #$40)) Then Begin
        Client.BufWriteChar(Char(ZDLE));
        LastSent := B xor $40;
      End Else
        LastSent := B;
    End;
  End;

  Client.BufWriteChar(Char(LastSent));
End;

Procedure TProtocolZmodem.ZSendBinaryHeader (FrameType : Byte);
Var
  ulCRC : LongInt;
  CRC   : SmallInt;
  Count : SmallInt;
Begin
  Client.BufWriteChar(Char(ZPAD));
  Client.BufWriteChar(Char(ZDLE));

  If UseCRC32 Then Begin
    Client.BufWriteChar(Char(ZBIN32));

    SendEscaped (FrameType);

    ulCRC := Crc32(FrameType, LongInt($FFFFFFFF));

    For Count := 0 to 3 Do Begin
      SendEscaped (TxHdr[Count]);
      ulCRC := Crc32 (TxHdr[Count], ulCRC);
    End;

    ulCRC := Not ulCRC;

    For Count := 0 to 3 Do Begin
      SendEscaped (Byte(ulCRC));
      ulCRC := ulCRC SHR 8;
    End;
  End Else Begin
    Client.BufWriteChar(Char(ZBIN));

    SendEscaped (FrameType);

    CRC := Crc16(FrameType, 0);

    For Count := 0 to 3 Do Begin
      SendEscaped (TxHdr[Count]);
      CRC := Crc16 (TxHdr[Count], CRC);
    End;

    CRC := Crc16(0, CRC);
    CRC := Crc16(0, CRC);

    SendEscaped (Lo(SmallInt(CRC SHR 8)));
    SendEscaped (Lo(CRC));
  End;

  Client.BufFlush;

  If FrameType <> ZDATA Then WaitMS(250); { do we need this? }
End;

Function TProtocolZmodem.ZGetHex : SmallInt;
Var
  C : SmallInt;
  N : SmallInt;
Begin
  C := ZGetByte;

  If C < 0 Then Begin
    ZGetHex := C;
    Exit;
  End;

  N := C - 48;

  If N > 9 Then
    N := N - 39;

  If (N AND $FFF0) <> 0 Then Begin
    ZGetHex := ZERROR;
    Exit;
  End;

  C := ZGetByte;

  If C < 0 Then Begin
    ZGetHex := C;
    Exit;
  End;

  C := C - 48;

  If C > 9 Then
    C := C - 39;

  If (C AND $FFF0) <> 0 Then Begin
    ZGetHex := ZERROR;
    Exit;
  End;

  C := C + (N SHL 4);

  ZGetHex := C;
End;

Function TProtocolZmodem.ZGetLong (Var Hdr: ZHdrType) : LongInt;
Begin
  Result := Hdr[ZP3];
  Result := (Result SHL 8) OR Hdr[ZP2];
  Result := (Result SHL 8) OR Hdr[ZP1];
  Result := (Result SHL 8) OR Hdr[ZP0];
End;

Function TProtocolZmodem.ZReceiveHexHeader (Var Hdr : ZHdrType) : SmallInt;
Var
  N   : SmallInt;
  C   : SmallInt;
  CRC : Word;
Begin
  C := ZGetHex;

  If C < 0 Then Begin
    ZReceiveHexHeader := C;
    Exit;
  End;

  RxType := C;
  CRC    := Crc16(RxType, 0);

  For N := 0 To 3 Do Begin
    C := ZGetHex;

    If C < 0 Then Begin
      ZReceiveHexHeader := C;
      Exit;
    End;

    Hdr[N] := Lo(C);
    CRC    := Crc16(Lo(C), CRC);
  End;

  C := ZGetHex;

  If C < 0 Then Begin
    ZReceiveHexHeader := C;
    Exit;
  End;

  CRC := Crc16(Lo(C), CRC);

  C := ZGetHex;

  If C < 0 Then Begin
    ZReceiveHexHeader := C;
    Exit;
  End;

  CRC := Crc16(Lo(C), CRC);

  If (CRC <> 0) Then Begin
    {$IFDEF ZDEBUG} ZLog('ZReceieveHexHeader -> CRC error'); {$ENDIF}
    ZReceiveHexHeader := ZERROR;
    Exit;
  End;

  If ReadByteTimeOut(20) = 13 Then
    C := ReadByteTimeOut(20);

  ZReceiveHexHeader := RxType;
End;

Function TProtocolZmodem.ZGetHeader (Var Hdr: ZHdrType) : SmallInt;
Label
  Again,
  Again2,
  Splat,
  Finished;
Var
  C         : SmallInt;
  SyncTries : SmallInt;
  CanCount  : SmallInt;
Begin
  SyncTries  := 32;
  CanCount   := 5;
  RxFrameIdx := 0;
  RxType     := 0;

Again:

  C := ZGetByte;

  Case C of
    ZPAD    : Goto Splat;
    RCDO,
    ZTIMEOUT: Goto Finished;
    CAN     : Begin
                Dec (CanCount);
                If CanCount <= 0 Then Begin
                  C := ZCAN;
                  Goto Finished;
                End;
              End;
  Else

Again2:

    Dec (SyncTries);

    If SyncTries = 0 Then Begin
      ZGetHeader := ZERROR;
      Exit;
    End;

    If C <> CAN Then
      CanCount := 5;

    Goto Again;
  End;

  CanCount := 5;

Splat:

  C := ZGetByte;

  Case C of
    ZPAD    : Goto Splat;
    RCDO,
    ZTIMEOUT: Goto Finished;
    ZDLE    : ;
  Else
    Goto Again2;
  End;

  C := ZGetByte;

  Case C of
    RCDO,
    ZTIMEOUT: Goto Finished;
    ZBIN    : Begin
                RxFrameIdx := ZBIN;
                C := ZReceiveBinaryHeader(Hdr);
              End;
    ZBIN32  : Begin
                RxFrameIdx := ZBIN32;
                C := ZReceiveBinaryHeader32(Hdr);
              End;
    ZHEX    : Begin
                RxFrameIdx := ZHEX;
                C := ZReceiveHexHeader(Hdr);
              End;
    CAN     : Begin
                Dec (CanCount);

                If CanCount <= 0 Then Begin
                  C := ZCAN;
                  Goto Finished;
                End;
                Goto Again2;
              End;
    Else
      Goto Again2;
    End;

  RxPos := ZGetLong(Hdr);

Finished:

  If C = GOTCAN Then C := ZCAN;

  {$IFDEF ZDEBUG} ZLog('ZGetHeader -> Result ' + HeaderType(C)); {$ENDIF}

  Result := C;
End;

Function TProtocolZmodem.ZInitReceiver : SmallInt;
Var
  I : SmallInt;
Begin
  ZPutLong (0);
  ZSendHexHeader (ZRQINIT);

  {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> begin ZRQINIT want ZRINIT'); {$ENDIF}

  For I := 0 to 10 Do Begin
    If AbortTransfer Then Break;

    Case ZGetHeader(RxHdr) of
      ZCHALLENGE: Begin
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZCHALLENGE'); {$ENDIF}

                    ZPutLong (RxPos);
                    ZSendHexHeader (ZACK);
                  End;
      ZCOMMAND  : Begin
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZCOMMAND'); {$ENDIF}

                    ZPutLong (0);
                    ZSendHexHeader (ZRQINIT);
                  End;
      ZRINIT    : Begin
                    RxBufLen      := (Word(RxHdr[ZP1]) SHL 8) OR RxHdr[ZP0];
                    UseCrc32      := (RxHdr[ZF0] AND CANFC32) <> 0;
                    EscapeAll     := (RxHdr[ZF0] AND ESCALL) = ESCALL;
                    ZInitReceiver := ZOK;

                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> ZRINIT'); {$ENDIF}
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> CRC32:' + strI2S(Ord(UseCrc32))); {$ENDIF}
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> EscapeAll:' + strI2S(Ord(EscapeAll))); {$ENDIF}
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> BlockSize:' + strI2S(RxBufLen)); {$ENDIF}

                    Exit;
                  End;
      RCDO,
      ZCAN,
      ZTIMEOUT  : Begin
                    {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got TIMEOUT/CAN'); {$ENDIF}

                    ZInitReceiver := ZERROR;
                    Exit;
                  End;
      ZRQINIT   : {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZRQINIT response') {$ENDIF};
    Else
      {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Unknown sending ZNAK'); {$ENDIF}
      ZSendHexHeader (ZNAK);
    End;
  End;

  Result := ZERROR;
End;

Procedure TProtocolZmodem.ZSendData (BufSize: SmallInt; FrameEnd: Byte);
Var
  ulCRC : LongInt;
  CRC   : SmallInt;
  Count : LongInt;
Begin
  If UseCRC32 Then Begin
    ulCRC := LongInt($FFFFFFFF);

    For Count := 0 to BufSize - 1 Do Begin
      SendEscaped (TxBuf[Count]);
      ulCRC := Crc32(TxBuf[Count], ulCRC);
    End;

    ulCRC := Crc32(FrameEnd, ulCRC);
    ulCRC := Not ulCRC;

    Client.BufWriteChar(Char(ZDLE));
    Client.BufWriteChar(Char(FrameEnd));

    For Count := 0 to 3 Do Begin
      SendEscaped (Byte(ulCRC));
      ulCRC := ulCRC SHR 8;
    End;

  End Else Begin
    CRC := 0;

    For Count := 0 to BufSize - 1 Do Begin
      SendEscaped (TxBuf[Count]);
      CRC := Crc16(TxBuf[Count], CRC);
    End;

    CRC := Crc16(FrameEnd, CRC);

    Client.BufWriteChar(Char(ZDLE));
    Client.BufWriteChar(Char(FrameEnd));

    CRC := Crc16(0, CRC);
    CRC := Crc16(0, CRC);

    SendEscaped (Lo(SmallInt(CRC SHR 8)));
    SendEscaped (Lo(CRC));
	End;

  If FrameEnd = ZCRCW Then Begin
    Client.BufWriteChar(Char(XON));
//    WaitMS(250);
  End;

  Client.BufFlush;
End;

Function TProtocolZmodem.ZSendFile : SmallInt;
Label
  Start;
Var
  FTime      : LongInt;
  TmpStr     : String;
  C          : SmallInt;
  Res        : LongInt;
  FileDone   : Boolean;
  GoodBlks   : Word;
  GoodNeeded : Word;
Begin
  {$IFDEF ZDEBUG} ZLog(''); {$ENDIF}
  {$IFDEF ZDEBUG} ZLog('ZSendFile -> begin'); {$ENDIF}
  {$IFDEF ZDEBUG} ZLog('ZSendFile -> file:' + Queue^.QData[Queue^.QPos]^.FName); {$ENDIF}

  Result := ZERROR;

  Assign (WrkFile, Queue.QData[Queue.QPos]^.FilePath + Queue.QData[Queue.QPos]^.FileName);

  If Not ioReset (WrkFile, 1, fmReadWrite + fmDenyNone) Then Exit;

  GetFTime (WrkFile, FTime);

  Status.FileName  := Queue.QData[Queue.QPos]^.FileName;
  Status.FilePath  := Queue.QData[Queue.QPos]^.FilePath;
  Status.FileSize  := Queue.QData[Queue.QPos]^.FileSize;
  Status.Position  := 0;
  Status.StartPos  := 0;
  Status.StartTime := TimerSeconds;

  StatusUpdate(False, False);

  Repeat
    If AbortTransfer Then Begin
      Close (WrkFile);
      Exit;
    End;

    FillChar (TxHdr, SizeOf(TxHdr), 0);
    FillChar (TxBuf, SizeOf(TxBuf), 0);

    TxHdr[ZF0] := ZCRESUM;

    TmpStr := Status.FileName + #0 + strI2S(Status.FileSize);

    Move (TmpStr[1], TxBuf[0], Length(TmpStr));

    ZSendBinaryHeader (ZFILE);
    ZSendData (Length(TmpStr), ZCRCW);

    {$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZFILE want ZRPOS'); {$ENDIF}

    WaitMS(500);  // Delay for older terminal programs apparently

    Repeat
      C := ZGetHeader(RxHdr);

      {$IFDEF ZDEBUG} ZLog('ZSendFile -> Handshake header ' + HeaderType(C)); {$ENDIF}

      Case C of
        ZRINIT    : ;
        RCDO,
        ZCAN,
        ZABORT,
        ZFIN,
        ZTIMEOUT  : Begin
                      Close (WrkFile);
                      Exit;
                    End;
        ZSKIP     : Begin
                      Close (WrkFile);
                      ZSendFile := ZSKIP;
                      Exit;
                    End;
        ZRPOS     : Goto start;
      End;
    Until (C <> ZRINIT);
  Until False;

Start:

  {$IFDEF ZDEBUG} ZLog('ZSendFile -> Start transfer at ' + strI2S(RxPos)); {$ENDIF}

  Seek (WrkFile, RxPos);

  TxPos      := RxPos;
  FileDone   := False;
  GoodBlks   := 0;
  GoodNeeded := 0;
  RxBufLen   := ZBufSize;

  Status.Position  := RxPos;
  Status.BlockSize := RxBufLen;

  StatusUpdate(False, False);

  If TxPos < Status.FileSize Then Begin
    ZPutLong (TxPos);
    ZSendBinaryHeader (ZDATA);
  End;

  StatusTimer := TimerSet(StatusCheck);

  While Not EndTransfer Do Begin
    If Not FileDone Then Begin
      ioBlockRead (WrkFile, TxBuf, RxBufLen, Res);

      If Res > 0 Then Begin
        If Res < RxBufLen Then
          ZSendData (Res, ZCRCE)
        Else
          ZSendData (Res, ZCRCG);

        Inc (TxPos, Res);

        Status.Position  := TxPos;
        Status.BlockSize := Res;

        If TimerUp(StatusTimer) Then Begin
          If AbortTransfer Then Break;
          StatusUpdate(False, False);
          StatusTimer := TimerSet(StatusCheck);
        End;
      End Else Begin
        {$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZEOF want ZRINIT'); {$ENDIF}

        FileDone := True;
        ZPutLong (TxPos);
        ZSendBinaryHeader (ZEOF);

        StatusUpdate(False, False);
      End;
    End;

    Inc (GoodBlks);

    If (RxBufLen < ZBUFSIZE) And (GoodBlks > GoodNeeded) Then Begin
      If ((RxBufLen SHL 1) < ZBUFSIZE) Then
        RxBufLen := RxBufLen SHL 1
      Else
        RxBufLen := ZBUFSIZE;

      GoodBlks := 0;
    End;

    While Client.DataWaiting And Not AbortTransfer Do Begin
      {$IFDEF ZDEBUG} ZLog('ZSendFile -> Might have packet response, checking'); {$ENDIF}

      C := ReadByteTimeOut(200);

      If (C = CAN) or (C = ZPAD) Then Begin
        C := ZGetHeader(RxHdr);

        {$IFDEF ZDEBUG} ZLog('ZSendFile -> Got packet response ' + HeaderType(C)); {$ENDIF}

        Case C of
          ZACK    : Continue;
          ZRINIT  : Begin
                      Close (WrkFile);
                      Result := ZOK;
                      Exit;
                    End;
          ZRPOS   : Begin
                      TxPos    := RxPos;
                      FileDone := False;

                      ioSeek (WrkFile, TxPos);

                      Client.PurgeInputData;
                      Client.PurgeOutputData;

                      If TxPos < Status.FileSize Then Begin
                        ZPutLong (TxPos);
                        ZSendBinaryHeader (ZDATA);
                      End;

                      If RxPos > 0 Then Begin
                        If (RxBufLen SHR 2) > 64 Then
                          RxBufLen := RxBufLen SHR 2
                        Else
                          RxBufLen := 64;

                        GoodBlks := 0;

                        If GoodNeeded SHL 1 > 16 Then
                          GoodNeeded := 16
                        Else
                          GoodNeeded := GoodNeeded SHL 1;
                      End;

                      Status.Position  := RxPos;
                      Status.BlockSize := RxBufLen;

                      StatusUpdate(False, False);

                      Break;
                    End;
          ZSKIP   : Begin
                      Close (WrkFile);
                      ZSendFile := ZSKIP;
                      Exit;
                    End;
        End;
      End;
    End;
  End;

  Close (WrkFile);
End;

Procedure TProtocolZmodem.ZEndSender;
Var
  TimeOut : LongInt;
Begin
  TimeOut := TimerSet(500);

  While Not AbortTransfer And Not TimerUp(TimeOut) Do Begin
    Client.PurgeInputData;

    ZPutLong (0);
    ZSendBinaryHeader (ZFIN);

    If Not Client.DataWaiting Then
      WaitMS(500)
    Else
      Case ZGetHeader(RxHdr) of
        ZFIN: Begin
                Client.BufWriteStr('OO');
                Client.BufFlush;
                Break;
              End;
        ZCAN,
        ZTIMEOUT,
        RCDO: Break;
      End;
  End;
End;

Procedure TProtocolZmodem.ZAckBiBi;
Var
  Count : Byte;
  Ch    : SmallInt;
Begin
  {$IFDEF ZDEBUG} ZLog('ZAckBiBi -> begin'); {$ENDIF}

  ZPutLong (0);

  // Send ZFIN and wait up to 5 seconds for OO

  For Count := 1 to 5 Do Begin
    If AbortTransfer Then Break;

    ZSendHexHeader (ZFIN);

    Ch := ReadByteTimeOut(100);

    {$IFDEF ZDEBUG} ZLog('ZAckBiBi -> ZFIN response is ' + HeaderType(Ch)); {$ENDIF}

    Case Ch of
      Ord('O')  : Begin
                    {$IFDEF ZDEBUG} ZLog('ZAckBiBi -> Got ending O'); {$ENDIF}
                    ReadByteTimeOut(1);
                    Break;
                  End;
      ZTIMEOUT,
      RCDO      : Break;
    End;
  End;
End;

Function TProtocolZmodem.ZInitSender : SmallInt;
Label
  Again;
Var
  Tmp    : SmallInt;
  N      : SmallInt;
  Errors : SmallInt;
Begin
  UseCRC32   := True;
  Errors     := 0;

  {$IFDEF ZDEBUG} ZLog('ZInitSender -> begin'); {$ENDIF}

  For N := 1 to 10 Do Begin
    If AbortTransfer Then Break;

    FillChar (TxHdr, SizeOf(TxHdr), 0); // zero out all flags

    TxHdr[ZF0] := CANFDX OR CANOVIO OR CANFC32 {OR CANBRK};

    If EscapeAll Then
      TxHdr[ZF0] := TxHdr[ZF0] or ESCALL;

    {$IFDEF ZDEBUG} ZLog('ZInitSender -> Sending ZRINIT'); {$ENDIF}

    ZSendHexHeader (ZRINIT);

Again:

    Tmp := ZGetHeader(RxHdr);

    {$IFDEF ZDEBUG} ZLog('ZInitSender -> Got response ' + HeaderType(Tmp)); {$ENDIF}

    Case Tmp of
      ZRQINIT : Continue;
      ZEOF    : Continue;
      ZTIMEOUT: Continue;
      ZFILE   : Begin
                  If ZReceiveData(RxBuf, ZBUFSIZE) = GOTCRCW Then Begin
                    ZInitSender := ZFILE;
                    Exit;
                  End;

                  ZSendHexHeader (ZNAK);
                  Goto Again;
                End;
      ZSINIT  : Begin
                  If ZReceiveData (RxBuf, ZATTNLEN) = GOTCRCW Then Begin
                    Attn := '';
                    Tmp  := 0;
                    While RxBuf[Tmp] <> 0 Do Begin
                      Attn := Attn + Chr(RxBuf[Tmp]);
                      Inc (Tmp);
                    End;
                    ZPutLong (1);
                    ZSendHexHeader (ZACK);
                  End Else
                    ZSendHexHeader (ZNAK);

                  Goto Again;
                End;
      ZFREECNT: Begin
                  ZPutLong (LongInt($FFFFFFFF));
                  ZSendHexHeader (ZACK);

                  Goto Again;
                End;
      ZCOMMAND: Begin
                  If ZReceiveData (RxBuf, ZBUFSIZE) = GOTCRCW Then Begin
                    ZPutLong (0);
                    Repeat
                      ZSendHexHeader (ZCOMPL);
                      Inc (Errors);
                    Until (Errors >= 10) or (ZGetHeader(RxHdr) = ZFIN);
                    ZAckBiBi;
                    ZInitSender := ZCOMPL;
                    Exit;
                  End Else
                    ZSendHexHeader (ZNAK);

                  Goto Again;
                End;
      ZCOMPL  : Continue;
      ZFIN    : Begin
                  ZAckBiBi;
                  ZInitSender := ZCOMPL;
                  Exit;
                End;
      RCDO,
      ZCAN    : Begin
                  ZInitSender := ZERROR;
                  Exit;
                End;
    End;
  End;

  ZInitSender := ZOK;
End;

Function TProtocolZmodem.ZReceiveData (Var Buf: ZBufType; Len: SmallInt) : SmallInt;
Label
  ErrorCRC16,
  ErrorCRC32;
Var
  C, D   : SmallInt;
  CRC    : SmallInt;
  ulCRC  : LongInt;
  Count  : SmallInt;
Begin
  RxCount := 0;

  If RxFrameIdx = ZBIN32 Then Begin
    ulCRC := LongInt($FFFFFFFF);

    While (Len >= 0) Do Begin
      C := ZDLRead;

      If Hi(C) <> 0 Then Begin

ErrorCRC32:

        Case C of
          GOTCRCE,
          GOTCRCG,
          GOTCRCQ,
          GOTCRCW : Begin
                      D     := C;
                      ulCRC := Crc32(Lo(C), ulCRC);

                      For Count := 1 to 4 Do Begin
                        C := ZDLRead;

                        If Hi(C) <> 0 Then Goto ErrorCRC32;

                        ulCRC := Crc32(Lo(C), ulCRC);
                      End;

                      If (ulCRC <> LongInt($DEBB20E3)) Then Begin
                        {$IFDEF ZDEBUG} ZLog('ZReceiveData -> CRC32 error'); {$ENDIF}
                        Result := ZERROR;
                        Exit;
                      End;

                      Result := D;

                      Exit;
                    End;
          GOTCAN  : Begin
                      ZReceiveData := ZCAN;
                      Exit;
                    End;
        Else
          ZReceiveData := C;
          Exit;
        End;
      End;

      Buf[RxCount] := Lo(C);

      Dec (Len);
      Inc (RxCount);

      ulCRC := Crc32(Lo(C), ulCRC);
    End;
  End Else Begin
    CRC := 0;

     While Len >= 0 Do Begin
      C := ZDLRead;

      If Hi(C) <> 0 Then Begin

ErrorCRC16:

        Case C of
          GOTCRCE,
          GOTCRCG,
          GOTCRCQ,
          GOTCRCW : Begin
                      D := C;

                      For Count := 1 to 2 Do Begin
                        CRC := Crc16(Lo(C), CRC);

                        C := ZDLRead;

                        If Hi(C) <> 0 Then Goto ErrorCRC16;
                      End;

                      CRC := Crc16(Lo(C), CRC);

                      If CRC <> 0 Then Begin
                        {$IFDEF ZDEBUG} ZLog('ZReceiveData -> CRC16 error'); {$ENDIF}
                        ZReceiveData := ZERROR
                      End Else
                        ZReceiveData := D;

                      Exit;
                    End;
          GOTCAN  : Begin
                      ZReceiveData := ZCAN;
                      Exit;
                    End;
        Else
          ZReceiveData := C;
          Exit;
        End;

        Buf[RxCount] := Lo(C);

        Inc(RxCount);
        Dec(Len);

        CRC := Crc16(Lo(C), CRC);
      End;
    End;
  End;

  {$IFDEF ZDEBUG} ZLog('ZReceiveData -> ZERROR (frameidx=' + strI2S(RxFrameIdx) + ')'); {$ENDIF}

  ZReceiveData := ZERROR;
End;

Function TProtocolZmodem.ZReceiveFile : SmallInt;
Label
  NextHeader,
  MoreData;
Var
  Tmp        : SmallInt;
  FName      : String;
  FSize      : LongInt;
  RetryCount : SmallInt;
  C          : SmallInt;
Begin
  {$IFDEF ZDEBUG} ZLog(''); {$ENDIF}
  {$IFDEF ZDEBUG} ZLog('ZRecvFile -> begin'); {$ENDIF}

  FName   := '';
  FSize   := 0;
  RxBytes := 0;

  Tmp := 0;
  While RxBuf[Tmp] <> 0 Do Begin
    FName := FName + Chr(RxBuf[Tmp]);
    Inc (Tmp);
  End;

  // Strip path if exists, and leading/trailing spaces
  FName := JustFile(strStripB(FName, ' '));

  Inc (Tmp);
  While (RxBuf[Tmp] <> $20) and (RxBuf[Tmp] <> 0) Do Begin
    FSize := (FSize * 10) + RxBuf[Tmp] - $30;
    Inc (Tmp);
  End;

  {$IFDEF ZDEBUG} ZLog('ZRecvFile -> File:' + FName); {$ENDIF}
  {$IFDEF ZDEBUG} ZLog('ZRecvFile -> Size:' + strI2S(FSize)); {$ENDIF}

  Client.PurgeInputData;

  Queue.Add(ReceivePath, FName);

  Queue.QData[Queue.QSize]^.FileSize := FSize;
  Queue.QData[Queue.QSize]^.Status   := QueueIntransit;

  Assign (WrkFile, ReceivePath + FName);

  {$I-} Reset (WrkFile, 1); {$I+}

  If IoResult = 0 Then Begin
    If FSize = FileSize(WrkFile) Then Begin
      // Same size file, SKIP it
      Close (WrkFile);

      Queue.QData[Queue.QSize]^.Status := QueueSkipped;

      ZSendHexHeader (ZSKIP);

      ZReceiveFile := ZEOF;

      Exit;
    End Else
    If FileSize(WrkFile) < FSize Then Begin
      // Resume transfer
      RxBytes := FileSize(WrkFile);

      Seek (WrkFile, RxBytes);
    End Else Begin
      // If adding rename/overwrite support do it either
      // but for now we just ZSKIP

      Close (WrkFile);

      Queue.QData[Queue.QSize]^.Status := QueueSkipped;

      ZSendHexHeader (ZSKIP);

      ZReceiveFile := ZEOF;

      Exit;
    End;
  End Else Begin
    {$I-} ReWrite (WrkFile, 1); {$I+}

    If IoResult <> 0 Then Begin
      ZSendHexHeader (ZSKIP);
      ZReceiveFile := ZEOF;

      Exit;
    End;
  End;

  {$IFDEF ZDEBUG} ZLog('ZRecvFile -> Begin data'); {$ENDIF}

  Status.FilePath  := ReceivePath;
  Status.FileName  := FName;
  Status.FileSize  := FSize;
  Status.BlockSize := 0;
  Status.Position  := RxBytes;
  Status.StartTime := TimerSeconds;

  StatusUpdate(False, False);

  RetryCount := 25;

  Queue.QData[Queue.QSize]^.Status := QueueFailed;

  StatusTimer := TimerSet(StatusCheck);

  While Not EndTransfer Do Begin

    {$IFDEF ZDEBUG} ZLog('ZRecvFile -> Sending ZRPOS ' + strI2S(RxBytes)); {$ENDIF}

    ZPutLong (RxBytes);
    ZSendBinaryHeader (ZRPOS);

NextHeader:

    C := ZGetHeader(RxHdr);

    {$IFDEF ZDEBUG} ZLog('ZRecvFile -> NextHeader -> Got ' + HeaderType(C)); {$ENDIF}

    Case C of
      ZNAK,
      ZTIMEOUT: Begin
                  Dec (RetryCount);

                  If RetryCount < 0 Then Begin
                    Close (WrkFile);
                    ZReceiveFile := ZERROR;
                    Exit;
                  End;
                End;
      ZFILE   : Begin
                  ZReceiveData (RxBuf, ZBUFSIZE);
                  Continue;
                End;
      ZEOF    : Begin
                  If ZGetLong(RxHdr) <> RxBytes Then Continue;

                  Status.Position  := RxBytes;
                  Status.BlockSize := RxCount;

                  StatusUpdate(False, False);

                  Close (WrkFile);

                  Queue.QData[Queue.QSize]^.Status := QueueSuccess;

                  ZReceiveFile := C;

                  Exit;
                End;
      ZERROR  : Begin
                  Dec (RetryCount);

                  If RetryCount < 0 Then Begin
                    Close (WrkFile);
                    ZReceiveFile := ZERROR;
                    Exit;
                  End;

                  Client.BufWriteStr(Attn);
                  Client.BufFlush;

                  Continue;
                End;
      ZDATA   : Begin
                  If ZGetLong(RxHdr) <> RxBytes Then Begin
                    {$IFDEF ZDEBUG} ZLog('ZRecvFile -> NextHeader -> ZDATA -> Size not ' + strI2S(RxBytes)); {$ENDIF}

                    Dec(RetryCount);

                    If RetryCount < 0 Then Begin
                      Close (WrkFile);
                      ZReceiveFile := ZERROR;
                      Exit;
                    End;

                    Client.BufWriteStr(Attn);
                    Client.BufFlush;

                    Continue;
                  End;

MoreData:

                  If TimerUp(StatusTimer) Then Begin
                    If AbortTransfer Then Break;

                    StatusUpdate(False, False);

                    StatusTimer := TimerSet(StatusCheck);
                  End;

                  C := ZReceiveData(RxBuf, ZBUFSIZE);

                  {$IFDEF ZDEBUG} ZLog('ZRecvFile -> MoreData -> Got ' + HeaderType(C)); {$ENDIF}

                  Case C of { we can combine zreceivedata and case here }
                    ZCAN    : Begin
                                Close (WrkFile);
                                ZReceiveFile := ZERROR;
                                Exit;
                              End;
                    ZERROR  : Begin
                                Dec(RetryCount);

                                If RetryCount < 0 Then Begin
                                  Close (WrkFile);
                                  ZReceiveFile := ZERROR;
                                  Exit;
                                End;

                                Client.BufWriteStr(Attn);
                                Client.BufFlush;
                              End;
                    ZTIMEOUT: Begin
                                Dec(RetryCount);

                                If RetryCount < 0 Then Begin
                                  Close (WrkFile);
                                  ZReceiveFile := ZERROR;
                                  Exit;
                                End;

                                Continue;
                              End;
                    GOTCRCW : Begin
                                RetryCount := 25;

                                BlockWrite (WrkFile, RxBuf, RxCount);

                                RxBytes := RxBytes + RxCount;

                                ZPutLong (RxBytes);
                                ZSendBinaryHeader (ZACK);

                                Status.Position  := RxBytes;
                                Status.BlockSize := RxCount;

                                Goto NextHeader;
                              End;
                    GOTCRCQ : Begin
                                RetryCount := 25;

                                BlockWrite (WrkFile, RxBuf, RxCount);

                                Rxbytes := RxBytes + RxCount;

                                ZPutLong (RxBytes);

                                ZSendBinaryHeader (ZACK);

                                Status.Position  := RxBytes;
                                Status.BlockSize := RxCount;

                                Goto MoreData;
                              End;
                    GOTCRCG : Begin
                                RetryCount := 25;

                                BlockWrite (WrkFile, RxBuf, RxCount);

                                Rxbytes := RxBytes + RxCount;

                                Status.Position  := RxBytes;
                                Status.BlockSize := RxCount;

                                Goto MoreData;
                              End;
                    GOTCRCE : Begin
                                RetryCount := 25;

                                BlockWrite (WrkFile, RxBuf, Rxcount);

                                Rxbytes := RxBytes + Rxcount;

                                Status.Position  := RxBytes;
                                Status.BlockSize := RxCount;

                                Goto NextHeader;
                              End;
                  End;
                End;

    End;
  End;

  Close (WrkFile);

  ZReceiveFile := ZERROR;
End;

Procedure TProtocolZmodem.DoAbortSequence;
Begin
  If Not Connected Then Exit;

  Client.PurgeInputData;
  Client.PurgeOutputData;
  Client.BufWriteStr(Attn);
  Client.BufWriteStr(CancelStr);
  Client.BufFlush;
End;

Procedure TProtocolZmodem.QueueReceive;
Begin
  Status.Sender := False;

  StatusUpdate(True, False);

  RxBufLen := ZBufSize;

  While Not AbortTransfer Do Begin
    If ZInitSender = ZFILE Then Begin
      If ZReceiveFile <> ZEOF Then Break;
    End Else
      Break;
  End;

  If AbortTransfer Then DoAbortSequence;

  StatusUpdate(False, True);
End;

Procedure TProtocolZmodem.QueueSend;
Begin
  Status.Sender := True;

  StatusUpdate (True, False);

  Queue.QPos := 0;

  While Queue.Next And Not AbortTransfer Do Begin
    If Queue.QPos = 1 Then
      If ZInitReceiver <> ZOK Then Break;

    Case ZSendFile of
      ZOK     : Queue.QData[Queue.QPos]^.Status := QueueSuccess;
      ZSKIP   : Queue.QData[Queue.QPos]^.Status := QueueSkipped;
      ZERROR  : Queue.QData[Queue.QPos]^.Status := QueueFailed;
    End;
  End;

  If AbortTransfer Then
    DoAbortSequence
  Else
    ZEndSender;

  StatusUpdate(False, True);
End;

End.