awzmodem.pas

Async Professional 4.04

{*********************************************************}
{*                   AWZMODEM.PAS 4.04                   *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$Q-,V-,I-,B-,F+,A-,X+}

unit AwZmodem;
  {-Provides Zmodem receive and transmit functions}

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  MMSystem,
  OoMisc,
  AwUser,
  AwTPcl,
  AwAbsPcl,
  AdPort;   


const
  {Compile-time constants}
  MaxAttentionLen = 32;           {Maximum length of attention string}
  MaxHandshakeWait = 1092;        {Ticks to wait for first hdr (60 secs)}
  MaxBadBlocks = 20;              {Quit if this many bad blocks}
  DefReceiveTimeout = 364;        {Default Ticks for received data (20 secs)}
  DrainingStatusInterval  = 18;   {Default status interval for draining eof}
  DefFinishWaitZM = 364;          {Wait time for ZFins, 30 secs}
  DefFinishRetry = 3;             {Retry ZFin 3 times}

  {For estimating protocol transfer times}
  ZmodemTurnDelay = 0;            {Millisecond turnaround delay}
  ZmodemOverHead  = 20;           {Default overhead for each data subpacket}

  {For checking max block sizes}
  ZMaxBlock : Array[Boolean] of Cardinal = (1024, 8192);
  ZMaxWork  : Array[Boolean] of Cardinal = (2048, 16384);

  {Zmodem constants}
  ZPad       = '*';                  {Pad}
  ZDle       = cCan;                 {Data link escape}
  ZBin       = 'A';                  {Binary header using Crc16}
  ZHex       = 'B';                  {Hex header using Crc16}
  ZBin32     = 'C';                  {Binary header using Crc32}

  {Zmodem frame types}
  ZrQinit    = #0;                   {Request init (to receiver)}
  ZrInit     = #1;                   {Init (to sender)}
  ZsInit     = #2;                   {Init (to receiver) (optional)}
  ZAck       = #3;                   {Acknowledge last frame}
  ZFile      = #4;                   {File info frame (to receiver)}
  ZSkip      = #5;                   {Skip to next file (to receiver)}
  ZNak       = #6;                   {Error receiving last data subpacket}
  ZAbort     = #7;                   {Abort protocol}
  ZFin       = #8;                   {Finished protocol}
  ZRpos      = #9;                   {Resume from this file position}
  ZData      = #10;                  {Data subpacket(s) follows}
  ZEof       = #11;                  {End of current file}
  ZFerr      = #12;                  {Error reading or writing file}
  ZCrc       = #13;                  {Request for file CRC (to receiver)}
  ZChallenge = #14;                  {Challenge the sender}
  ZCompl     = #15;                  {Complete}
  ZCan       = #16;                  {Cancel requested (to either)}
  ZFreeCnt   = #17;                  {Request diskfree}
  ZCommand   = #18;                  {Execute this command (to receiver)}

{Constructors/destructors}
function zpInit(var P : PProtocolData; H : TApdCustomComPort;         
                Options : Cardinal) : Integer;
procedure zpDone(var P : PProtocolData);

function zpReinit(P : PProtocolData) : Integer;
procedure zpDonePart(P : PProtocolData);

{Options}
function zpSetFileMgmtOptions(P : PProtocolData;
                              Override, SkipNoFile : Bool;
                              FOpt : Byte) : Integer;
function zpSetRecoverOption(P : PProtocolData; OnOff : Bool) : Integer;
function zpSetBigSubpacketOption(P : PProtocolData;
                                 UseBig : Bool) : Integer;
function zpSetZmodemFinishWait(P : PProtocolData;
                               NewWait : Cardinal;
                               NewRetry : Byte) : Integer;

{Control}
procedure zpPrepareTransmit(P : PProtocolData);
procedure zpPrepareReceive(P : PProtocolData);
procedure zpTransmit(Msg, wParam : Cardinal; lParam : LongInt);
procedure zpReceive(Msg, wParam : Cardinal; lParam : LongInt);

implementation

{$IFDEF TRIALRUN}
  {$I TRIAL07.INC}
  {$I TRIAL03.INC}
  {$I TRIAL01.INC}
{$ENDIF}

const
  {For various hex char manipulations}
  HexDigits : array[0..15] of Char = '0123456789abcdef';

  {For initializing block check values}
  CheckInit : array[Boolean] of Integer = (0, -1);

  {For manipulating file management masks}
  FileMgmtMask = $07;              {Isolate file mgmnt values}
  FileSkipMask = $80;              {Skip file if dest doesn't exist}

  {Only supported conversion option}
  FileRecover = $03;               {Resume interrupted file transfer}

  {Data subpacket terminators}
  ZCrcE      = 'h';                {End  - last data subpacket of file}
  ZCrcG      = 'i';                {Go   - no response necessary}
  ZCrcQ      = 'j';                {Ack  - requests ZACK or ZRPOS}
  ZCrcW      = 'k';                {Wait - sender waits for answer}

  {Translate these escaped sequences}
  ZRub0      = 'l';                {Translate to $7F}
  ZRub1      = 'm';                {Translate to $FF}

  {Byte offsets for pos/flag bytes}
  ZF0 = 3;                         {Flag byte 3}
  ZF1 = 2;                         {Flag byte 2}
  ZF2 = 1;                         {Flag byte 1}
  ZF3 = 0;                         {Flag byte 0}
  ZP0 = 0;                         {Position byte 0}
  ZP1 = 1;                         {Position byte 1}
  ZP2 = 2;                         {Position byte 1}
  ZP3 = 3;                         {Position byte 1}

  {Bit masks for ZrInit}
  CanFdx  = $0001;           {Can handle full-duplex}
  CanOvIO = $0002;           {Can do disk and serial I/O overlaps}
  CanBrk  = $0004;           {Can send a break}
  CanCry  = $0008;           {Can encrypt/decrypt, not supported}
  CanLzw  = $0010;           {Can LZ compress, not supported}
  CanFc32 = $0020;           {Can use 32 bit CRC}
  EscAll  = $0040;           {Escapes all control chars, not supported}
  Esc8    = $0080;           {Escapes the 8th bit, not supported}

  {Bit masks for ZsInit}
  TESCtl  = $0040;           {Sender asks for escaped ctl chars, not supported}
  TESC8   = $0080;           {Sender asks for escaped hi bits, not supported}

  {Character constants}
  cDleHi  = Char(Ord(cDle) + $80);
  cXonHi  = Char(Ord(cXon) + $80);
  cXoffHi = Char(Ord(cXoff) + $80);

  aDataTrigger = 0;

  LogZModemState : array[TZmodemState] of TDispatchSubType = (        
     dsttzInitial, dsttzHandshake, dsttzGetFile, dsttzSendFile,
     dsttzCheckFile, dsttzStartData, dsttzEscapeData, dsttzSendData,
     dsttzWaitAck, dsttzSendEof, dsttzDrainEof, dsttzCheckEof,
     dsttzSendFinish, dsttzCheckFinish, dsttzError, dsttzCleanup,
     dsttzDone,
     dstrzRqstFile, dstrzDelay, dstrzWaitFile, dstrzCollectFile,
     dstrzSendInit, dstrzSendBlockPrep, dstrzSendBlock, dstrzSync,
     dstrzStartFile, dstrzStartData, dstrzCollectData, dstrzGotData,
     dstrzWaitEof, dstrzEndOfFile, dstrzSendFinish, dstrzCollectFinish,
     dstrzError, dstrzWaitCancel, dstrzCleanup, dstrzDone);


  procedure zpPrepareWriting(P : PProtocolData);
    {-Prepare to save protocol blocks (usually opens a file)}
  var
    FileExists     : Bool;
    FileSkip       : Bool;
    Result         : Cardinal;
    FileLen        : LongInt;
    FileDate       : LongInt;
    SeekPoint      : LongInt;
    FileStartOfs   : LongInt;
    YMTSrcFileDate : LongInt;                                        
    FileOpt        : Byte;

    procedure ErrorCleanup;
    begin
      with P^ do begin
        Close(aWorkFile);
        if IOResult <> 0 then ;
        FreeMem(aFileBuffer, FileBufferSize);
      end;
    end;

    { Allows a 1 sec fudge to compensate for FAT timestamp rounding }
    function YMStampEqual(YMStamp1, YMStamp2 : LongInt) : Boolean;
    begin
      Result := abs(YMStamp1 - YMStamp2) <= 1;
    end;

    { Allows a 1 sec fudge to compensate for FAT timestamp rounding }
    function YMStampLessOrEqual(YMStamp1, YMStamp2 : LongInt) : Boolean;
    begin
      Result := YMStampEqual(YMStamp1, YMStamp2) or (YMStamp1 < YMStamp2);
    end;

  begin
    with P^ do begin
      aProtocolError := ecOK;
      {Allocate a file buffer}
      aFileBuffer := AllocMem(FileBufferSize);

      {Set file mgmt options}
      FileSkip := (zFileMgmtOpts and FileSkipMask) <> 0;
      FileOpt := zFileMgmtOpts and FileMgmtMask;

      {Check for a local request for file recovery}
      if zReceiverRecover then
        zConvertOpts := zConvertOpts or FileRecover;

      {Does the file exist already?}
      aSaveMode := FileMode;
      FileMode := 0;                                               
      Assign(aWorkFile, aPathName);
      Reset(aWorkFile, 1);
      Result := IOResult;
      FileMode := aSaveMode;

      {Exit on errors other than FileNotFound}
      if (Result <> 0) and (Result <> 2) then begin
        apProtocolError(P, -Result);
        ErrorCleanup;
        Exit;
      end;

      {Note if file exists, its size and timestamp}
      FileExists := (Result = 0);
      if FileExists then begin
        FileLen := FileSize(aWorkFile);
        FileDate := FileGetDate(TFileRec(aWorkFile).Handle);
        FileDate := apPackToYMTimeStamp(FileDate);
      end else begin
        FileLen := 0;
        FileDate := 0;
      end;
      Close(aWorkFile);
      if IOResult = 0 then ;

      {If recovering, skip all file managment checks and go append file}
      if FileExists and
         (aSrcFileLen > FileLen) and
         ((zConvertOpts and FileRecover) = FileRecover) then begin
        SeekPoint := FileLen;
        FileStartOfs := FileLen;
        aInitFilePos := FileLen;
      end else begin
        {Tell status we're not recovering}
        aInitFilePos := 0;

        {Check for skip condition}
        if FileSkip and not FileExists then begin
          aProtocolStatus := psFileDoesntExist;
          ErrorCleanup;
          Exit;
        end;

        {Process the file management options}
        SeekPoint := 0;
        FileStartOfs := 0;
        case FileOpt of
          zfWriteNewerLonger : {Transfer only if new, newer or longer}
            if FileExists then begin
              YMTSrcFileDate := apPackToYMTimeStamp(aSrcFileDate);
              if YMStampLessOrEqual(YMTSrcFileDate, FileDate) and   
                 (aSrcFileLen <= FileLen) then begin
                aProtocolStatus := psCantWriteFile;
                ErrorCleanup;
                Exit;
              end;
            end;
          zfWriteAppend :      {Transfer regardless, append if exists}
            if FileExists then
              SeekPoint := FileLen;
          zfWriteClobber :     {Transfer regardless, overwrite} ;
            {Nothing to do, this is the normal behavior}
          zfWriteDifferent :   {Transfer only if new, size diff, or dates diff}
            if FileExists then begin
              YMTSrcFileDate := apPackToYMTimeStamp(aSrcFileDate);
              if YMStampEqual(YMTSrcFileDate, FileDate) and            
                 (aSrcFileLen = FileLen) then begin
                aProtocolStatus := psCantWriteFile;
                ErrorCleanup;
                Exit;
              end;
            end;
          zfWriteProtect :     {Transfer only if dest file doesn't exist}
            if FileExists then begin
              aProtocolStatus := psCantWriteFile;
              ErrorCleanup;
              Exit;
            end;
          zfWriteCrc,          {Not supported, treat as WriteNewer}
          zfWriteNewer :       {Transfer only if new or newer}
            if FileExists then begin
              YMTSrcFileDate := apPackToYMTimeStamp(aSrcFileDate);
              if YMStampLessOrEqual(YMTSrcFileDate, FileDate) then   
              begin
                aProtocolStatus := psCantWriteFile;
                ErrorCleanup;
                Exit;
              end;
            end;
        end;
      end;

      {Rewrite or append to file}
      Assign(aWorkFile, aPathname);
      if SeekPoint = 0 then begin
        {New or overwriting destination file}
        Rewrite(aWorkFile, 1);
      end else begin
        {Appending to file}
        Reset(aWorkFile, 1);
        Seek(aWorkFile, SeekPoint);
      end;
      Result := IOResult;
      if Result <> 0 then begin
        apProtocolError(P, -Result);
        ErrorCleanup;
        Exit;
      end;

      {Initialized the buffer management vars}
      aFileOfs := FileStartOfs;
      aStartOfs := FileStartOfs;
      aLastOfs := FileStartOfs;
      aEndOfs := aStartOfs + FileBufferSize;
      aFileOpen := True;
    end;
  end;

  procedure zpFinishWriting(P : PProtocolData);
    {-Cleans up after saving all protocol blocks}
  var
    BytesToWrite : Integer;
    BytesWritten : Integer;
    Result       : Cardinal;
  begin
    with P^ do begin
      if aFileOpen then begin
        {Error or end-of-file, commit buffer}
        BytesToWrite := aFileOfs - aStartOfs;
        BlockWrite(aWorkFile, aFileBuffer^, BytesToWrite, BytesWritten);
        Result := IOResult;
        if (Result <> 0) then
          apProtocolError(P, -Result);
        if (BytesToWrite <> BytesWritten) then
          apProtocolError(P, ecDiskFull);

        {Set the timestamp to that of the source file}
        if aProtocolError = ecOK then begin
          FileSetDate(TFileRec(aWorkFile).Handle, aSrcFileDate);     
        end;

        {Clean up}
        Close(aWorkFile);
        if IOResult <> 0 then ;
        FreeMem(aFileBuffer, FileBufferSize);
        aFileOpen := False;
      end;
    end;
  end;

  procedure zpDeallocBuffers(P : PProtocolData);
    {-Release block and work buffers}
  begin