{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       ZModem protocol implementation (VCL)            }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 23 Oct 2005                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrzmodem;

interface

uses nrcomm, nrclasses, // ExtCtrls,
     {$IFDEF LINUX}
       nrlinux,
       {$IFDEF NR_WITH_CONTROLS}
         qcomctrls,
       {$ENDIF}
     {$ELSE}
       Windows, nrwin32,
       {$IFDEF NR_WITH_CONTROLS}
         comctrls,
       {$ENDIF}
     {$ENDIF}
     SysUtils, Classes;

Const
  MAX_BIN_BLOCK_SIZE = 1024 * 16;

//Var crcErrorEmul:boolean = false;

type

  TzModemOptions=set of (zoCreateWithNewName,zoOverwrite,zoNotWaitFinal,
                 zoCheckConnection,zoIgnoreFileTime,zoChallenge,zoResuming,
                 zoWithoutRZ,zoSegmentTransfer,zoEscCtrls);

  TzAbortType=(zeByMe,zeByRemote,zeByTimeOut,zeByBadCRC,zeByCommError,zeByUnknown,zeByMedia);

  TzModemState=(msListen,msSend,msReceive);

  TzInternalState=(isWaitSession,isWaitQInit,isWaitZFile,isWaitFileName,
        isWaitZData,isWaitBinBlock,isWaitFin,isWaitRInit,
        isWaitRPos,isWaitInterrupt,isWaitEOFRInit,isWaitZACK,isWaitEscapeData,
        isWaitZACKAfterSInit);

  TzAnswerType=(atSession,atQInit,atRInit,atFileName,atData,atEof,atAbort);

  TFileNameReceivedEvent = procedure (Sender:TObject;var FileName:string; var flSkip:boolean)of object;
  TZAbortEvent           = procedure (Sender:TObject;Error:TzAbortType)of object;
  TFileSentEvent = procedure (Sender:TObject; FileName:string; flComplete:boolean)of object;
  TFileReceivedEvent = procedure (Sender:TObject; FileName:string)of object;

  TzHeader = packed record
    FrameType:AnsiChar;
    CmdType:AnsiChar;
    case Integer of
    0:(F:array[0..3]of AnsiChar;
       CRC:cardinal);
    1:(dF:integer);
    2:(loF,hiF:word);
  end;

  EnrZModemError=class(Exception);

  TnrZModem = class(TnrCustomDataProcessor)
  private{ Private declarations }
    Timer:TnrTimer;
    zState:TzInternalState;

    {$IFDEF NR_WITH_CONTROLS}
    fProgressBar: TProgressBar;
    {$ENDIF}
    fModemState: TzModemState;
    Buff:PAnsiChar;
    Size:integer; //store data for use ...
    zTxHeader:TzHeader;
    zRxHeader:TzHeader;
    idxRxHeader:integer;
    LenRxHeader:integer;
    RxCRC:dword;
    RxBlckCRC:dword;
    sqSessionHeader:TCommEvent;
    sqAbortZ:TCommEvent;
    flRxCRC32:boolean;
    flRxRLE:boolean;
    flRxVariable:boolean;
    flSkipRxChar:boolean;
    flRxFrameEnd:boolean;
    flIgnoreCRC:boolean;
    SessionCaption:string;
    LastRxChar:AnsiChar;   //last char (any)
    RxBinBlockType:AnsiChar;
    fOnBeforeReceived: TFileNameReceivedEvent;
    CountBadCRC:cardinal;
    fErrorLimit: cardinal;
    CurrentFileTime:TDateTime;
    IdxRxBinBlock:integer;
    SizeRxBinBlock:integer;
    RxBinBlock:array[0.. MAX_BIN_BLOCK_SIZE - 1]of AnsiChar;
    TxBinBlock:array[0.. MAX_BIN_BLOCK_SIZE - 1]of AnsiChar;
    fFileName: string;
    fFileSize: integer;
    fDefaultPath: string;
    fOptions: TzModemOptions;
    TimeOutCount:cardinal;
    fTimeOut: cardinal;
    fTimeOutRetries: cardinal;
    fOnSuccessfulEnd: TNotifyEvent;
    fOnProgress: TNotifyEvent;
    fOnCRCError: TNotifyEvent;
    fOnAbort: TZAbortEvent;
    fOnTimeOut: TNotifyEvent;
    flSkipDataPacket:boolean;
    fAbortNoCarrier: boolean;
    flCommandMode:boolean;
    ChallengeNumber:integer;
    InFileList:TSTringList;
    fTotalSize: integer;
    ProgressBase:integer;
    fOnAfterFileSent: TFileSentEvent;
    fEscapeChars:string;
    fFilePosition: integer;
    flPacket:boolean;
    fOnAfterFileReceived: TFileReceivedEvent;
    fOnBeforeFileSend: TFileSentEvent;
    fBlockEndChar:AnsiChar;
    fEscCtrls:boolean;
    timerSend:TnrTimer;

    {$IFDEF NR_WITH_CONTROLS}
    procedure SetProgressBar(const Value: TProgressBar);
    function GetProgressBar: TProgressBar;
    {$ENDIF}

    procedure RestartTimer;
    function zCreateFile(s:string):boolean;
    function zOpenFile(s:string):boolean;
    procedure zCloseFile;
    function zReadFile(var Buffer;L:cardinal):boolean;
    function zWriteFile(var Buffer;L:cardinal):boolean;
    function SetFilePosition(L:integer):boolean;
    function GetAbortNoCarrier: boolean;
    function GetErrorLimit: cardinal;

    function GetDefaultPath: string;
    function GetOptions: TzModemOptions;
    function GetTimeOut: cardinal;
    function GetTimeOutRetries: cardinal;
    function GetOnAbort: TZAbortEvent;
    function GetOnAfterFileReceived: TFileReceivedEvent;
    function GetOnAfterFileSent: TFileSentEvent;
    function GetOnBeforeFileSend: TFileSentEvent;
    function GetOnBeforeReceived: TFileNameReceivedEvent;
    function GetOnCRCError: TNotifyEvent;
    function GetOnProgress: TNotifyEvent;
    function GetOnSuccessfulEnd: TNotifyEvent;
    function GetOnTimeOut: TNotifyEvent;
    procedure SetAbortNoCarrier(const Value: boolean);
    procedure SetDefaultPath(const Value: string);
    procedure SetErrorLimit(const Value: cardinal);
    procedure SetOnAbort(const Value: TZAbortEvent);
    procedure SetOnAfterFileReceived(const Value: TFileReceivedEvent);
    procedure SetOnAfterFileSent(const Value: TFileSentEvent);
    procedure SetOnBeforeFileSend(const Value: TFileSentEvent);
    procedure SetOnBeforeReceived(const Value: TFileNameReceivedEvent);
    procedure SetOnCRCError(const Value: TNotifyEvent);
    procedure SetOnProgress(const Value: TNotifyEvent);
    procedure SetOnSuccessfulEnd(const Value: TNotifyEvent);
    procedure SetOnTimeOut(const Value: TNotifyEvent);
    procedure SetOptions(const Value: TzModemOptions);
    procedure SetTimeOut(const Value: cardinal);
    procedure SetTimeOutRetries(const Value: cardinal);
    function GetZChar(ch: AnsiChar):AnsiString;
  protected  { Protected declarations }
    hFile:integer;
    flResumePossible:boolean;
    procedure ClearRxHeader;
    procedure ClearRxBinBlock;
    procedure SendHexHeader;
    procedure SendBinHeader;
    procedure SendBinBlock(Len:integer; Ch:AnsiChar;flAsync:boolean);
    procedure DoTimeOut(Sender:TObject);
    procedure DoBadCRC;
    procedure DoReceivedBinBlock;
    procedure DoFileName;
    procedure DoEscapeData;
    function IsHeader(Ch,zCh:AnsiChar):boolean;
    procedure IsSession(ch:AnsiChar);
    procedure IsQInitHeader;
    procedure IsRInit;
    procedure IsZSinit;
    procedure IsZSkip;
    procedure IsChallenge;
    procedure IsZFile;
    procedure IsZData;
    procedure IsBinBlock(Ch,zCh:AnsiChar);
    procedure IsZFin;
    procedure IsRPos;
    procedure IsInterrupt;
    procedure IsZACK;
    procedure AnswerRInit(flFin:boolean);
    procedure AnswerZChallenge;
    procedure AnswerSkip;
    procedure AnswerRPos(Pos:cardinal);
    procedure AnswerFin;
    procedure AnswerBeginSession;
    procedure AnswerSInit;
    procedure AnswerZFile;
    procedure AnswerZData(Start:boolean);
    procedure AnswerEOF;
    procedure AnswerAbort;
    procedure AnswerZACK(N:cardinal);
    procedure AnswerZNAK;
    procedure DoAbort(ByIt:TzAbortType);
    procedure RepeatLastHeader;
    procedure UpdateFileTime;
    procedure DoMediumClosed; override;
    procedure DoTimerSender(Sender: TObject);
  public     { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoProcessing(Data:PAnsiChar; Len:cardinal; var R:TIgnoreTypes); override;
    procedure DoAfterSendComplete2(var flCascade:boolean); //override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Send(fName:string);
    procedure Abort;
    property ModemState:TzModemState read fModemState;
    property TotalSize:integer read fTotalSize;
    property FileTotalSize:integer read fFileSize;
    property FilePosition:integer read fFilePosition;
    property FileName:string read fFileName;
    property EscCtrls:boolean read fEscCtrls;
  published  { Published declarations }
    property AbortNoCarrier:boolean read GetAbortNoCarrier write SetAbortNoCarrier;
    property Active;
    property DataProcessor; //cascade processing ...
    property ErrorLimit:cardinal read GetErrorLimit write SetErrorLimit;

    {$IFDEF NR_WITH_CONTROLS}
    property ProgressBar:TProgressBar read GetProgressBar write SetProgressBar;
    {$ENDIF}
    property DefaultPath:string read GetDefaultPath write SetDefaultPath;
    property Options:TzModemOptions read GetOptions write SetOptions;
    property TimeOut:cardinal read GetTimeOut write SetTimeOut;
    property TimeOutRetries:cardinal read GetTimeOutRetries write SetTimeOutRetries;
    property Log;
    property OnBeforeReceived:TFileNameReceivedEvent read GetOnBeforeReceived
                                                     write SetOnBeforeReceived;
    property OnCRCError:TNotifyEvent read GetOnCRCError write SetOnCRCError;
    property OnProgress:TNotifyEvent read GetOnProgress write SetOnProgress;
    property OnTimeOut:TNotifyEvent read GetOnTimeOut write SetOnTimeOut;
    property OnSuccessfulEnd:TNotifyEvent read GetOnSuccessfulEnd write SetOnSuccessfulEnd;
    property OnAbort:TZAbortEvent read GetOnAbort write SetOnAbort;
    property OnAfterFileSent:TFileSentEvent read GetOnAfterFileSent write SetOnAfterFileSent;
    property OnAfterFileReceived:TFileReceivedEvent read GetOnAfterFileReceived write SetOnAfterFileReceived;
    property OnBeforeFileSend:TFileSentEvent read GetOnBeforeFileSend write SetOnBeforeFileSend;
    property OnDataSend;
    property OnFatalError;
  end;

implementation
uses nrcrc,nrsysutils;

Const
  sZError0='The receiving file "%s" already exists!!!';
  sZError1='Error open file "%s" !!!';
  sZError2='TnrZModem is receiving file now.'#13'Abort current session before.';
  sZError3='Error create receiving file "%s" !!!';
  sZError4='The TnrZmodem service is not active.';
  sZError9='The TnrZmodem has not a communication device.';
  sZError10='There are NO files for transmission!!!';

  {$IFDEF LINUX}
  chPathSlash = '/';
  {$ELSE}
  chPathSlash = '\';
  {$ENDIF}

Const
  ///   Z M O D E M . H     Manifest constants for ZMODEM
  ///    application to application file transfer protocol
  ZPAD          = #$2A;          //'*' 052 Padding character begins frames
  ZDLE          = #$18;          //030 Ctrl-X Zmodem escape - `ala BISYNC DLE
  ZDLEE         = #$58;          // Escaped ZDLE as transmitted
  ZBIN          = #$41;          //'A' Binary frame indicator (CRC-16)
  ZHEX          = #$42;          //'B' HEX frame indicator
  ZBIN32        = #$43;          //'C' Binary frame with 32 bit FCS
  ZBINR32       = #$44;          //'D' RLE packed Binary frame with 32 bit FCS
  ZVBIN         = #$61;          //'a' Binary frame indicator (CRC-16)
  ZVHEX         = #$62;          //'b' HEX frame indicator
  ZVBIN32       = #$63;          //'c' Binary frame with 32 bit FCS
  ZVBINR32      = #$64;          //'d' RLE packed Binary frame with 32 bit FCS
  ZRESC         = #$7E;          //0176 RLE flag/escape character
  ZMAXHLEN      = 16;           /// Max header information length  NEVER CHANGE
  ZMAXSPLEN     = 1024;         /// Max subpacket length  NEVER CHANGE

  ZRQINIT       = 0;	// Request receive init
  ZRINIT        = 1;	// Receive init
  ZSINIT        = 2;	// Send init sequence (optional)
  ZACK          = 3;	// ACK to above
  ZFILE         = 4;	// File name from sender
  ZSKIP         = 5;	// To sender: skip this file
  ZNAK          = 6; 	// Last packet was garbled
  ZABORT        = 7;	// Abort batch transfers
  ZFIN          = 8;	// Finish session
  ZRPOS         = 9;	// Resume data trans at this position
  ZDATA         = 10;	// Data packet(s) follow
  ZEOF          = 11;	// End of file
  ZFERR         = 12;	// Fatal Read or Write error Detected
  ZCRC          = 13;	// Request for file CRC and response
  ZCHALLENGE    = 14;	// Receiver's Challenge
  ZCOMPL        = 15;	// Request is complete
  ZCAN          = 16;	// Other end canned session with CAN*5
  ZFREECNT      = 17;	// Request for free bytes on filesystem
  ZCOMMAND      = 18;	// Command from sending program
  ZSTDERR       = 19;	// Output to standard error, data follows

  // ZDLE sequences
  ZCRCE         = $68;  //'h' CRC next, frame ends, header packet follows
  ZCRCG         = $69;  //'i' CRC next, frame continues nonstop
  ZCRCQ         = $6A;  //'j' CRC next, frame continues, ZACK expected
  ZCRCW         = $6B;  //'k' CRC next, ZACK expected, end of frame
  ZRUB0         = $6C;  //'l' Translate to rubout 0177
  ZRUB1         = $6D;  //'m' Translate to rubout 0377

  // zdlread return values (internal)
  // -1 is general error, -2 is timeout
  GOTOR         = $100;
  GOTCRCE       = (ZCRCE or GOTOR);	// ZDLE-ZCRCE received
  GOTCRCG       = (ZCRCG or GOTOR);	// ZDLE-ZCRCG received
  GOTCRCQ       = (ZCRCQ or GOTOR);	// ZDLE-ZCRCQ received
  GOTCRCW       = (ZCRCW or GOTOR);	// ZDLE-ZCRCW received
  GOTCAN        = (GOTOR or $18);	// CAN*5 seen

  // Byte positions within header array
  ZF0           = 3;	// First flags byte
  ZF1           = 2;
  ZF2           = 1;
  ZF3           = 0;
  ZP0           = 0;	// Low order 8 bits of position
  ZP1           = 1;
  ZP2           = 2;
  ZP3           = 3;	// High order 8 bits of file position

  // Parameters for ZRINIT header
  ZRPXWN	= 8;	// 9th byte in header contains window size/256
  ZRPXQQ	= 9;	// 10th to 14th bytes contain quote mask
  // Bit Masks for ZRINIT flags byte ZF0
  CANFDX	= 01;	// Rx can send and receive true FDX
  CANOVIO	= 02;	// Rx can receive data during disk I/O
  CANBRK	= 04;	// Rx can send a break signal
  CANRLE	= 08;	// Receiver can decode RLE
  CANLZW	= 16;	// Receiver can uncompress
  CANFC32	= 32;	// Receiver can use 32 bit Frame Check
  ESCCTL        = $40;	// Receiver expects ctl chars to be escaped
  ESC8          = $80;	// Receiver expects 8th bit to be escaped

  // Bit Masks for ZRINIT flags byte ZF1
  CANVHDR	= 01;	// Variable headers OK
  ZRRQWN	= 8;	// Receiver specified window size in ZRPXWN
  ZRRQQQ	= 16;	// Additional control chars to quote in ZRPXQQ
  ZRQNVH	= (ZRRQWN or ZRRQQQ);// Variable len hdr reqd to access info

  // Parameters for ZSINIT frame
  ZATTNLEN      = 32;	// Max length of attention string
  ALTCOFF       = ZF1;	// Offset to alternate canit string, 0 if not used
  // Bit Masks for ZSINIT flags byte ZF0
  TESCCTL       = $40;	// Transmitter expects ctl chars to be escaped
  TESC8         = $80;	// Transmitter expects 8th bit to be escaped

  // Parameters for ZFILE frame
  // Conversion options one of these in ZF0
  ZCBIN         = 1;	// Binary transfer - inhibit conversion
  ZCNL          = 2;	// Convert NL to local end of line convention
  ZCRESUM	= 3;	// Resume interrupted file transfer
  // Management include options, one of these ored in ZF1
  ZMSKNOLOC	= $80;	// Skip file if not present at rx
  // Management options, one of these ored in ZF1
  ZMMASK        = $1F;	// Mask for the choices below
  ZMNEWL        = 1;	// Transfer if source newer or longer
  ZMCRC         = 2;	// Transfer if different file CRC or length
  ZMAPND        = 3;	// Append contents to existing file (if any)
  ZMCLOB        = 4;	// Replace existing file
  ZMNEW         = 5;	// Transfer if source newer
  // Number 5 is alive ...
  ZMDIFF        = 6;	// Transfer if dates or lengths different
  ZMPROT        = 7; 	// Protect destination file
  ZMCHNG        = 8;	// Change filename if destination exists
  // Transport options, one of these in ZF2
  ZTLZW         = 1;	// Lempel-Ziv compression
  ZTRLE         = 3;	// Run Length encoding
  // Extended options for ZF3, bit encoded
  ZXSPARS	= 64;	// Encoding for sparse file operations
  ZCANVHDR	= 01;	// Variable headers OK
  // Receiver window size override
  ZRWOVR        = 4;	// byte position for receive window override/256

  // Parameters for ZCOMMAND frame ZF0 (otherwise 0)
  ZCACK1        = 1;	// Acknowledge, then do command

  ZSIGNLENGTH   = 3;
  ZRSIGN        = 'r';
  ZZSIGN        = 'z';
  ZEOLNSIGN     = #$0D;

  cmdAbort=ZDLE+ZDLE+ZDLE+ZDLE+ZDLE+ZDLE+ZDLE+ZDLE+#8#8#8#8#8#8#8#8;

function DateTimeToZModemTimeStamp(D:TDateTime):cardinal;
var ts,tsBase:TTimeStamp;
begin
  ts:=DateTimeToTimeStamp(D);
  tsBase:=DateTimeToTimeStamp(EncodeDate(1970,1,1));
  ts.Date:=ts.Date-tsBase.Date;
  Result:=ts.Date*24*60*60+ts.Time div 1000;
end;

function ZModemTimeStampToDateTime(D:integer):TDateTime;
var ts,tsBase:TTimeStamp;
begin
  tsBase:=DateTimeToTimeStamp(EncodeDate(1970,1,1));
  ts.Date:=tsBase.Date+(D div (24*60*60));
  ts.Time:=(D mod (24*60*60))*1000;
  Result:=TimeStampToDateTime(ts);
end;

{function GetZChar(ch: char):string;
begin
  case Ch of
     ZDLE,#$11,#$13,#$91,#$93:
     Result:=ZDLE+Char(Byte(Ch)xor $40);
     else begin
          Result:=ch;
     end;
  end;
end;}

{=============================================}
{ TnrZModem                                   }
{---------------------------------------------}

constructor TnrZModem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sLogPrefix:='nrZModem: ';
  hFile:=-1;
  fEscapeChars:='+';
  fTimeOut:=10000;
  fTimeOutRetries:=3;
  Timer:=TnrTimer.Create;//(Self);
  Timer.Enabled:=False;
  Timer.OnTimer:=DoTimeOut;
  ClearRxHeader;
  zState:=isWaitSession;
  fModemState:=msListen;
  fErrorLimit:=255;
  flIgnoreCRC:=False;
  sqSessionHeader.str:=ZRSIGN+ZZSIGN+ZEOLNSIGN;
  sqSessionHeader.len:=ZSIGNLENGTH;
  sqSessionHeader.Reserved:=0;
  sqAbortZ.str:=ZDLE+ZDLE+ZDLE+ZDLE+ZDLE;
  sqAbortZ.len:=5;
  sqAbortZ.Reserved:=0;
  fOptions:=[zoCreateWithNewName,zoResuming];
  InFileList:=TStringList.Create;
//  timerSend := TTimer.Create(Self);
  timerSend := TnrTimer.Create;//(Self);
  timerSend.Enabled := False;
  timerSend.Interval := 1;
  timerSend.OnTimer := DoTimerSender;
end;

destructor TnrZModem.Destroy;
begin
  if fModemState<>msListen
    then DoAbort(zeByMe);
  Timer.Free;
  InFileList.Free;
  timerSend.Free;
  inherited Destroy;
end;

procedure TnrZModem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation=opRemove then begin
    {$IFDEF NR_WITH_CONTROLS}
    if AComponent=fProgressBar then fProgressBar:= nil;
    {$ENDIF}
  end;
end;

{$IFDEF NR_WITH_CONTROLS}

procedure TnrZModem.SetProgressBar(const Value: TProgressBar);
begin
  fProgressBar := Value;
  if Value<>nil then Value.FreeNotification(self);
end;

function TnrZModem.GetProgressBar: TProgressBar;
begin
  Result:=fProgressBar;
end;

{$ENDIF}

procedure TnrZModem.RestartTimer;
begin
  Timer.Enabled:=False;
  Timer.OnTimer:=nil;
  TimeOutCount:=0;
  Timer.Interval:=fTimeOut;
  Timer.OnTimer:=DoTimeOut;
  Timer.Enabled:=True;
  LoggingFmt(dlDebug,'Start Timer %u ms',[Timer.Interval]);
end;

procedure TnrZModem.zCloseFile;
begin
  if hFile<>-1 then begin
    SysUtils.FileClose(hFile);
    hFile:=-1;
    fFilePosition:=0;
    fFileSize:=0;
    Logging(dlDetail,'File closed');
  end;
end;

function TnrZModem.zCreateFile(s: string):boolean;
label exit_result;
var i:integer;
    sExt,sName:string;
begin
  Result:=False;
  zCloseFile;
  if FileExists(s) then begin
    if (zoResuming in fOptions)and(flResumePossible) then begin
      if zOpenFile(s) then begin
        if fTotalSize<=fFileSize then zCloseFile
                                 else begin
                                    SetFilePosition(fFileSize);
                                    goto exit_result;
                                 end;
      end;
    end;
    if (zoCreateWithNewName in fOptions) then begin
       i:=0;
       sName:=ChangeFileExt(s,'');
       sExt:=ExtractFileExt(s);
       repeat
         s:=Format('%s%d%s',[sName,i,sExt]);
         Inc(i);
       until not FileExists(s);
    end;
    if FileExists(s) and not (zoOverwrite in fOptions) then begin
      DoFatalErrors(3,1,Format(sZError0,[s]));
      exit;
    end;
  end;
  fFileName:=s;
  hFile:=FileCreate(s);
  fFilePosition:=0;
  fFileSize:=0;
exit_result:
  Result:=(hFile<>-1);
  LoggingFmt(dlDetail,'File created [%s]',[s]);
end;

function TnrZModem.zOpenFile(s: string):boolean;
begin
  zCloseFile;
  fFileName:=s;
  hFile:=FileOpen(s,fmOpenReadWrite or fmShareExclusive);
  fFilePosition:=0;
  if hFile<>-1 then begin
    fFileSize:=FileSeek(hFile,0,2);
    if fFileSize<>-1 then FileSeek(hFile,0,0) else fFileSize:=0;
  end;
  LoggingFmt(dlDetail,'File opened [%s]',[s]);
  Result:=(hFile<>-1);
end;

function TnrZModem.zReadFile(var Buffer; L: cardinal):boolean;
var i:integer;
begin
  i:=0;
  Result:=(hFile<>-1);
  if Result then begin
    i:=FileRead(hFile,Buffer,L);
    Result:=(i<>-1);
  end;
  if Result then fFilePosition:=fFilePosition+i
            else fFilePosition:=0;
end;

function TnrZModem.zWriteFile(var Buffer; L: cardinal): boolean;
var i:integer;
begin
  i:=0;
  Result:=(hFile<>-1);
  if Result then begin
    i:=FileWrite(hFile,Buffer,L);
    Result:=(i<>-1);
  end;
  if Result then fFilePosition:=fFilePosition+i
            else fFilePosition:=0;
end;

function TnrZModem.SetFilePosition(L: integer):boolean;
begin
  Result:=(hFile<>-1);
  if Result then Result:=(SysUtils.FileSeek(hFile,L,0)<>-1);
  if Result then fFilePosition:=L;
end;

procedure TnrZModem.DoProcessing(Data: PAnsiChar; Len: cardinal;
   var R: TIgnoreTypes);
label GoToAbort;
var i:integer;
    ch:AnsiChar;
begin
  if Active then begin
    flSkipDataPacket := False;
    Buff := Data;
    Size := Len;

    for i := 0 to Size - 1 do begin

      if fModemState = msListen then begin
        if zoWithoutRZ in fOptions
          then zState := isWaitQInit
          else zState := isWaitSession;
      end;

      if flSkipDataPacket then begin
        LastRxChar := Buff[Size - 1];
        break;
      end;

      R := [];

      if zState = isWaitSession then begin
        IsSession(Buff[i]);
      end else begin //Session is opened ...
        if fModemState<>msListen then R:=[itTerminal];

        // cheking an abort sequense ...
        if CheckSequence(Buff[i],sqAbortZ) then begin
          GoToAbort:
          Logging(dlDetail,'Is Abort!!!');
          DoAbort(zeByRemote);
          continue;
        end;
        flSkipRxChar:=False;
        ch := Buff[i];

        //OutputDebugString(PChar('DoPr: '+IntToHex(Byte(LastRxChar),2)+'='+IntToHex(Byte(Ch),2)));
        //check input char ESC sequence ...
        case Byte(Buff[i]) of
          $11,$13,$91,$93,$18: //
             flSkipRxChar:=True;
          ZCRCE,ZCRCG,ZCRCQ,ZCRCW:
             if LastRxChar=ZDLE
               then ch := AnsiChar(byte(Buff[i]) or GOTOR);
          ZRUB0:
             if LastRxChar=ZDLE
               then ch:=#$7F;
          ZRUB1:
             if LastRxChar=ZDLE
               then ch:=#$FF;
          else begin

             if (fEscCtrls and ((Byte(Buff[i]) and $60)=0))
              then flSkipRxChar:=True;

             if((Byte(Buff[i]) and $60)=$40)and(LastRxChar=ZDLE)
               then ch := AnsiChar(Byte(Buff[i]) xor $40);
          end;
        end;

        if (zState=isWaitBinBlock)or
           (zState=isWaitFileName)or(zState=isWaitEscapeData)
        then IsBinBlock(Buff[i],ch) // Binary block receiving ...
        else
        if IsHeader(Buff[i], ch) then begin // Header is received
          case Byte(zRxHeader.CmdType) of  // now processing it ...
            ZCAN: goto  GoToAbort;
            ZNAK: RepeatLastHeader;
            ZSINIT:IsZSinit;
            ZCHALLENGE:if zState = isWaitRInit then IsChallenge;
            ZSKIP: IsZSkip;
            ZRINIT:case zState of
                     isWaitRInit,isWaitEOFRInit:IsRInit;
                     isWaitRPos:AnswerBeginSession;
                   end;
            else case zState of
                   isWaitQInit:IsQInitHeader;
                   isWaitZFile:IsZFile;
                   isWaitZData:isZData;
                   isWaitFin:isZFin;
                   isWaitRPos:IsRPos;
                   isWaitInterrupt,isWaitEOFRInit:IsInterrupt;
                   isWaitZACK,isWaitZACKAfterSInit:IsZACK;
                 end;
          end;
          ClearRxHeader;
        end;

        if(Buff[i]<>ZDLE)and flSkipRxChar
          then continue;
        LastRxChar:=Buff[i];
      end;
    end;
  end;

  inherited DoProcessing(Data, Len, R);

end;

procedure TnrZModem.ClearRxHeader;
begin
  flRxCRC32:=False;
  flRxRLE:=False;
  flRxVariable:=False;
  idxRxHeader:=0;
  ZeroMemory(@zRxHeader,SizeOf(TzHeader));
  ClearRxBinBlock;
end;

procedure TnrZModem.ClearRxBinBlock;
begin
  ZeroMemory(@RxBinBlock[0],MAX_BIN_BLOCK_SIZE);
  flRxFrameEnd:=False;
  IdxRxBinBlock:=0;
  SizeRxBinBlock:=0;
  RxBinBlockType:=#0;
  RxBlckCRC:=0;
end;

procedure TnrZModem.SendBinHeader;
var p:PAnsiChar;
    i:integer;
    s:AnsiString;
begin
  s := ZPAD+ZDLE+ZBIN;
  zTxHeader.FrameType := ZBIN;
  p := PAnsiChar(Integer(@zTxHeader)+1);
  zTxHeader.CRC := 0;
  for i := 0 to 4 do begin
    s := s + GetZChar(p[i]);
    zTxHeader.CRC:=updcrc(p[i],zTxHeader.CRC);
  end;
  zTxHeader.CRC:=updcrc(#0,updcrc(#0,zTxHeader.CRC));

{  if crcErrorEmul then begin
    crcErrorEmul := False;
    Inc(zTxHeader.CRC);
  end;}

  LoggingFmt(dlDebug,
    'zTxBinHdr: %.2X,%.2X [%.2X,%.2X,%.2X,%.2X] CRC=%.4X',
    [Byte(zTxHeader.FrameType),Byte(zTxHeader.CmdType),
     Byte(zTxHeader.F[0]),Byte(zTxHeader.F[1]),
     Byte(zTxHeader.F[2]),Byte(zTxHeader.F[3]),
     Word(zTxHeader.CRC)]);
  //Device.SendString(s+GetZChar(p[6])+GetZChar(p[5]));
  DoStringSend(AnsiString(s + GetZChar(p[6]) + GetZChar(p[5])));
  ClearRxHeader;
end;

procedure TnrZModem.SendHexHeader;
var p:PAnsiChar;
    s:AnsiString;
    crc:integer;
    i:integer;
begin
  s:='';
  zTxHeader.FrameType:=ZHEX;
  p := PAnsiChar(Integer(PChar(@zTxHeader))+1);
  crc:=0;
  for i := 0 to 4 do begin
    s := s + AnsiString(Format('%.2x',[Byte(p[i])]));
    crc := updcrc(p[i],crc);
  end;
  crc := updcrc(#0,updcrc(#0,crc));

{  if crcErrorEmul then begin
    crcErrorEmul := False;
    Inc(crc);
  end; }

  LoggingFmt(dlDebug,
    'zTxHexHdr: %.2X,%.2X [%.2X,%.2X,%.2X,%.2X] CRC=%.4X',
    [Byte(zTxHeader.FrameType),Byte(zTxHeader.CmdType),
     Byte(zTxHeader.F[0]),Byte(zTxHeader.F[1]),
     Byte(zTxHeader.F[2]),Byte(zTxHeader.F[3]),
     zTxHeader.CRC]);
  s := s + AnsiString(Format('%.4x',[crc]));
  s := ZPAD + ZPAD + ZDLE + ZHEX + AnsiString(Lowercase(String(s))) + #$0D#$8A;
  if(zTxHeader.CmdType <> Char(ZFIN)) and (zTxHeader.CmdType <> Char(ZACK))
     then s := s + #$11;
  //Device.SendString(s);
  DoStringSend(s);
  ClearRxHeader;
end;

procedure TnrZModem.SendBinBlock(Len:integer; Ch:AnsiChar; flAsync:boolean);
var i:integer;
    crc:word;
    s:AnsiString;
begin
  s := '';
  crc := 0;
  for i := 0 to Len - 1 do begin
    s := s + GetZChar(TxBinBlock[i]);
    crc := updcrc(TxBinBlock[i], crc);
  end;
  crc := updcrc(Ch, crc);
  s := s + ZDLE + Ch;
  crc := updcrc(#0, updcrc(#0,crc));

{  if crcErrorEmul then begin
    crcErrorEmul := False;
    Inc(crc);
  end; }

  s := s + GetZChar(PAnsiChar(@crc)[1]) + GetZChar(PAnsiChar(@crc)[0]);
  if flAsync
    then DoDataSend(@s[1],Length(s)) // Device.SendData(@s[1],Length(s))
    else DoStringSend(s);    // Device.SendString(s);
  Logging(dlDebug,'zTxBinBlock!!!  ['+IntToHex(crc,4)+']');
end;

function TnrZModem.IsHeader(Ch, zCh: AnsiChar):boolean;
var p:PAnsiChar;
    b:byte;
begin

  Result := False;
  p := @zRxHeader;
  case zRxHeader.FrameType of
    #0:case idxRxHeader of
         0:if ch=ZPAD then Inc(idxRxHeader);
         1:if(ch=ZPAD)or(ch=ZDLE) then Inc(idxRxHeader)
                                  else idxRxHeader:=0;
         2:if((LastRxChar=ZDLE)and((ch=ZBIN)or(ch=ZVBIN)or(ch=ZBIN32)or(ch=ZVBIN32)))
              or((LastRxChar=ZPAD)and(ch=ZDLE))then begin
               Inc(idxRxHeader);
               if ch<>ZDLE then zRxHeader.FrameType := ch;
             end else idxRxHeader:=0;
         3:if(ch=ZHEX)or(ch=ZVHEX)then begin
             zRxHeader.FrameType:=ch;
             Inc(idxRxHeader);
           end else idxRxHeader:=0;
         else idxRxHeader:=0;
       end;
    ZBIN:begin
         if flSkipRxChar then exit;
         if idxRxHeader=3 then begin
           LenRxHeader:=7;
           RxCRC:=0;
           flRxCRC32:=False;
           p[idxRxHeader-2] := zCh;
           RxCRC:=UpdCRC(zCh,RxCRC);
         end else begin
            if (idxRxHeader-3)<LenRxHeader then begin
                p[idxRxHeader-2] := zCh;
                RxCRC:=UpdCRC(zCh,RxCRC);
              end;
         end;
         Inc(idxRxHeader);
         Result:=((idxRxHeader-3)>=LenRxHeader);
       end;
    ZBIN32:begin
         if flSkipRxChar then exit;
         if idxRxHeader=3 then begin
           LenRxHeader:=9;
           RxCRC:=$FFFFFFFF;
           flRxCRC32:=True;
           RxCRC:=UpdCRC32(zCh,RxCRC);
           p[idxRxHeader-2]:=zCh;
         end else begin
           if (idxRxHeader-3)<LenRxHeader then begin
               p[idxRxHeader-2]:=zCh;
               RxCRC:=UpdCRC32(zCh,RxCRC);
             end;
         end;
         Inc(idxRxHeader);
         Result:=((idxRxHeader-3)>=LenRxHeader);
       end;
    ZHEX://begin
       //if (AnsiChar(ch) in ['0'..'9','a'..'f']) then begin
       if ((ch >= '0') and (ch <= '9')) or ((ch >= 'a') and (ch <= 'f')) then begin
       //OutputDebugString(PChar('Is Hex: '+IntToStr(idxRxHeader)));
       //prepare HEX digit
       b := (Byte(ch)-$30);
       if b > 9 then b := b - $27;
       if idxRxHeader = 4 then begin
         RxCRC := 0;
         LenRxHeader := 14;
         flRxCRC32 := False;
         p[idxRxHeader-3] := AnsiChar(b);
         Inc(idxRxHeader);
       end else begin
         if (idxRxHeader - 4) < LenRxHeader then begin
           if(idxRxHeader and 1) = 1 then begin
             b := (Byte(p[(idxRxHeader - 3) div 2])shl 4) + b;
             p[(idxRxHeader-3)div 2] := AnsiChar(b);
             RxCRC := UpdCRC(AnsiChar(b), RxCRC);
           end else p[(idxRxHeader-2)div 2] := AnsiChar(b);
           Inc(idxRxHeader);
         end;
         Result:=((idxRxHeader-4)>=LenRxHeader);
       end;
       end else begin
         idxRxHeader:=0;
         zRxHeader.FrameType:=#0;
       end;
    ZVBIN32,ZVBIN,ZVHEX:
     Logging(dlDebug,'zRxVBLOCK!!!');
  end;
  if Result then begin

    if flRxCRC32 then Result:=(RxCRC=$DEBB20E3)
                 else Result:=((RxCRC and $FFFF)=0);
    LoggingFmt(dlDetail,
    'zRxHdr: %.2X,%.2X [%.2X,%.2X,%.2X,%.2X] CRC=%.4X',
    [Byte(zRxHeader.FrameType),Byte(zRxHeader.CmdType),
     Byte(zRxHeader.F[0]),Byte(zRxHeader.F[1]),
     Byte(zRxHeader.F[2]),Byte(zRxHeader.F[3]),
     Byte(zRxHeader.CRC)]);

    if not Result then begin
      DoBadCRC;
      ClearRxHeader;
    end;
  end;
end;

procedure TnrZModem.IsBinBlock(Ch,zCh: Ansichar);
//var s:string;
//    i:integer;
begin
  if IdxRxBinBlock<ZMAXHLEN then begin
    flIgnoreCRC := True;
    if IsHeader(Ch,zCh) and (zRxHeader.CmdType = Char(ZEOF)) then begin
      zCloseFile;
      AnswerRInit(True);
      if not (zoIgnoreFileTime in fOptions) then UpdateFileTime;
      exit;
    end;
    flIgnoreCRC:=False;
  end;
  if not flSkipRxChar then begin

    if flRxCRC32 then RxBlckCRC := UpdCRC32(zCh,RxBlckCRC)
                 else RxBlckCRC := UpdCRC(zCh,RxBlckCRC);

    if flRxFrameEnd then begin
       Dec(IdxRxBinBlock);
       if IdxRxBinBlock = 0 then begin //BinBlock END -> Check CRC ...
         Logging(dlDebug,'zRxBinBlock');
         if flRxCRC32 then flRxFrameEnd := (RxBlckCRC = $DEBB20E3)
                      else flRxFrameEnd := ((RxBlckCRC and $FFFF) = 0);


         {if not flRxFrameEnd then begin
           s := '';
           for i := 0 to SizeRxBinBlock - 1
             do s := s + IntToHex(Byte(RxBinBlock[i]), 2) + ' ';
           Logging(dlDebug,'zRxBinBlock BAD CRC sz= ' + IntToStr(SizeRxBinBlock) + ' : ' + s);
         end;}

         if not flRxFrameEnd then DoBadCRC//Bad CRC !!!
                             else DoReceivedBinBlock;
        ClearRxHeader;
       end;

    end else begin
      if(Integer(zCh)in[ZCRCE,ZCRCG,ZCRCQ,ZCRCW])and
        (LastRxChar=ZDLE) then begin
           RxBinBlockType:=zCh;
           flRxFrameEnd:=True;
           SizeRxBinBlock:=IdxRxBinBlock;
           if flRxCRC32 then IdxRxBinBlock:=4
                        else IdxRxBinBlock:=2;
        end else begin
          RxBinBlock[IdxRxBinBlock]:=zCh;
          Inc(IdxRxBinBlock);
        end;
    end;
  end;
end;

procedure TnrZModem.DoTimeOut(Sender: TObject);
begin
  Inc(TimeOutCount);
  LoggingFmt(dlDetail,'Timeout!!! %u ms',[Timer.Interval]);
  if TimeOutCount>fTimeOutRetries then begin
    DoAbort(zeByTimeOut);
  end else begin
    if Assigned(OnTimeOut) then fOnTimeOut(Self);
    case zState of
      isWaitQInit:begin zState:=isWaitSession; Timer.Enabled:=False; end;
      isWaitZFile,isWaitFileName:AnswerRInit(False);
      isWaitRInit:AnswerBeginSession();
      isWaitEOFRInit:AnswerEOF();
      isWaitFin:if ModemState=msReceive then AnswerRInit(True)
                                        else AnswerFin();
      isWaitZData,isWaitBinBlock:AnswerRPos(FilePosition);
      isWaitRPos:AnswerZFile();
      else begin
        DoAbort(zeByUnknown);
      end;
    end;
  end;
end;

procedure TnrZModem.DoTimerSender(Sender: TObject);
var fl:boolean;
begin
  fl := False;
  timerSend.Enabled := fl;
  DoAfterSendComplete2(fl);
end;

//Scans the stream for a session begin sign
procedure TnrZModem.IsSession(ch : AnsiChar);
begin
  fModemState:=msListen;
  if CheckSequence(Ch,sqSessionHeader) then begin
    fEscapeChars:='';
    fEscCtrls := False;
    Logging(dlDetail,'Is Session Begin !!!');
    zState:=isWaitQInit;
    fModemState:=msReceive;
    SessionCaption:='';
    ClearRxHeader;
    RestartTimer;
  end;
end;

procedure TnrZModem.IsQInitHeader;
begin
  if zRxHeader.CmdType=Char(ZRQINIT) then begin
    if fModemState=msListen then fModemState:=msReceive;
    Logging(dlDetail,'Is QINIT !!!');
    flCommandMode:=(zRxHeader.F[ZF0]<>#0);
    if zoChallenge in fOptions then AnswerZChallenge
                               else AnswerRInit(False);
    RestartTimer();
  end;
end;

procedure TnrZModem.IsZFile;
begin
  if zRxHeader.CmdType=Char(ZFILE) then begin
    Logging(dlDetail,'Is ZFile !!!');
    fFileName:='';
    zState:=isWaitFileName;
    flResumePossible:=(zRxHeader.F[ZF0]=Char(ZCRESUM));
    RestartTimer;
  end else
  if zRxHeader.CmdType=Char(ZRQINIT) then IsQInitHeader
  else IsZFin;
end;

procedure TnrZModem.IsZData;
var fPos:integer;
begin
  if zRxHeader.CmdType=Char(ZDATA) then begin
    fPos:=Cardinal(Pointer(@zRxHeader.F)^);
    Logging(dlDetail,'Is ZDATA !!!');
    zState:=isWaitBinBlock;
    RestartTimer;
    if fPos<>FilePosition then begin
      DoAbort(zeByUnknown);
    end;
  end;
end;

procedure TnrZModem.IsZFin;
begin
  if ((zRxHeader.CmdType=Char(ZFIN))or
      (zRxHeader.CmdType=Char(ZEOF))) then begin
    Logging(dlDetail,'Is ZFIN !!!');
    zCloseFile;
    if fModemState=msReceive
      then AnswerFin
      else DoStringSend('OO');// Device.SendString('OO');
    zState:=isWaitSession;
    fModemState:=msListen;
    Timer.Enabled:=False;
  end else IsZFile;
end;

procedure TnrZModem.IsRInit;
begin
  Logging(dlDetail,'Is RINIT or Challenge !!!');
  if zRxHeader.CmdType=Char(ZRINIT) then begin
    Logging(dlDetail,'Is RINIT !!!');
    if(zState=isWaitEOFRInit)and(Assigned(fOnAfterFileSent))then begin
      zCloseFile;
      fOnAfterFileSent(Self,fFileName,True);
    end;
    if(zState=isWaitRInit)or(zState=isWaitRPos)or
      ((zState=isWaitEOFRInit)and(InFileList.Count>0))then begin
         if fEscCtrls
           then AnswerSInit
           else AnswerZFile;
    end else begin
      AnswerFin;
      flPacket:=False;
      if zoNotWaitFinal in fOptions then begin
        //Device.SendString('OO');
        DoStringSend('OO');
        zState:=isWaitSession;
        fModemState:=msListen;
        Timer.Enabled:=False;
      end else zState:=isWaitFin;
      zCloseFile;
    end;
    RestartTimer;
  end;
end;

procedure TnrZModem.IsZSinit;
begin
  Logging(dlDetail,'Is ZSINIT !!!');
  fEscCtrls := ((TESCCTL and Byte(zRxHeader.F[ZF0]))<>0);
  zState:=isWaitEscapeData;
  RestartTimer;
end;

procedure TnrZModem.IsChallenge;
var i:integer;
begin
  i:=Longint(Pointer(@zRxHeader.F[0])^);
  LoggingFmt(dlDetail,'Is CHALLENGE (%u)',[i]);
  AnswerZACK(i);
  zState:=isWaitRInit;
end;

procedure TnrZModem.IsRPos;
var l:longint;
begin
  if zRxHeader.CmdType=Char(ZRPOS) then begin
    Logging(dlDetail,'Is RPOS !!!');
    l:=Longint(Pointer(@zRxHeader.F[0])^);
    if not SetFilePosition(l) then begin
      DoFatalErrors(0,0,'Can''t to set a new file position ='+IntToStr(l));
      DoAbort(zeByMe);
      exit;
    end;
    AnswerZData(True);
    InFileList.Delete(0);
    zState:=isWaitInterrupt;
    Timer.Enabled:=False;
  end;
end;

procedure TnrZModem.IsInterrupt;
var l:integer;
    fl:boolean;
begin
  if Byte(zRxHeader.CmdType)=ZRPOS then begin
    LoggingFmt(dlDetail,'Interrupt RPOS [%u] !!!',[Longint(Pointer(@zRxHeader.F[0])^)]);
    flPacket:=False;
    if not SetFilePosition(Longint(Pointer(@zRxHeader.F[0])^)) then begin
      DoFatalErrors(0,0,'Can''t to set a new file position.');
      DoAbort(zeByMe);
      exit;
    end;
    //Device.ClearDeviceBuffers;
    if FilePosition<fFileSize then begin
      AnswerZData(False);
      zState:=isWaitZACK;
      l:=fFileSize-FilePosition;
      if l>=1024 then l:=1024;
      zReadFile(TxBinBlock,L);
      SendBinBlock(L,Char(ZCRCW),True);
      RestartTimer();
    end else AnswerEOF;
  end
  else
    if (zoSegmentTransfer in fOptions)and(Byte(zRxHeader.CmdType)=ZACK) then begin
      Logging(dlDebug,'Response ZACK');
      fl:=True;
      flPacket:=True;
      DoAfterSendComplete2(fl);
    end;
end;

procedure TnrZModem.IsZACK;
var i:integer;
begin
  if Byte(zRxHeader.CmdType)=ZACK then begin
    i:=Longint(Pointer(@zRxHeader.F[0])^);
    LoggingFmt(dlDetail,'Is ZACK (%u)',[i]);

    if zState = isWaitZACKAfterSInit
      then AnswerZFile
      else begin
        if (zoChallenge in fOptions)and (ChallengeNumber<>0)
          then begin
            //challenge answer was received ...
            if i<>ChallengeNumber
              then AnswerAbort
              else AnswerRInit(False);
          end else begin
            // file block repeated request ...
            SetFilePosition(i);
            AnswerZData(True);
            zState:=isWaitInterrupt;
            Timer.Enabled:=False;
          end;
      end;
  end;
end;

procedure TnrZModem.IsZSkip;
begin
  ClearRxHeader;
  zCloseFile;
  if(Assigned(fOnAfterFileSent))
     then fOnAfterFileSent(Self,fFileName,False);
  InFileList.Delete(0);   //???????????????????
  if(InFileList.Count>0)
    then AnswerZFile
    else begin
      AnswerFin;
      zState:=isWaitFin;
    end;
end;

procedure TnrZModem.AnswerRInit(flFin:boolean);
begin
  Logging(dlDetail,'Answer RINIT');
  ChallengeNumber:=0;
  zTxHeader.CmdType:=Char(ZRINIT);
  zTxHeader.F[ZF0]:=Char(CANFDX or CANOVIO);//#$23;//
  zTxHeader.F[ZF1]:=#0;
  zTxHeader.loF:=0;
  SendHexHeader;
  if flFin then begin
    zState:=isWaitFin;
  end else zState:=isWaitZFile;
end;

procedure TnrZModem.AnswerZChallenge;
begin
  ChallengeNumber:=Integer(Self);
  LoggingFmt(dlDetail,'nrZM: Answer CHALLENGE (%u)',[ChallengeNumber]);
  zTxHeader.CmdType:=Char(ZCHALLENGE);
  zTxHeader.dF:=ChallengeNumber;
  SendHexHeader;
  zState:=isWaitZACK;
end;

procedure TnrZModem.AnswerSkip;
begin
  Logging(dlDetail,'nrZM: Answer SKIP');
  zTxHeader.CmdType:=Char(ZSKIP);
  zTxHeader.dF:=0;
  SendHexHeader;
end;

procedure TnrZModem.AnswerRPos(Pos:cardinal);
begin
  LoggingFmt(dlDetail,'Answer RPOS [%d]',[Pos]);
  zTxHeader.CmdType:=Char(ZRPOS);
  zTxHeader.dF:=Pos;
  SendHexHeader;
  zState:=isWaitZData;
end;

procedure TnrZModem.AnswerZACK(N: cardinal);
begin
  LoggingFmt(dlDetail,'Answer ZACK [%d]',[N]);
  zTxHeader.CmdType:=Char(ZACK);
  zTxHeader.dF:=N;
  SendHexHeader;
  zState:=isWaitZData;
end;

procedure TnrZModem.AnswerZNAK;
begin
  Logging(dlDebug,'Answer ZNAK');
  zTxHeader.CmdType:=Char(ZNAK);
  zTxHeader.dF:=0;
  SendHexHeader;
end;

procedure TnrZModem.AnswerFin;
begin
  Logging(dlDetail,'Answer FIN');
  zTxHeader.CmdType:=Char(ZFIN);
  zTxHeader.dF:=0;
  SendHexHeader;
  if (fModemState=msReceive) and Assigned(fOnAfterFileReceived)
    then fOnAfterFileReceived(Self,fFileName);
  if Assigned(fOnSuccessfulEnd) then fOnSuccessfulEnd(Self);
end;

procedure TnrZModem.AnswerBeginSession;
begin
  flPacket:=False;
  Logging(dlDetail,'Answer Begin session ...');
  if not (zoWithoutRZ in fOptions)
     then DoStringSend('rz'#13);// Device.SendString('rz'#13);
  zTxHeader.CmdType:=Char(ZRQINIT);
  zTxHeader.dF:=0;
  SendHexHeader;

  fEscCtrls := (zoEscCtrls in fOptions);

  zState:=isWaitRInit;
  fEscapeChars:='+';
end;

procedure TnrZModem.AnswerSInit;
var s:string;
begin
  Logging(dlDetail,'Answer ZSINIT');
  zTxHeader.CmdType:=Char(ZSINIT);
  zTxHeader.dF:=0;
  SendHexHeader;
  s := ''#0;
  CopyMemory(@TxBinBlock[0],@s[1],1);
  SendBinBlock(ZATTNLEN,Char(ZCRCW),False);
  zState := isWaitZACKAfterSInit;
end;

procedure TnrZModem.AnswerZFile;
label next_file;
var s:AnsiString;
    ch:AnsiChar;
    fs:TSearchRec;
    i:integer;
begin
  flPacket := False;
next_file:
  fFileName := InFileList[0];
  fFileSize := Integer(InFileList.Objects[0]);
  if not zOpenFile(fFileName) then begin
    InFileList.Delete(0);
    s := AnsiString(fFileName);
    fFileName := '';
    DoFatalErrors(3,2,Format(sZError1,[s]));
    if InFileList.Count>0 then goto next_file
                          else begin AnswerFin; exit; end;
  end;

  ProgressBase:=ProgressBase+fFileSize;
  zTxHeader.CmdType := Char(ZFILE);
  if zoResuming in fOptions then ch := AnsiChar(ZCRESUM)
                            else ch := AnsiChar(ZCBIN);
  zTxHeader.dF:=0;
  zTxHeader.F[ZF0] := ch;
  SendBinHeader;
  if FindFirst(fFileName,faAnyFile{(faReadOnly+faHidden+faSysFile)},fs)<>0{i=Integer(INVALID_HANDLE_VALUE)} then begin
    LoggingFmt(dlDetail,'Find ERROR File [%s] not found',[s]);
    AnswerAbort;
    exit;
  end;

  try
    s := AnsiString(IntToOct(DateTimeToZModemTimeStamp(FileDateToDateTime(fs.Time))));
  except
    s:='0';
  end;

  s := AnsiString(Format('%s'#0'%d %s 0 0 %d %d'#0,[lowercase(ExtractFileName(fFileName)),
    fs.Size, s,InFileList.Count{+1},fTotalSize-ProgressBase+fFileSize]));

  LoggingFmt(dlDetail,'Answer ZFile [%s]',[s]);
  FindClose(fs);
  i := Length(s);
  CopyMemory(@TxBinBlock[0], @s[1], i);
  SendBinBlock(i,Char(ZCRCW),False);
  zState := isWaitRPos;
end;

procedure TnrZModem.AnswerZData(Start:boolean);
var fl:boolean;
begin
  LoggingFmt(dlDetail,'Answer ZData [Pos=%d]',[FilePosition]);
  zTxHeader.CmdType:=Char(ZDATA);
  zTxHeader.dF:=FilePosition;
  SendBinHeader;
  if Start then begin
    fl:=True;
    flPacket:=True;
    DoAfterSendComplete2(fl);
  end;
end;

procedure TnrZModem.AnswerEOF;
begin
  Logging(dlDetail,'Answer EOF');
  zTxHeader.CmdType:=Char(ZEOF);
  zTxHeader.dF:=FilePosition;
  SendBinHeader;
  zState:=isWaitEOFRInit;
  RestartTimer;
  //zCloseFile;
end;

procedure TnrZModem.AnswerAbort;
begin
  Timer.Enabled:=False;
  Logging(dlDetail,'Answer ABORT');
  //Device.SendData(cmdAbort,16);
  DoDataSend(cmdAbort,16);
  zState:=isWaitSession;
  fModemState:=msListen;
end;

procedure TnrZModem.DoAbort(ByIt:TzAbortType);
begin
  flPacket:=False;
  Timer.Enabled:=False;
  zCloseFile;
  if Assigned(Device) then begin
    //Device.ClearDeviceBuffers;
    if fModemState<>msListen //zState<>isWaitSession
      then AnswerAbort;
    if Assigned(fOnAbort) then fOnAbort(Self,ByIt);
  end else begin
    zState:=isWaitSession;
    fModemState:=msListen;
  end;
end;

procedure TnrZModem.DoBadCRC;
begin
  Inc(CountBadCRC);
  Logging(dlDetail,'Bad CRC!!!');
  if CountBadCRC>fErrorLimit then begin
    DoAbort(zeByBadCRC);
  end else begin
    ClearRxBinBlock;
    if Assigned(fOnCRCError) then fOnCRCError(Self);
    flSkipDataPacket:=True;
    if zState=isWaitBinBlock
      then AnswerRPos(FilePosition)
      else RepeatLastHeader;
  end;
end;

procedure TnrZModem.DoReceivedBinBlock;
begin
  case zState of
    isWaitFileName:DoFileName;
    isWaitEscapeData:DoEscapeData;
    else begin
      zWriteFile(RxBinBlock,SizeRxBinBlock);
      LoggingFmt(dlDebug,'DoReceivedBinBlock Type=%.2X pos=%u',[Byte(RxBinBlockType), fFilePosition]);
      if RxBinBlockType=Char(ZCRCW) then begin
        ClearRxHeader;
        AnswerZACK(FilePosition);
        zState:=isWaitBinBlock;
      end else begin
        ClearRxHeader;
      end;
      {$IFDEF NR_WITH_CONTROLS}
      if Assigned(fProgressBar) then fProgressBar.Position:=FilePosition;
      {$ENDIF}
      ClearRxBinBlock;
      RestartTimer;
      if Assigned(fOnProgress) then fOnProgress(Self);
    end;
  end;
end;

procedure TnrZModem.DoFileName;
label error_exit;
var flSkip:boolean;
    i,sz,fPos:integer;
    s,sd:String;
begin
  i:=0;
  fFileName:='';
  s:='';
  while(RxBinBlock[i] <> #0) and (i < SizeRxBinBlock)do begin
    s := s + Char(RxBinBlock[i]); //extract file name
    Inc(i);
  end;
  s := ExtractFilename(s);
  Inc(i);sz:=0;
  while(RxBinBlock[i]<>#0)and(RxBinBlock[i]<>' ')and(i<SizeRxBinBlock) do begin
    sz:=sz*10+(Byte(RxBinBlock[i])-$30);   //extract file size
    Inc(i);
  end;
  sd:='';
  Inc(i);
  while(RxBinBlock[i]<>#0)and(RxBinBlock[i]<>' ')and(i<SizeRxBinBlock) do begin
    sd := sd + Char(RxBinBlock[i]);   //extract file time
    Inc(i);
  end;
  if(sd<>'')and(sd<>'0')
    then CurrentFileTime:=ZModemTimeStampToDateTime(OctToInt(sd))
    else CurrentFileTime:=Now;
  fTotalSize:=sz;
  flSkip:=False;
  fDefaultPath:=Trim(fDefaultPath);
  i:=Length(fDefaultPath);
  if i>0 then
    if fDefaultPath[i]<>chPathSlash then fDefaultPath:=fDefaultPath+chPathSlash;
  s:=fDefaultPath+s; fFileSize:=sz;
  LoggingFmt(dlSimple,'Do file name=[%s] Sz=%d',[s,sz]);

  if Assigned(fOnBeforeReceived) then fOnBeforeReceived(Self, s, flSkip);
  if flSkip then begin
    fFileName:='';
    fFileSize:=0;
    AnswerSkip;
    zState:=isWaitZFile;
  end else begin
    if not zCreateFile(s) then begin
      fFileName:='';
      DoAbort(zeByMe);
      DoFatalErrors(3,3,Format(sZError3,[s]));
      exit;
    end;
    {$IFDEF NR_WITH_CONTROLS}
    fPos:=0;
    if Assigned(fProgressBar) then begin
      fProgressBar.Min:=0;
      fProgressBar.Max:=sz;
      fProgressBar.Position:=fPos;
    end;
    {$ENDIF}
    fPos:=fFileSize;
    AnswerRPos(fPos);
  end;
end;

procedure TnrZModem.DoEscapeData;
var i:integer;
begin
  fEscapeChars := '';
  for i:=0 to ZATTNLEN-1 do
    if RxBinBlock[i]<>#0
      then fEscapeChars := fEscapeChars + Char(RxBinBlock[i])
      else break;
  ClearRxHeader;
  AnswerZACK(0);
  zState:=isWaitZFile;
end;

procedure TnrZModem.Send(fName:string);
var FileFilters:TStringList;
    fs:TSearchRec;
    flNew:boolean;
    path:string;
label NextScan,ExitScan;
begin
  LoggingFmt(dlSimple,'SendFile %s',[fName]);

  if Assigned(fOnBeforeFileSend) then fOnBeforeFileSend(Self,fName,False);

  if not Active then begin
    DoFatalErrors(3,4,sZError4);
    exit;
  end;

  if (not Assigned(Device))and(not Assigned(OnDataSend)) then begin
    DoFatalErrors(3,9,sZError9);
    exit;
  end;

  if zoCheckConnection in fOptions then
    if Device is TnrComm then  TnrComm(Device).InitDeviceConnect;

  if ModemState=msReceive then begin
    DoFatalErrors(3,5,sZError2);
    exit;
  end;

  if zoSegmentTransfer in fOptions
    then fBlockEndChar:=Char(ZCRCW)
    else fBlockEndChar:=Char(ZCRCG);

  fName:=StringReplace(fName,',',#13#10,[rfReplaceAll]);
  fName:=StringReplace(fName,';',#13#10,[rfReplaceAll]);
  FileFilters:=TStringList.Create;
  FileFilters.Text:=fName;
  flNew:=True;
  fTotalSize:=0;
  InFileList.Clear;
  path:='';

NextScan:
  if flNew then begin //extract next filter from send string
    if FileFilters.Count=0 then goto ExitScan;
    path:=ExtractFilePath(FileFilters[0]);
    while FindFirst(FileFilters[0],faAnyFile{(faReadOnly+faHidden+faSysFile)},fs)<>0 do begin
      FileFilters.Delete(0);
      if FileFilters.Count=0 then goto ExitScan;
    end;
    flNew:=False;
  end else begin
    if FindNext(fs)<>0 then begin
      FindClose(fs);
      FileFilters.Delete(0);
      //fs.FindHandle:=0;
      flNew:=True;
      goto NextScan;
    end;
  end;
  fTotalSize:=fTotalSize+fs.Size;
  InFileList.AddObject(path+fs.Name{ FindData.cFileName},TObject(fs.Size));
  goto NextScan;

ExitScan:
  FileFilters.Free;

  if InFileList.Count>0 then begin
    fModemState:=msSend;
    AnswerBeginSession;
    RestartTimer;
    {$IFDEF NR_WITH_CONTROLS}
    if Assigned(fProgressBar) then begin
      fProgressBar.Min:=0;
      fProgressBar.Max:=fTotalSize;
      fProgressBar.Position:=0;
      ProgressBase:=0;
    end;
    {$ENDIF}
  end else DoFatalErrors(3,5,sZError10);
end;

procedure TnrZModem.Abort;
begin
  Logging(dlSimple,'Abort()');
  DoAbort(zeByMe);
end;

procedure TnrZModem.RepeatLastHeader;
begin
  {$IFDEF DEBUGSELF}
  ShowStatus('Is ZNAK -> Repeat Last Header');
  {$ENDIF}
  case zTxHeader.FrameType of
    ZBIN:SendBinHeader;
    ZHEX:SendHexHeader;
  end;
end;

procedure TnrZModem.UpdateFileTime;
{$IFNDEF LINUX}
var hF:cardinal;
{$ENDIF}
begin
  {$IFNDEF LINUX}
  hF:=FileOpen(fFileName,fmOpenWrite);
  FileSetDate(hF,DateTimeToFileDate(CurrentFileTime));
  FileClose(hF);
  {$ELSE}
  FileSetDate(FileName,DateTimeToFileDate(CurrentFileTime));
  {$ENDIF}
end;

procedure TnrZModem.DoMediumClosed;
begin
  if(fModemState<>msListen)then begin
    Logging(dlDetail,'Medium was closed');
    zState:=isWaitSession;
    fModemState:=msListen;
    flPacket:=False;
    DoAbort(zeByMedia);
  end;
end;

procedure TnrZModem.DoAfterSendComplete2(var flCascade: boolean);
var Len:integer;
    ch:AnsiChar;
begin
  if flPacket then begin
    Len:=0;
    while (Len<1024)and(FilePosition<fFileSize)do begin
      zReadFile(Ch,1);
      TxBinBlock[Len] := ch;
      Inc(Len);
    end;
    if FilePosition=fFileSize
      then ch := AnsiChar(ZCRCE)   // last block of file ...
      else ch := fBlockEndChar;// ordinary block of file {Char(ZCRCG)};
    LoggingFmt(dlDebug,'send %u',[FilePosition]);
    {$IFDEF NR_WITH_CONTROLS}
    if Assigned(fProgressBar)
       then fProgressBar.Position:=ProgressBase-fFileSize+FilePosition;
    {$ENDIF}
    flPacket:=False;
    if Len = 0
      then SendBinBlock(Len,ch,False)
      else begin
        if zoSegmentTransfer in fOptions
          then RestartTimer
          else flPacket := True;

        SendBinBlock(Len, ch, False);
        timerSend.Enabled := true;

      end;

    if Assigned(fOnProgress) then fOnProgress(Self);
    if Len=0 then AnswerEOF;
  end;

end;

function TnrZModem.GetAbortNoCarrier: boolean;
begin
  Result := fAbortNoCarrier;
end;

function TnrZModem.GetErrorLimit: cardinal;
begin
  Result := fErrorLimit;
end;

function TnrZModem.GetDefaultPath: string;
begin
  Result := fDefaultPath;
end;

function TnrZModem.GetOptions: TzModemOptions;
begin
  Result := fOptions;
end;

function TnrZModem.GetTimeOut: cardinal;
begin
  Result := fTimeOut;
end;

function TnrZModem.GetTimeOutRetries: cardinal;
begin
  Result := fTimeOutRetries;
end;

function TnrZModem.GetOnAbort: TZAbortEvent;
begin
  Result := fOnAbort;
end;

function TnrZModem.GetOnAfterFileReceived: TFileReceivedEvent;
begin
  Result := fOnAfterFileReceived;
end;

function TnrZModem.GetOnAfterFileSent: TFileSentEvent;
begin
  Result := fOnAfterFileSent;
end;

function TnrZModem.GetOnBeforeFileSend: TFileSentEvent;
begin
  Result := fOnBeforeFileSend;
end;

function TnrZModem.GetOnBeforeReceived: TFileNameReceivedEvent;
begin
  Result := fOnBeforeReceived;
end;

function TnrZModem.GetOnCRCError: TNotifyEvent;
begin
  Result := fOnCRCError;
end;

function TnrZModem.GetOnProgress: TNotifyEvent;
begin
  Result := fOnProgress;
end;

function TnrZModem.GetOnSuccessfulEnd: TNotifyEvent;
begin
  Result := fOnSuccessfulEnd;
end;

function TnrZModem.GetOnTimeOut: TNotifyEvent;
begin
  Result := fOnTimeOut;
end;

procedure TnrZModem.SetAbortNoCarrier(const Value: boolean);
begin
  fAbortNoCarrier:=Value;
end;

procedure TnrZModem.SetDefaultPath(const Value: string);
begin
  fDefaultPath:=Value;
end;

procedure TnrZModem.SetErrorLimit(const Value: cardinal);
begin
  fErrorLimit:=Value;
end;

procedure TnrZModem.SetOnAbort(const Value: TZAbortEvent);
begin
  fOnAbort:=Value;
end;

procedure TnrZModem.SetOnAfterFileReceived(
  const Value: TFileReceivedEvent);
begin
  fOnAfterFileReceived:=Value;
end;

procedure TnrZModem.SetOnAfterFileSent(const Value: TFileSentEvent);
begin
  fOnAfterFileSent:=Value;
end;

procedure TnrZModem.SetOnBeforeFileSend(const Value: TFileSentEvent);
begin
  fOnBeforeFileSend:=Value;
end;

procedure TnrZModem.SetOnBeforeReceived(
  const Value: TFileNameReceivedEvent);
begin
  fOnBeforeReceived:=Value;
end;

procedure TnrZModem.SetOnCRCError(const Value: TNotifyEvent);
begin
  fOnCRCError:=Value;
end;

procedure TnrZModem.SetOnProgress(const Value: TNotifyEvent);
begin
  fOnProgress:=Value;
end;

procedure TnrZModem.SetOnSuccessfulEnd(const Value: TNotifyEvent);
begin
  fOnSuccessfulEnd:=Value;
end;

procedure TnrZModem.SetOnTimeOut(const Value: TNotifyEvent);
begin
  fOnTimeOut :=Value;
end;

procedure TnrZModem.SetOptions(const Value: TzModemOptions);
begin
  fOptions:=Value;
end;

procedure TnrZModem.SetTimeOut(const Value: cardinal);
begin
  fTimeOut:=Value;
end;

procedure TnrZModem.SetTimeOutRetries(const Value: cardinal);
begin
  fTimeOutRetries:=Value;
end;

function TnrZModem.GetZChar(ch: AnsiChar): AnsiString;
begin
  case Ch of
     ZDLE, #$11, #$13, #$91, #$93, #$10, #$90:
       Result := AnsiChar(ZDLE) + AnsiChar(Byte(Ch) xor $40);
     #$FF: if fEscCtrls
              then Result := ZDLE + Char(ZRUB1)
              else Result := Ch;
     else begin
       if ((Byte(Ch)and $60)=0) and fEscCtrls
         then Result := AnsiChar(ZDLE) + AnsiChar(Byte(Ch)xor $40)
         else Result := ch;
     end;
  end;
end;

end.


