awxmodem.pas

Async Professional 4.04

{*********************************************************}
{*                   AWXMODEM.PAS 4.04                   *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}
{*      Thanks to David Hudder for his substantial       *}
{*  contributions to improve efficiency and reliability  *}
{*********************************************************}

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

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

unit AwXmodem;
  {-Provides Xmodem/Crc/1K receive and transmit functions}

interface

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

{Constructors/destructors}
function xpInit(var P : PProtocolData; H : TApdCustomComPort;          
                UseCRC, Use1K, UseGMode : Boolean;
                Options : Cardinal) : Integer;
procedure xpDone(var P : PProtocolData);

procedure xpReinit(P : PProtocolData; UseCRC, Use1K, UseGMode : Boolean);

{Options}
function xpSetCRCMode(P : PProtocolData; Enable : Boolean) : Integer;
function xpSet1KMode(P : PProtocolData; Enable : Boolean) : Integer;
function xpSetGMode(P : PProtocolData; Enable : Boolean) : Integer;
function xpSetBlockWait(P : PProtocolData; NewBlockWait : Cardinal) : Integer;
function xpSetXmodemFinishWait(P : PProtocolData; NewFinishWait : Cardinal) : Integer;

{Control}
procedure xpPrepareTransmit(P : PProtocolData);
procedure xpPrepareReceive(P : PProtocolData);
function xpTransmitPrim(Msg, wParam : Cardinal; lParam : LongInt) : LongInt;
procedure xpTransmit(Msg, wParam : Cardinal; lParam : LongInt);
function xpReceivePrim(Msg, wParam : Cardinal; lParam : LongInt) : LongInt;
procedure xpReceive(Msg, wParam : Cardinal; lParam : LongInt);

{Internal (but used by AWYMODEM)}
function xpPrepHandshake(P : PProtocolData) : Boolean;
function xpProcessHandshake(P : PProtocolData) : Boolean;
procedure xpTransmitBlock(P : PProtocolData; var Block : TDataBlock;
                          BLen : Cardinal; BType : Char);
procedure xpReceiveBlock(P : PProtocolData; var Block : TDataBlock;
                         var BlockSize : Cardinal; var HandShake : Char);
function xpProcessBlockReply(P : PProtocolData) : Boolean;
function xpCollectBlock(P : PProtocolData; var Block : TDataBlock) : Boolean;
function xpGetHandshakeChar(P : PProtocolData) : Char;
procedure xpSendHandshakeChar(P : PProtocolData; Handshake : Char);
function xpCheckForBlockStart(P : PProtocolData; var C : Char) : Boolean;
function xpProcessBlockStart(P : PProtocolData; C : Char) : TProcessBlockStart;

procedure xpCancel(P : PProtocolData);

const
  {Compile-time constants}
  DrainWait = 1092;              {OutBuf drain time before error (60 sec)}
  XmodemOverhead = 5;            {Overhead bytes for each block}
  XmodemTurnDelay = 1000;        {MSec turnaround delay for each block}

  {Mode request characters}
  GReq   = 'G';
  CrcReq = 'C';
  ChkReq = cNak;

implementation

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

const
  {Compile-time constants}
  DefBlockWait = 91;             {Normal between-block wait time (5 sec)}
  MaxCrcTry = 3;                 {Max tries for Crc before trying checksum}
  DefMaxBlockErrors = 5;         {Default maximum acceptable errors per block}
  aDataTrigger = 0;
const
  LogXModemState : array[TXmodemState] of TDispatchSubType = (
     dsttxInitial, dsttxHandshake, dsttxGetBlock, dsttxWaitFreeSpace,
     dsttxSendBlock, dsttxDraining, dsttxReplyPending,
     dsttxEndDrain, dsttxFirstEndOfTransmit, dsttxRestEndOfTransmit,
     dsttxEotReply, dsttxFinished, dsttxDone,
     dstrxInitial, dstrxWaitForHSReply, dstrxWaitForBlockStart,
     dstrxCollectBlock, dstrxProcessBlock,  dstrxFinishedSkip,
     dstrxFinished, dstrxDone);                                      

  function IsXYProtocol(Protocol : Byte) : Boolean;
    {-Return True if this is an Xmodem or Ymodem protocol}
  begin
    case Protocol of
      Xmodem, XmodemCRC, Xmodem1K, Xmodem1KG,
      Ymodem, YmodemG :
        IsXYProtocol := True;
      else
        IsXYProtocol := False;
    end;
  end;

  function IsXProtocol(Protocol : Byte) : Boolean;
    {-Return True if this is an Xmodem protocol}
  begin
    case Protocol of
      Xmodem, XmodemCRC, Xmodem1K, Xmodem1KG :
        IsXProtocol := True;
      else
        IsXProtocol := False;
    end;
  end;

  function GetProtocolType(CRC, OneK, G, Y : Boolean) : Cardinal;
    {-Return the protocol type}
  const
    KType : array[Boolean] of Cardinal = (Xmodem1K, Ymodem);
    GType : array[Boolean] of Cardinal = (Xmodem1KG, YmodemG);
  begin
    if not CRC then
      GetProtocolType := Xmodem
    else if not OneK then
      GetProtocolType := XmodemCRC
    else if not G then
      GetProtocolType := KType[Y]
    else
      GetProtocolType := GType[Y];
  end;

  procedure xpInitData(P : PProtocolData; UseCRC, Use1K, UseGMode : Boolean);
    {-Allocates and initializes a protocol control block with options}
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
  begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
    with P^ do begin
      {Set modes...}
      aCurProtocol := Xmodem;
      xpSetCRCMode(P, UseCRC);
      xpSet1KMode(P, Use1K);
      xpSetGMode(P, UseGMode);

      {Miscellaneous inits}
      xEotCheckCount := 1;
      xBlockWait := DefBlockWait;
      xMaxBlockErrors := DefMaxBlockErrors;
      aOverhead := XmodemOverhead;
      aTurnDelay := XmodemTurnDelay;
      aFinishWait := 0;

      {Set read/write hooks}
      apResetReadWriteHooks(P);
    end;
  end;

  function xpInit(var P : PProtocolData; H : TApdCustomComPort;       
                  UseCRC, Use1K, UseGMode : Boolean;
                  Options : Cardinal) : Integer;
    {-Allocates and initializes a protocol control block with options}
  var
    InSize, OutSize : Cardinal;
  begin
    {Check for adequate output buffer size}
    H.ValidDispatcher.BufferSizes(InSize, OutSize);
    if (OutSize < (1024 + XmodemOverhead)) then begin
      xpInit := ecOutputBufferTooSmall;
      Exit;
    end;

    {Init standard data}
    if apInitProtocolData(P, H, Options) <> ecOk then begin
      xpInit := ecOutOfMemory;
      Exit;
    end;

    {Can't fail after this}
    xpInit := ecOK;
    xpInitData(P, UseCRC, Use1K, UseGMode);
  end;

  procedure xpReinit(P : PProtocolData; UseCRC, Use1K, UseGMode : Boolean);
    {-Allocates and initializes a protocol control block with options}
  begin
    xpInitData(P, UseCRC, Use1K, UseGMode);
  end;

  procedure xpDone(var P : PProtocolData);
    {-Disposes of P}
  begin
    apDoneProtocol(P);
  end;

  function xpSetCRCMode(P : PProtocolData; Enable : Boolean) : Integer;
    {-Enable/disable CRC mode}
  var
    Y : Bool;
  begin
    with P^ do begin
      {Check protocol type}
      Y := False;
      case aCurProtocol of
        Xmodem, XmodemCRC   :
          ;
        Xmodem1K, Xmodem1KG :
          Enable := True;
        Ymodem, YmodemG     :
          begin
            Y := True;
            Enable := True;
          end;
        else begin
          xpSetCRCMode := ecBadProtocolFunction;
          Exit;
        end;
      end;

      {Ok now}
      xpSetCRCMode := ecOK;

      {Set check type}
      xCRCMode := Enable;
      if xCRCMode then
        aCheckType := bcCrc16
      else
        aCheckType := bcChecksum1;

      {Set the protocol type}
      aCurProtocol := GetProtocolType(xCRCMode, x1KMode, xGMode, Y);
    end;
  end;

  function xpSet1KMode(P : PProtocolData; Enable : Boolean) : Integer;
    {-Enable/disable Xmodem1K}
  var
    Y : Bool;
  begin
    with P^ do begin
      {Check the protocol type}
      case aCurProtocol of
        Xmodem, Xmodem1K, Xmodem1KG, XmodemCRC :
          Y := False;
        Ymodem, YmodemG :
          Y := True;
        else begin
          xpSet1KMode := ecBadProtocolFunction;
          Exit;
        end;
      end;

      {Ok now}
      xpSet1KMode := ecOK;

      {Turn 1K mode on or off}
      x1KMode := Enable;
      if x1KMode then begin
        aBlockLen := 1024;
        xStartChar := cStx;
        xCRCMode := True;
      end else begin
        aBlockLen := 128;
        xStartChar := cSoh;
      end;

      {Set the protocol type}
      aCurProtocol := GetProtocolType(xCRCMode, x1KMode, xGMode, Y);
    end;
  end;

  function xpSetGMode(P : PProtocolData; Enable : Boolean) : Integer;
    {-Enable/disable streaming}
  var
    Y : Bool;
  begin
    with P^ do begin
      {Check the protocol type}
      case aCurProtocol of
        Xmodem, Xmodem1K, Xmodem1KG, XmodemCRC :
          Y := False;
        Ymodem, YmodemG :
          Y := True;
        else begin
          xpSetGMode := ecBadProtocolFunction;
          Exit;
        end;
      end;

      {Ok now}
      xpSetGMode := ecOK;

      {Turn G mode on or off}
      xGMode := Enable;
      if xGMode then begin
        {Force 1K mode if entering G mode}
        xpSet1KMode(P, True);
        aTurnDelay := 0;
        xEotCheckCount := 0;
      end else begin
        aTurnDelay := XmodemTurnDelay;
        xEotCheckCount := 1;
        xMaxBlockErrors := DefMaxBlockErrors;
      end;

      {Set the protocol type}
      aCurProtocol := GetProtocolType(xCRCMode, x1KMode, xGMode, Y);
    end;
  end;

  function xpSetBlockWait(P : PProtocolData; NewBlockWait : Cardinal) : Integer;
    {-Set inter-block wait time}
  begin
    with P^ do begin
      if not IsXYProtocol(aCurProtocol) then
        xpSetBlockWait := ecBadProtocolFunction
      else begin
        xpSetBlockWait := ecOK;
        xBlockWait := NewBlockWait;
      end;
    end;
  end;

  function xpSetXmodemFinishWait(P : PProtocolData;
                                 NewFinishWait : Cardinal) : Integer;
    {-Set additional finish wait (time to wait for EOT response)}
  begin
    with P^ do begin
      if IsXYProtocol(aCurProtocol) then
        xpSetXmodemFinishWait := ecBadProtocolFunction
      else begin
        xpSetXmodemFinishWait := ecOK;
        aFinishWait := NewFinishWait;
      end;
    end;
  end;

  function xpPrepHandshake(P : PProtocolData) : Boolean;
    {-Prepare to wait for a handshake char, return False if too many errors}
  begin
    with P^ do begin
      Inc(aHandshakeAttempt);
      if aHandshakeAttempt > aHandshakeRetry then begin
        xpPrepHandshake := False;
        apProtocolError(P, ecTimeout);
      end else begin
        aHC.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
        xpPrepHandshake := True;
        if aHandshakeAttempt <> 1 then begin
          Inc(aBlockErrors);
          Inc(aTotalErrors);
          aForceStatus := True;
        end;
      end;
    end;
  end;

  procedure xpCancel(P : PProtocolData);
    {-Sends cancel request to remote}
  const
    CanStr : array[0..6] of Char = cCan+cCan+cCan+cBS+cBS+cBS;
  begin
    with P^ do begin
      if aHC.Open then begin                                           
        {Flush anything that might be left in the output buffer}
        aHC.FlushOutBuffer;

        {Cancel with three CANCEL chars}
        aHC.PutBlock(CanStr, StrLen(CanStr));
      end;                                                             
      aForceStatus := True;
    end;
  end;

  function xpGetHandshakeChar(P : PProtocolData) : Char;
    {-Returns proper handshake character}
  begin