{*********************************************************}
{*                  ADPROTCL.PAS 3.00                    *}
{*       Copyright (c) TurboPower Software 1996-2000     *}
{*                 All rights reserved.                  *}
{*********************************************************}

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

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

{$IFDEF Win32}
{$J+}
{$ENDIF}

{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

unit AdProtcl;
  {-File transfer protocol VCL component}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  Classes,
  Messages,
  Controls,
  Graphics,
  Forms,
  OoMisc,
  AwUser,
  AwTPcl,
  AwAbsPcl,
  AwXmodem,
  AwYmodem,
  AwZmodem,
  AwKermit,
  AwBPlus,
  AwAscii,
  AdExcept,
{$IFDEF TRIALRUN}
  {$I TRIAL08.INC}
{$ENDIF}
  AdPort;

type
  {Block check methods - NOTE! this must match OOMISC}
  TBlockCheckMethod = (
    bcmNone,
    bcmChecksum,
    bcmChecksum2,
    bcmCrc16,
    bcmCrc32,
    bcmCrcK);

  {Protocol types - NOTE! this must match OOMISC}
  TProtocolType = (
    ptNoProtocol,
    ptXmodem,
    ptXmodemCRC,
    ptXmodem1K,
    ptXmodem1KG,
    ptYmodem,
    ptYmodemG,
    ptZmodem,
    ptZmodem8K,
    ptKermit,
    ptAscii,
    ptBPlus);

  {Zmodem file management options - NOTE! this must match OOMISC}
  TZmodemFileOptions = (
    zfoNoOption,           {Place holder}
    zfoWriteNewerLonger,   {Transfer if new, newer or longer}
    zfoWriteCrc,           {Not supported, same as WriteNewer}
    zfoWriteAppend,        {Transfer if new, append if exists}
    zfoWriteClobber,       {Transfer regardless}
    zfoWriteNewer,         {Transfer if new or newer}
    zfoWriteDifferent,     {Transfer if new or diff dates/lens}
    zfoWriteProtect);      {Transfer only if new}

  {Action to take if incoming file exists - NOTE! this must match OOMISC}
  TWriteFailAction = (
    wfWriteNone,         {No option set yet}
    wfWriteFail,         {Fail the open attempt}
    wfWriteRename,       {Rename the incoming file}
    wfWriteAnyway,       {Overwrite the existing file}
    wfWriteResume);      {Resume an interrupted receive}

  {ASCII end-of-line translations}
  TAsciiEOLTranslation = (
    aetNone,             {No CR/LF translations}
    aetStrip,            {Strip CRs or LFs}
    aetAddCRBefore,      {Add CR before each LF}
    aetAddLFAfter);      {Add LF after each CR}

  {DeleteFailed options for TApdProtocolLog}
  TDeleteFailed = (dfNever, dfAlways, dfNonRecoverable);

const
  {Defaults for TApdProtocol properties}
  awpDefProtocolType         = ptZmodem;
  awpDefXYmodemBlockWait     = 91;
  awpDefZmodemOptionOverride = False;
  awpDefZmodemSkipNoFile     = False;
  awpDefZmodemFileOption     = zfoWriteNewer;
  awpDefZmodemRecover        = False;
  awpDefZmodem8K             = False;
  awpDefZmodemZRQINITValue   = 0;
  awpDefZmodemFinishRetry    = 0;
  awpDefKermitMaxLen         = 80;
  awpDefKermitMaxWindows     = 0;
  awpDefKermitSWCTurnDelay   = 0;
  awpDefKermitTimeoutSecs    = 5;
  awpDefKermitPadCharacter   = ' ';
  awpDefKermitPadCount       = 0;
  awpDefKermitTerminator     = #13;
  awpDefKermitCtlPrefix      = '#';
  awpDefKermitHighbitPrefix  = 'Y';
  awpDefKermitRepeatPrefix   = '~';
  awpDefAsciiCharDelay       = 0;
  awpDefAsciiLineDelay       = 0;
  awpDefAsciiEOLChar         = #13;
  awpDefAsciiCRTranslation   = aetNone;
  awpDefAsciiLFTranslation   = aetNone;
  awpDefAsciiEOFTimeout      = 364;      {20 seconds}
  awpDefHonorDirectory       = False;
  awpDefIncludeDirectory     = False;
  awpDefRTSLowForWrite       = False;
  awpDefAbortNoCarrier       = False;
  awpDefBP2KTransmit         = False;
  awpDefAsciiSuppressCtrlZ   = False;
  awpDefFinishWait           = 364;
  awpDefTurnDelay            = 0;
  awpDefOverhead             = 0;
  awpDefWriteFailAction      = wfWriteRename;
  awpDefStatusInterval       = 18;
  awpDefUpcaseFileNames      = True;

  {Defaults for TApdProtocolLog properties}
  awpDefHistoryName       = 'APRO.HIS';
  awpDefDeleteFailed      = dfNonRecoverable;

  MaxKermitLongLen     = 1024;
  MaxKermitWindows     = 27;

  {Status options}
  apFirstCall          = OoMisc.apFirstCall;
  apLastCall           = OoMisc.apLastCall;

  {General protocol status constants}
  psOK                 = OoMisc.psOK;
  psProtocolHandshake  = OoMisc.psProtocolHandshake;
  psInvalidDate        = OoMisc.psInvalidDate;
  psFileRejected       = OoMisc.psFileRejected;
  psFileRenamed        = OoMisc.psFileRenamed;
  psSkipFile           = OoMisc.psSkipFile;
  psFileDoesntExist    = OoMisc.psFileDoesntExist;
  psCantWriteFile      = OoMisc.psCantWriteFile;
  psTimeout            = OoMisc.psTimeout;
  psBlockCheckError    = OoMisc.psBlockCheckError;
  psLongPacket         = OoMisc.psLongPacket;
  psDuplicateBlock     = OoMisc.psDuplicateBlock;
  psProtocolError      = OoMisc.psProtocolError;
  psCancelRequested    = OoMisc.psCancelRequested;
  psEndFile            = OoMisc.psEndFile;
  psResumeBad          = OoMisc.psResumeBad;
  psSequenceError      = OoMisc.psSequenceError;
  psAbortNoCarrier     = OoMisc.psAbortNoCarrier;

  {Specific to certain protocols}
  psGotCrcE            = OoMisc.psGotCrcE;
  psGotCrcG            = OoMisc.psGotCrcG;
  psGotCrcW            = OoMisc.psGotCrcW;
  psGotCrcQ            = OoMisc.psGotCrcQ;
  psTryResume          = OoMisc.psTryResume;
  psHostResume         = OoMisc.psHostResume;
  psWaitAck            = OoMisc.psWaitAck;

  {For specifying log file calls}
  lfReceiveStart       = OoMisc.lfReceiveStart;
  lfReceiveOk          = OoMisc.lfReceiveOk;
  lfReceiveFail        = OoMisc.lfReceiveFail;
  lfReceiveSkip        = OoMisc.lfReceiveSkip;
  lfTransmitStart      = OoMisc.lfTransmitStart;
  lfTransmitOk         = OoMisc.lfTransmitOk;
  lfTransmitFail       = OoMisc.lfTransmitFail;
  lfTransmitSkip       = OoMisc.lfTransmitSkip;

type
  TApdAbstractStatus = class;
  TApdProtocolLog = class;

  {$IFNDEF AProBCB}
  {For passing strings in event handlers}
  TPassString = String[255];
  {$ENDIF}

  {Protocol event handlers}
  TProtocolErrorEvent    = procedure(CP : TObject; ErrorCode : Integer)
                           of object;
  TProtocolFinishEvent   = procedure(CP : TObject; ErrorCode : Integer)
                           of object;
  TProtocolLogEvent      = procedure(CP : TObject; Log : Word)
                           of object;
  TProtocolResumeEvent   = procedure(CP : TObject;
                                     var Resume : TWriteFailAction)
                           of object;
  TProtocolStatusEvent   = procedure(CP : TObject; Options : Word)
                           of object;

  {$IFDEF Prot16OpenStrings}
  TProtocolNextFileEvent = procedure(CP : TObject; var FName : String)
                           of object;
  TProtocolAcceptEvent   = procedure(CP : TObject;
                                     var Accept : Boolean;
                                     var FName : String) of object;
  {$ELSE}
  TProtocolNextFileEvent = procedure(CP : TObject; var FName : TPassString)
                           of object;
  TProtocolAcceptEvent   = procedure(CP : TObject;
                                     var Accept : Boolean;
                                     var FName : TPassString) of object;
  {$ENDIF}

  {Protocol component}
  TApdCustomProtocol = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    {Private data}
    NeedBPS           : Boolean;         {True if we don't know BPS yet}
    ProtFunc          : TProtocolFunc;   {Current protocol function}
    Force             : Boolean;         {True to force setting options}

    {Property data}
    FMsgHandler       : HWnd;            {Window handler of MessageHandler}
    FComPort          : TApdCustomComPort; {Comport to use}
    FProtocolType     : TProtocolType;   {Current protocol}
    FStatusDisplay    : TApdAbstractStatus; {Built-in status display}
    FProtocolLog      : TApdProtocolLog; {Built-in protocol logging function}
    FXYmodemBlockWait : Cardinal;            {Inter-block delay in ticks}
    FZmodemOptionOverride : Boolean;     {True to override transmitter options}
    FZmodemSkipNoFile : Boolean;         {True to skip new incoming files}
    FZmodemFileOption : TZmodemFileOptions; {File mgmt options}
    FZmodemRecover    : Boolean;         {True to enable crash recovery}
    FZmodem8K         : Boolean;         {True to enable 8K zmodem}
    FZmodemZRQINITValue : LongInt;       {Optional ZRQINIT data}
    FZmodemFinishRetry : Cardinal;           {Number of ZFin retries}
    FKermitMaxLen     : Cardinal;            {Max normal packet len}
    FKermitMaxWindows : Cardinal;            {Maximum number of windows}
    FKermitSWCTurnDelay : Cardinal;          {Turn delay when SWC in use}
    FKermitTimeoutSecs : Cardinal;           {Packet timeout in seconds}
    FKermitPadCharacter : Char;          {Pad character}
    FKermitPadCount   : Cardinal;            {Padding count}
    FKermitTerminator : Char;            {Packet terminator character (ASCII)}
    FKermitCtlPrefix  : Char;            {Control char prefix (ASCII value)}
    FKermitHighbitPrefix : Char;         {Hibit prefix (ASCII value)}
    FKermitRepeatPrefix : Char;          {Repeat prefix (ASCII value)}
    FAsciiCharDelay   : Cardinal;            {Inter-character delay}
    FAsciiLineDelay   : Cardinal;            {Inter-line delay}
    FAsciiEOLChar     : Char;            {End-of-line character (ASCII value)}
    FAsciiCRTranslation : TAsciiEOLTranslation; {ASCII translate CR}
    FAsciiLFTranslation : TAsciiEOLTranslation; {ASCII translate LF}
    FAsciiEOFTimeout  : Cardinal;            {Ticks to assume EOF}

    {Events}
    FOnProtocolAccept   : TProtocolAcceptEvent;
    FOnProtocolError    : TProtocolErrorEvent;
    FOnProtocolFinish   : TProtocolFinishEvent;
    FOnProtocolLog      : TProtocolLogEvent;
    FOnProtocolNextFile : TProtocolNextFileEvent;
    FOnProtocolResume   : TProtocolResumeEvent;
    FOnProtocolStatus   : TProtocolStatusEvent;

    procedure CreateMessageHandler;
    procedure CheckPort;

  protected
    {Misc protected methods}
    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;

    {Property methods}
    procedure SetComPort(const NewComPort : TApdCustomComPort);
    procedure SetProtocolType(const NewProtocol : TProtocolType);
    function GetDestinationDirectory : String;
    procedure SetDestinationDirectory(const NewDir : String);
    function GetFileMask : TFileName;
    procedure SetFileMask(const NewFileMask : TFileName);
    function GetBatch : Boolean;
    function GetBlockCheckMethod : TBlockCheckMethod;
    procedure SetBlockCheckMethod(const NewMethod : TBlockCheckMethod);
    function GetHandshakeRetry : Cardinal;
    procedure SetHandshakeRetry(const NewRetry : Cardinal);
    function GetHandshakeWait : Cardinal;
    procedure SetHandshakeWait(const NewWait : Cardinal);
    function GetBlockLength : Cardinal;
    function GetBlockNumber : Cardinal;
    function GetTransmitTimeout : Cardinal;
    procedure SetTransmitTimeout(const NewTimeout : Cardinal);
    function GetFinishWait : Cardinal;
    procedure SetFinishWait(const NewWait : Cardinal);
    function GetActualBPS : LongInt;
    procedure SetActualBPS(const NewBPS : Longint);
    function GetTurnDelay : Cardinal;
    procedure SetTurnDelay(const NewDelay : Cardinal);
    function GetOverhead : Cardinal;
    procedure SetOverhead(const NewOverhead : Cardinal);
    function GetWriteFailAction : TWriteFailAction;
    procedure SetWriteFailAction(const NewAction : TWriteFailAction);
    function GetProtocolStatus : Cardinal;
    function GetProtocolError : SmallInt;
    function GetFileLength : LongInt;
    function GetFileDate : TDateTime;
    function GetInitialPosition : LongInt;
    function GetStatusInterval : Cardinal;
    procedure SetStatusInterval(const NewInterval : Cardinal);
    procedure SetStatusDisplay(const NewDisplay : TApdAbstractStatus);
    procedure SetProtocolLog(const NewLog : TApdProtocolLog);
    function GetInProgress : Boolean;
    function GetBlockErrors : Cardinal;
    function GetTotalErrors : Cardinal;
    function GetBytesRemaining : LongInt;
    function GetBytesTransferred : LongInt;
    function GetElapsedTicks : LongInt;
    function GetFileName : String;
    procedure SetFileName(const NewName : String);
    function GetXYmodemBlockWait : Cardinal;
    procedure SetXYmodemBlockWait(const NewWait : Cardinal);
    function GetZmodemOptionOverride : Boolean;
    procedure SetZmodemOptionOverride(const NewOverride : Boolean);
    function GetZmodemSkipNoFile : Boolean;
    procedure SetZmodemSkipNoFile(const NewSkip : Boolean);
    function GetZmodemFileOption : TZmodemFileOptions;
    procedure SetZmodemFileOption(const NewOpt : TZmodemFileOptions);
    function GetZmodemRecover : Boolean;
    procedure SetZmodemRecover(const NewRecover : Boolean);
    function GetZmodem8K : Boolean;
    procedure SetZmodem8K(const New8K : Boolean);
    function GetZmodemZRQINITValue : LongInt;
    procedure SetZmodemZRQINITValue(const NewZRQINITValue : LongInt);
    function GetZmodemFinishRetry : Cardinal;
    procedure SetZmodemFinishRetry(const NewRetry : Cardinal);
    function GetKermitMaxLen : Cardinal;
    procedure SetKermitMaxLen(const NewLen : Cardinal);
    function GetKermitMaxWindows : Cardinal;
    procedure SetKermitMaxWindows(const NewMax : Cardinal);
    function GetKermitSWCTurnDelay : Cardinal;
    procedure SetKermitSWCTurnDelay(const NewDelay : Cardinal);
    function GetKermitTimeoutSecs : Cardinal;
    procedure SetKermitTimeoutSecs(const NewTimeout : Cardinal);
    function GetKermitPadCharacter : Char;
    procedure SetKermitPadCharacter(NewChar : Char);
    function GetKermitPadCount : Cardinal;
    procedure SetKermitPadCount(NewCount : Cardinal);
    function GetKermitTerminator : Char;
    procedure SetKermitTerminator(const NewTerminator : Char);
    function GetKermitCtlPrefix : Char;
    procedure SetKermitCtlPrefix(const NewPrefix : Char);
    function GetKermitHighbitPrefix : Char;
    procedure SetKermitHighbitPrefix(const NewPrefix : Char);
    function GetKermitRepeatPrefix : Char;
    procedure SetKermitRepeatPrefix(const NewPrefix : Char);
    function GetKermitWindowsTotal : Cardinal;
    function GetKermitWindowsUsed : Cardinal;
    function GetKermitLongBlocks : Boolean;
    function GetAsciiCharDelay : Cardinal;
    procedure SetAsciiCharDelay(const NewDelay : Cardinal);
    function GetAsciiLineDelay : Cardinal;
    procedure SetAsciiLineDelay(const NewDelay : Cardinal);
    function GetAsciiEOLChar : Char;
    procedure SetAsciiEOLChar(const NewChar : Char);
    function GetAsciiCRTranslation : TAsciiEOLTranslation;
    procedure SetAsciiCRTranslation(const NewTrans : TAsciiEOLTranslation);
    function GetAsciiLFTranslation : TAsciiEOLTranslation;
    procedure SetAsciiLFTranslation(const NewTrans : TAsciiEOLTranslation);
    function GetAsciiEOFTimeout : Cardinal;
    procedure SetAsciiEOFTimeout(const NewTimeout : Cardinal);
    function GetHonorDirectory : Boolean;
    procedure SetHonorDirectory(const NewOpt : Boolean);
    function GetIncludeDirectory : Boolean;
    procedure SetIncludeDirectory(const NewOpt : Boolean);
    function GetRTSLowForWrite : Boolean;
    procedure SetRTSLowForWrite(const NewOpt : Boolean);
    function GetAbortNoCarrier : Boolean;
    procedure SetAbortNoCarrier(const NewOpt : Boolean);
    function GetBP2KTransmit : Boolean;
    procedure SetBP2KTransmit(const NewOpt : Boolean);
    function GetAsciiSuppressCtrlZ : Boolean;
    procedure SetAsciiSuppressCtrlZ(const NewOpt : Boolean);
    function GetUpcaseFileNames : Boolean;
    procedure SetUpcaseFileNames(NewUpcase : Boolean);

    {Protocol event methods}
    procedure apwProtocolAccept(CP : TObject; var Accept : Boolean;
                                var FName : TPassString); virtual;
    procedure apwProtocolError(CP : TObject; ErrorCode : Integer); virtual;
    procedure apwProtocolFinish(CP : TObject; ErrorCode : Integer); virtual;
    procedure apwProtocolLog(CP : TObject; Log : Cardinal); virtual;
    procedure apwProtocolNextFile(CP : TObject; var FName : TPassString); virtual;
    procedure apwProtocolResume(CP : TObject;
                                var Resume : TWriteFailAction); virtual;
    procedure apwProtocolStatus(CP : TObject; Options : Cardinal); virtual;

  public
    PData             : PProtocolData;   {Protocol data}

    constructor Create(AOwner : TComponent); override;
      {-Create a TApdProtocol component}
    destructor Destroy; override;
      {-Destroy a TApdProtocol component}
    procedure Assign(Source : TPersistent); override;
      {-Assign fields from TApdProtocol object specified by Source}
    {.Z-}
    function EstimateTransferSecs(const Size : Longint) : Longint;
      {-Return the number of seconds to transmit Size bytes}
    function StatusMsg(const Status : Cardinal) : String;
      {-Return a status message for Status}
    procedure StartTransmit;
      {-Start a background transmit session}
    procedure StartReceive;
      {-Start a background receive session}
    procedure CancelProtocol;
      {-Cancel the background protocol session}

    {B+ methods}
    procedure ProcessENQ;
      {-Process the <ENQ> character for a B+ protocol}
    procedure ProcessESCI(const X, Y : Byte);
      {-Process the <ESC>I sequence for a B+ protocol}
    procedure PrepareProcessDLE(var ATimerIndex : Cardinal);
      {-Prepare to process a <DLE> sequence for a B+ protocol}
    procedure ProcessDLE(const IsData : Boolean;
                         var Ready, Start, Upload : Boolean);
      {-Process a <DLE> sequence for a B+ protocol}

    {General properties}
    property ComPort : TApdCustomComPort
      read FComPort write SetComPort;

    {General protocol control properties}
    property ProtocolType : TProtocolType
      read FProtocolType write SetProtocolType;
    property DestinationDirectory : String
      read GetDestinationDirectory write SetDestinationDirectory;
    property FileMask : TFileName
      read GetFileMask write SetFileMask;
    property BlockCheckMethod : TBlockCheckMethod
      read GetBlockCheckMethod write SetBlockCheckMethod;
    property HandshakeRetry : Cardinal
      read GetHandshakeRetry write SetHandshakeRetry default awpDefHandshakeRetry;
    property HandshakeWait : Cardinal
      read GetHandshakeWait write SetHandshakeWait default awpDefHandshakeWait;
    property TransmitTimeout : Cardinal
      read GetTransmitTimeout write SetTransmitTimeout default awpDefTransTimeout;
    property FinishWait : Cardinal
      read GetFinishWait write SetFinishWait default awpDefFinishWait;
    property ActualBPS : Longint
      read GetActualBPS write SetActualBPS;
    property TurnDelay : Cardinal
      read GetTurnDelay write SetTurnDelay default awpDefTurnDelay;
    property Overhead : Cardinal
      read GetOverhead write SetOverhead default awpDefOverhead;
    property WriteFailAction : TWriteFailAction
      read GetWriteFailAction write SetWriteFailAction
      default awpDefWriteFailAction;

    {Option properties}
    property HonorDirectory : Boolean
      read GetHonorDirectory write SetHonorDirectory
      default awpDefHonorDirectory;
    property IncludeDirectory : Boolean
      read GetIncludeDirectory write SetIncludeDirectory
      default awpDefIncludeDirectory;
    property RTSLowForWrite : Boolean
      read GetRTSLowForWrite write SetRTSLowForWrite
      default awpDefRTSLowForWrite;
    property AbortNoCarrier : Boolean
      read GetAbortNoCarrier write SetAbortNoCarrier
      default awpDefAbortNoCarrier;
    property BP2KTransmit : Boolean
      read GetBP2KTransmit write SetBP2KTransmit
      default awpDefBP2KTransmit;
    property AsciiSuppressCtrlZ : Boolean
      read GetAsciiSuppressCtrlZ write SetAsciiSuppressCtrlZ
      default awpDefAsciiSuppressCtrlZ;
    property UpcaseFileNames : Boolean
      read GetUpcaseFileNames write SetUpcaseFileNames
      default awpDefUpcaseFileNames;

    {Read only properties}
    property Batch : Boolean
      read GetBatch;
    property BlockLength : Cardinal
      read GetBlockLength;
    property BlockNumber : Cardinal
      read GetBlockNumber;
    property ProtocolStatus : Cardinal
      read GetProtocolStatus;
    property ProtocolError : SmallInt
      read GetProtocolError;
    property FileLength : LongInt
      read GetFileLength;
    property FileDate : TDateTime
      read GetFileDate;
    property InitialPosition : LongInt
      read GetInitialPosition;

    {Status properties}
    property StatusDisplay : TApdAbstractStatus
      read FStatusDisplay write SetStatusDisplay;
    property ProtocolLog : TApdProtocolLog
      read FProtocolLog write SetProtocolLog;
    property StatusInterval : Cardinal
      read GetStatusInterval write SetStatusInterval default awpDefStatusInterval;
    property InProgress : Boolean
      read GetInProgress;
    property BlockErrors : Cardinal
      read GetBlockErrors;
    property TotalErrors : Cardinal
      read GetTotalErrors;
    property BytesRemaining : LongInt
      read GetBytesRemaining;
    property BytesTransferred : LongInt
      read GetBytesTransferred;
    property ElapsedTicks : LongInt
      read GetElapsedTicks;
    property FileName : String
      read GetFileName write SetFileName;

    {Xmodem/Ymodem properties}
    property XYmodemBlockWait : Cardinal
      read GetXYmodemBlockWait write SetXYmodemBlockWait
      default awpDefXYmodemBlockWait;

    {Zmodem properties}
    property ZmodemOptionOverride : Boolean
      read GetZmodemOptionOverride write SetZmodemOptionOverride
      default awpDefZmodemOptionOverride;
    property ZmodemSkipNoFile : Boolean
      read GetZmodemSkipNoFile write SetZmodemSkipNoFile
      default awpDefZmodemSkipNoFile;
    property ZmodemFileOption : TZmodemFileOptions
      read GetZmodemFileOption write SetZmodemFileOption
      default awpDefZmodemFileOption;
    property ZmodemRecover : Boolean
      read GetZmodemRecover write SetZmodemRecover default awpDefZmodemRecover;
    property Zmodem8K : Boolean
      read GetZmodem8K write SetZmodem8K default awpDefZmodem8K;
    property ZmodemZRQINITValue : LongInt
      read GetZmodemZRQINITValue write SetZmodemZRQINITValue
      default awpDefZmodemZRQINITValue;
    property ZmodemFinishRetry : Cardinal
      read GetZmodemFinishRetry write SetZmodemFinishRetry
      default awpDefZmodemFinishRetry;

    {Kermit properties}
    property KermitMaxLen : Cardinal
      read GetKermitMaxLen write setKermitMaxLen
      default awpDefKermitMaxLen;
    property KermitMaxWindows : Cardinal
      read GetKermitMaxWindows write SetKermitMaxWindows
      default awpDefKermitMaxWindows;
    property KermitSWCTurnDelay : Cardinal
      read GetKermitSWCTurnDelay write SetKermitSWCTurnDelay
      default awpDefKermitSWCTurnDelay;
    property KermitTimeoutSecs : Cardinal
      read GetKermitTimeoutSecs write SetKermitTimeoutSecs
      default awpDefKermitTimeoutSecs;
    property KermitPadCharacter : Char
      read GetKermitPadCharacter write SetKermitPadCharacter
      default awpDefKermitPadCharacter;
    property KermitPadCount : Cardinal
      read GetKermitPadCount write SetKermitPadCount
      default awpDefKermitPadCount;
    property KermitTerminator : Char
      read GetKermitTerminator write SetKermitTerminator
      default awpDefKermitTerminator;
    property KermitCtlPrefix : Char
      read GetKermitCtlPrefix write SetKermitCtlPrefix
      default awpDefKermitCtlPrefix;
    property KermitHighbitPrefix : Char
      read GetKermitHighbitPrefix write SetKermitHighbitPrefix
      default awpDefKermitHighbitPrefix;
    property KermitRepeatPrefix : Char
      read GetKermitRepeatPrefix write SetKermitRepeatPrefix
      default awpDefKermitRepeatPrefix;
    property KermitWindowsTotal : Cardinal
      read GetKermitWindowsTotal;
    property KermitWindowsUsed : Cardinal
      read GetKermitWindowsUsed;
    property KermitLongBlocks : Boolean
      read GetKermitLongBlocks;
    property AsciiCharDelay : Cardinal
      read GetAsciiCharDelay write SetAsciiCharDelay
      default awpDefAsciiCharDelay;
    property AsciiLineDelay : Cardinal
      read GetAsciiLineDelay write SetAsciiLineDelay
      default awpDefAsciiLineDelay;
    property AsciiEOLChar : Char
      read GetAsciiEOLChar write SetAsciiEOLChar
      default awpDefAsciiEOLChar;
    property AsciiCRTranslation : TAsciiEOLTranslation
      read GetAsciiCRTranslation write SetAsciiCRTranslation
      default awpDefAsciiCRTranslation;
    property AsciiLFTranslation : TAsciiEOLTranslation
      read GetAsciiLFTranslation write SetAsciiLFTranslation
      default awpDefAsciiLFTranslation;
    property AsciiEOFTimeout : Cardinal
      read GetAsciiEOFTimeout write SetAsciiEOFTimeout
      default awpDefAsciiEOFTimeout;

    {Protocol events}
    property OnProtocolAccept : TProtocolAcceptEvent
      read FOnProtocolAccept write FOnProtocolAccept;
    property OnProtocolError : TProtocolErrorEvent
      read FOnProtocolError write FOnProtocolError;
    property OnProtocolFinish : TProtocolFinishEvent
      read FOnProtocolFinish write FOnProtocolFinish;
    property OnProtocolLog : TProtocolLogEvent
      read FOnProtocolLog write FOnProtocolLog;
    property OnProtocolNextFile : TProtocolNextFileEvent
      read FOnProtocolNextFile write FOnProtocolNextFile;
    property OnProtocolResume : TProtocolResumeEvent
      read FOnProtocolResume write FOnProtocolResume;
    property OnProtocolStatus : TProtocolStatusEvent
      read FOnProtocolStatus write FOnProtocolStatus;
  end;

  {Abstract protocol status class}
  TApdAbstractStatus = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    FDisplay         : TForm;
    FPosition        : TPosition;
    FCtl3D           : Boolean;
    FVisible         : Boolean;
    FCaption         : TCaption;

    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;

  protected
    FProtocol        : TApdCustomProtocol;

    procedure SetPosition(const NewPosition : TPosition);
    procedure SetCtl3D(const NewCtl3D : Boolean);
    procedure SetVisible(const NewVisible : Boolean);
    procedure SetCaption(const NewCaption : TCaption);
    procedure GetProperties;
    procedure Show;

  public
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdAbstractStatus component}
    destructor Destroy; override;
      {-Destroy a TApdAbstractStatus component}
    {.Z-}
    procedure UpdateDisplay(First, Last : Boolean); virtual; abstract;
      {-Update the status display with current data}
    procedure CreateDisplay; dynamic; abstract;
      {-Create the status display}
    procedure DestroyDisplay; dynamic; abstract;
      {-Destroy the status display}

    property Display : TForm
      read FDisplay write FDisplay;

  published
    property Position : TPosition
      read FPosition write SetPosition;
    property Ctl3D : Boolean
      read FCtl3D write SetCtl3D;
    property Visible : Boolean
      read FVisible write SetVisible;
    property Protocol : TApdCustomProtocol
      read FProtocol write FProtocol;
    property Caption : TCaption
      read FCaption write SetCaption;
  end;

  {Builtin log procedure}
  TApdProtocolLog = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    FDeleteFailed  : TDeleteFailed;
    FHistoryName   : String;
    FProtocol      : TApdCustomProtocol;

    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;

  public
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdProtocolLog component}
    {.Z-}
    procedure UpdateLog(const Log : Cardinal); virtual;
      {-Add a log entry}

  published
    property Protocol : TApdCustomProtocol
      read FProtocol write FProtocol;
    property DeleteFailed : TDeleteFailed
      read FDeleteFailed write FDeleteFailed default awpDefDeleteFailed;
    property HistoryName : String
      read FHistoryName write FHistoryName;
  end;

  {Protocol component}
  TApdProtocol = class(TApdCustomProtocol)
  published
    property ComPort;
    property ProtocolType;
    property DestinationDirectory;
    property FileMask;
    property BlockCheckMethod;
    property HandshakeRetry;
    property HandshakeWait;
    property TransmitTimeout;
    property FinishWait;
    property TurnDelay;
    property Overhead;
    property WriteFailAction;
    property HonorDirectory;
    property IncludeDirectory;
    property RTSLowForWrite;
    property AbortNoCarrier;
    property BP2KTransmit;
    property AsciiSuppressCtrlZ;
    property StatusDisplay;
    property ProtocolLog;
    property StatusInterval;
    property FileName;
    property XYmodemBlockWait;
    property ZmodemOptionOverride;
    property ZmodemSkipNoFile;
    property ZmodemFileOption;
    property ZmodemRecover;
    property Zmodem8K;
    property ZmodemFinishRetry;
    property KermitMaxLen;
    property KermitMaxWindows;
    property KermitSWCTurnDelay;
    property KermitTimeoutSecs;
    property KermitPadCharacter;
    property KermitPadCount;
    property KermitTerminator;
    property KermitCtlPrefix;
    property KermitHighbitPrefix;
    property KermitRepeatPrefix;
    property AsciiCharDelay;
    property AsciiLineDelay;
    property AsciiEOLChar;
    property AsciiCRTranslation;
    property AsciiLFTranslation;
    property AsciiEOFTimeout;
    property UpcaseFileNames;
    property OnProtocolAccept;
    property OnProtocolError;
    property OnProtocolFinish;
    property OnProtocolLog;
    property OnProtocolNextFile;
    property OnProtocolResume;
    property OnProtocolStatus;
  end;

  {.Z+}
  {A list of active TApdProtocol objects}
  PProtocolWindowNode = ^TProtocolWindowNode;
  TProtocolWindowNode = record
    pwWindow   : TApdHwnd;
    pwProtocol : TApdCustomProtocol;
  end;

  {Miscellaneous functions}
  function CheckNameString(const Check : TBlockCheckMethod) : String;
  function FormatMinSec(const TotalSecs : LongInt) : String;
  {.Z-}
  function ProtocolName(const ProtocolType : TProtocolType) : String;

  {Component registration procedure}

implementation

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

const
  FileSkipMask = $80;   {Skip file if dest doesn't exist}
  FileRecover  = $03;   {Resume interrupted file transfer}

const
  {Table of protocol preparation procedures}
  PrepProcs : array[ptNoProtocol..ptBPlus, Boolean] of TPrepareProc = (
    (nil, nil),                               {NoProtocol}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem}
    (xpPrepareReceive, xpPrepareTransmit),    {XmodemCRC}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem1K}
    (xpPrepareReceive, xpPrepareTransmit),    {Xmodem1KG}
    (ypPrepareReceive, ypPrepareTransmit),    {Ymodem}
    (ypPrepareReceive, ypPrepareTransmit),    {YmodemG}
    (zpPrepareReceive, zpPrepareTransmit),    {Zmodem}
    (zpPrepareReceive, zpPrepareTransmit),    {Zmodem8K}
    (kpPrepareReceive, kpPrepareTransmit),    {Kermit}
    (spPrepareReceive, spPrepareTransmit),    {Ascii}
    (bpPrepareReceive, bpPrepareTransmit));   {B+}

  {Table of protocol functions}
  ProtFuncs : array[ptNoProtocol..ptBPlus, Boolean] of TProtocolFunc = (
    (nil, nil),                   {NoProtocol}
    (xpReceive, xpTransmit),      {Xmodem}
    (xpReceive, xpTransmit),      {XmodemCRC}
    (xpReceive, xpTransmit),      {Xmodem1K}
    (xpReceive, xpTransmit),      {Xmodem1KG}
    (ypReceive, ypTransmit),      {Ymodem}
    (ypReceive, ypTransmit),      {YmodemG}
    (zpReceive, zpTransmit),      {Zmodem}
    (zpReceive, zpTransmit),      {Zmodem8K}
    (kpReceive, kpTransmit),      {Kermit}
    (spReceive, spTransmit),      {Ascii}
    (bpReceive, bpTransmit));     {B+}

var
  ProtList : TList;

{General purpose routines}

  function LeftPad(const S : String; Len : Byte) : String;
    {-Return a string left-padded to length len}
  var
    o : String;
    SLen : Byte;
  begin
    SLen := Length(S);
    if SLen >= Len then
      LeftPad := S
    else if SLen < 255 then begin
      {$IFDEF Win32}
      SetLength(o, Len);
      {$ELSE}
      o[0] := Chr(Len);
      {$ENDIF}
      Move(S[1], o[Succ(Cardinal(Len))-SLen], SLen);
      FillChar(o[1], Len-SLen, ' ');
      LeftPad := o;
    end;
  end;

  function SearchStatusDisplay(const C : TComponent) : TApdAbstractStatus;
    {-Search for a status display in the same form as TComponent}

    function FindStatusDisplay(const C : TComponent) : TApdAbstractStatus;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdAbstractStatus then begin
          {...and it's not assigned}
          if not Assigned(TApdAbstractStatus(C.Components[I]).FProtocol) then begin
            Result := TApdAbstractStatus(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindStatusDisplay(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindStatusDisplay(C);
  end;

  function SearchProtocolLog(const C : TComponent) : TApdProtocolLog;
    {-Search for a protocol log in the same form as TComponent}

    function FindProtocolLog(const C : TComponent) : TApdProtocolLog;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdProtocolLog then begin
          {...and it's not assigned}
          if not Assigned(TApdProtocolLog(C.Components[I]).FProtocol) then begin
            Result := TApdProtocolLog(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindProtocolLog(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindProtocolLog(C);
  end;

{Message handler window}

  function FindProtocol(Handle : TApdHwnd) : TApdCustomProtocol;
    {-Return protocol object for this window handle}
  var
    I : Integer;
  begin
    for I := 0 to ProtList.Count-1 do begin
      with PProtocolWindowNode(ProtList.Items[I])^ do begin
        if pwWindow = Handle then begin
          Result := pwProtocol;
          Exit;
        end;
      end;
    end;
    Result := nil;
  end;

  function MessageHandler(hWindow : TApdHwnd; Msg, wParam : Integer;
                          lParam : Longint) : Longint;
    {$IFDEF Win32} stdcall; export; {$ELSE} export; {$ENDIF}
    {-Window function for all apw_ProtXxx messages}
  var
    P : TApdCustomProtocol;
    Accept : Boolean;
    FName : ShortString;
    Temp : TWriteFailAction;

  begin
    Result := 0;
    P := FindProtocol(hWindow);
    if Assigned(P) then begin
      with P do begin
        case Msg of
          APW_PROTOCOLSTATUS      :
            apwProtocolStatus(P, wParam);
          APW_PROTOCOLLOG         :
            apwProtocolLog(P, wParam);
          APW_PROTOCOLNEXTFILE    :
            begin
              FName := '';
              apwProtocolNextFile(P, FName);
              if FName <> '' then begin
                StrPCopy(PChar(lParam), FName);
                Result := 1;
              end else
                Result := 0;
            end;
          APW_PROTOCOLACCEPTFILE  :
            begin
              FName := StrPas(PChar(lParam));
              apwProtocolAccept(P, Accept, FName);
              if Accept then begin
                if FileName <> '' then
                  StrPCopy(PChar(lParam), FName);
                Result := 1;
              end else
                Result := 0;
            end;
          APW_PROTOCOLFINISH      :
            apwProtocolFinish(P, SmallInt(wParam));
          APW_PROTOCOLRESUME      :
            begin
              Temp := TWriteFailAction(wParam);
              apwProtocolResume(P, Temp);
              MessageHandler := wParam;
            end;
          APW_PROTOCOLERROR       :
            apwProtocolError(P, SmallInt(wParam));
          else
            MessageHandler := DefWindowProc(hWindow, Msg, wParam, lParam);
        end;
      end;
    end else
      MessageHandler := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;

  procedure RegisterMessageHandlerClass;
  const
    Registered : Boolean = False;
  var
    XClass: TWndClass;
  begin
    if Registered then
      Exit;
    Registered := True;

    with XClass do begin
      Style         := 0;
      lpfnWndProc   := @MessageHandler;
      cbClsExtra    := 0;
      cbWndExtra    := 0;
      {$IFDEF VERSION3}
      if ModuleIsLib and not ModuleIsPackage then
        hInstance   := SysInit.hInstance
      else
        hInstance   := System.MainInstance;
      {$ELSE}
      hInstance     := System.hInstance;
      {$ENDIF}
      hIcon         := 0;
      hCursor       := 0;
      hbrBackground := 0;
      lpszMenuName  := nil;
      lpszClassName := MessageHandlerClassName;
    end;
    WinProcs.RegisterClass(XClass);
  end;

{TApdProtocol}

  procedure TApdCustomProtocol.CreateMessageHandler;
    {-Create message handler window}
  var
    Node : PProtocolWindowNode;
    hInstance : THandle;
  begin
    {$IFDEF VERSION3}
    if ModuleIsLib and not ModuleIsPackage then
      hInstance   := SysInit.hInstance
    else
      hInstance   := System.MainInstance;
    {$ELSE}
    hInstance := System.hInstance;
    {$ENDIF}
    FMsgHandler :=
      CreateWindow(MessageHandlerClassName,   {window class name}
      '',                         {caption}
      0,                          {window style}
      0,                          {X}
      0,                          {Y}
      0,                          {width}
      0,                          {height}
      0,                          {parent}
      0,                          {menu}
      hInstance,
      nil);

    if FMsgHandler = 0 then
      raise EInternal.Create(ecInternal, False);

    ShowWindow(FMsgHandler, sw_Hide);

    {Add to global list}
    Node := nil;
    try
      New(Node);
      Node^.pwWindow := FMsgHandler;
      Node^.pwProtocol := Self;
      ProtList.Add(Node);
      apSetProtocolWindow(PData, FMsgHandler);
    except
      on EOutOfMemory do begin
        if Node <> nil then
          Dispose(Node);
        raise;
      end;
    end;
  end;

  procedure TApdCustomProtocol.CheckPort;
    {-Set port's comhandle or raise exception}
  begin
    {Make sure comport is open, pass handle to protocol}
    if Assigned(FComPort) then
      apSetProtocolPort(PData, FComPort)
    else
      raise EPortNotAssigned.Create(ecPortNotAssigned, False);
  end;

  procedure TApdCustomProtocol.Notification(AComponent : TComponent;
                                            Operation : TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      {Owned components going away}
      if AComponent = FComPort then
        ComPort := nil;
      if AComponent = FStatusDisplay then
        StatusDisplay := nil;
      if AComponent = FProtocolLog then
        ProtocolLog := nil;
    end else if Operation = opInsert then begin
      {Check for new comport}
      if AComponent is TApdCustomComPort then
        if not Assigned(FComPort) then
          ComPort := TApdCustomComPort(AComponent);

      {Check for new status component}
      if AComponent is TApdAbstractStatus then begin
        if not Assigned(FStatusDisplay) then
          if not Assigned(TApdAbstractStatus(AComponent).FProtocol) then
            StatusDisplay := TApdAbstractStatus(AComponent);
      end;

      {Check for new protocol log component}
      if AComponent is TApdProtocolLog then begin
        if not Assigned(FProtocolLog) then begin
          if not Assigned(TApdProtocolLog(AComponent).FProtocol) then begin
            ProtocolLog := TApdProtocolLog(AComponent);
            ProtocolLog.FProtocol := Self;
          end;
        end;
      end;
    end;
  end;

  procedure TApdCustomProtocol.ProcessENQ;
    {-Let the protocol see that we got an ENQ}
  begin
    CheckPort;
    SetProtocolType(ptBPlus);
    CheckException(Self, bpProcessEnq(PData));
  end;

  procedure TApdCustomProtocol.ProcessESCI(const X, Y : Byte);
    {-Let the protocol see the ESCI}
  begin
    CheckPort;
    SetProtocolType(ptBPlus);
    CheckException(Self, bpProcessESCI(PData, X, Y));
  end;

  procedure TApdCustomProtocol.PrepareProcessDLE(var ATimerIndex : Cardinal);
    {-Got a DLE, prepare for processing}
  begin
    CheckPort;
    SetProtocolType(ptBPlus);
    CheckException(Self, bpPrepareProcessDLE(PData, ATimerIndex));
  end;

  procedure TApdCustomProtocol.ProcessDLE(const IsData : Boolean;
                                          var Ready, Start, Upload : Boolean);
    {-Process next character in DLE sequence}
  var
    BReady  : Bool;
    BStart  : Bool;
    BUpload : Bool;
  begin
    CheckPort;
    SetProtocolType(ptBPlus);
    CheckException(Self, bpProcessDLE(PData, IsData, BReady, BStart, BUpload));
    Ready := BReady;
    Start := BStart;
    Upload := BUpload;
  end;

  procedure TApdCustomProtocol.SetComPort(const NewComPort : TApdCustomComPort);
    {-Set a new comport}
  begin
    if NewComPort <> FComPort then begin
      FComPort := NewComPort;
      if Assigned(FComPort) then
        apSetProtocolPort(PData, ComPort)
      else
        apSetProtocolPort(PData, nil);
    end;
  end;

  procedure TApdCustomProtocol.SetProtocolType(
                               const NewProtocol : TProtocolType);
    {-Set a new protocol type}
  var
    Status : Integer;
  begin
    if (NewProtocol <> FProtocolType) or
       (csLoading in ComponentState) then begin
      {Dispose of current protocol, if necessary}
      case FProtocolType of
        ptXmodem, ptXmodemCRC, ptXmodem1K, ptXmodem1KG :
          {nothing to do};
        ptYModem, ptYmodemG :
          ypDonePart(PData);
        ptZmodem :
          zpDonePart(PData);
        ptKermit :
          kpDonePart(PData);
        ptBPlus :
          bpDonePart(PData);
        ptASCII :
          spDonePart(PData);
      end;

      {Init new protocol}
      Status := ecOk;
      Force := True;
      case NewProtocol of
        ptXmodem, ptXmodemCRC, ptXmodem1K, ptXmodem1KG :
          begin
            xpReinit(PData, NewProtocol <> ptXmodem,
                            NewProtocol = ptXmodem1K,
                            NewProtocol = ptXmodem1KG);
            SetXYmodemBlockWait(FXYmodemBlockWait);
          end;

        ptYmodem, ptYModemG :
          begin
            Status := ypReinit(PData,
                               True,
                               NewProtocol = ptYmodemG);
            if Status = ecOk then
              SetXYmodemBlockWait(FXYmodemBlockWait);
          end;

        ptZmodem :
          begin
            Status := zpReinit(PData);
            if Status = ecOk then begin
              SetZmodemOptionOverride(FZmodemOptionOverride);
              SetZmodemSkipNoFile(FZmodemSkipNoFile);
              SetZmodemFileOption(FZmodemFileOption);
              SetZmodemRecover(FZmodemRecover);
              SetZmodem8K(FZmodem8K);
              SetZmodemFinishRetry(FZmodemFinishRetry);
            end;
          end;

        ptKermit :
          begin
            Status := kpReinit(PData);
            if Status = ecOk then begin
              SetKermitMaxLen(FKermitMaxLen);
              SetKermitMaxWindows(FKermitMaxWindows);
              SetKermitSWCTurnDelay(FKermitSWCTurnDelay);
              SetKermitTimeoutSecs(FKermitTimeoutSecs);
              SetKermitPadCharacter(FKermitPadCharacter);
              SetKermitPadCount(FKermitPadCount);
              SetKermitTerminator(FKermitTerminator);
              SetKermitCtlPrefix(FKermitCtlPrefix);
              SetKermitHighbitPrefix(FKermitHighbitPrefix);
              SetKermitRepeatPrefix(FKermitRepeatPrefix);
            end;
          end;

        ptBPlus :
          Status := bpReinit(PData);

        ptASCII :
          begin
            Status := spReinit(PData);
            if Status = ecOk then begin
              SetAsciiCharDelay(FAsciiCharDelay);
              SetAsciiLineDelay(FAsciiLineDelay);
              SetAsciiEOLChar(FAsciiEOLChar);
              SetAsciiCRTranslation(FAsciiCRTranslation);
              SetAsciiLFTranslation(FAsciiLFTranslation);
              SetAsciiEOFTimeout(FAsciiEOFTimeout);
            end;
          end;
     end;

     {Note new protocol type}
     if Status = ecOk then
        FProtocolType := NewProtocol
     else
       CheckException(Self, Status);
    end;
  end;

  function TApdCustomProtocol.GetDestinationDirectory : String;
    {-Return the destination directory}
  begin
    Result := StrPas(PData^.aDestDir);
  end;

  procedure TApdCustomProtocol.SetDestinationDirectory(const NewDir : String);
    {-Set a new destination directory}
  begin
    with PData^ do
      StrPCopy(aDestDir, NewDir);
  end;

  function TApdCustomProtocol.GetFileMask : TFileName;
    {-Return the current file mask}
  begin
    Result := StrPas(PData^.aSearchMask);
  end;

  procedure TApdCustomProtocol.SetFileMask(const NewFileMask : TFileName);
    {-Set a new file mask}
  var
    S : TFileName;
  begin
    with PData^ do
      {$IFDEF Win32}
      if Length(NewFileMask) > 255 then begin
        S := NewFileMask;
        SetLength(S, 255);
        StrPCopy(aSearchMask, S);
      end else
      {$ENDIF}
        StrPCopy(aSearchMask, NewFileMask);
  end;

  function TApdCustomProtocol.GetBatch : Boolean;
    {-Return True if the current protocol supports batch transfers}
  begin
    Result := PData^.aBatchProtocol;
  end;

  function TApdCustomProtocol.GetBlockCheckMethod : TBlockCheckMethod;
    {-Return the current block check method}
  begin
    Result := TBlockCheckMethod(PData^.aCheckType);
  end;

  function TApdCustomProtocol.GetProtocolStatus : Cardinal;
    {-Return the current protocol status}
  begin
    Result := PData^.aProtocolStatus;
  end;

  function TApdCustomProtocol.GetProtocolError : SmallInt;
    {-Return the current protocol error}
  begin
    Result := PData^.aProtocolError;
  end;

  function TApdCustomProtocol.GetFileLength : LongInt;
    {-Return the file length}
  begin
    Result := PData^.aSrcFileLen;
  end;

  function TApdCustomProtocol.GetFileDate : TDateTime;
    {-Return the file timestamp}
  begin
    Result := FileDateToDateTime(PData^.aSrcFileDate);
  end;

  function TApdCustomProtocol.GetInitialPosition : LongInt;
    {-Return the initial file position}
  begin
    Result := PData^.aInitFilePos;
  end;

  function TApdCustomProtocol.GetStatusInterval : Cardinal;
    {-Return the current status update interval, in ticks}
  begin
    Result := PData^.aStatusInterval;
  end;

  procedure TApdCustomProtocol.SetStatusInterval(const NewInterval : Cardinal);
    {-Set a new update status interval}
  begin
    with PData^ do
      if NewInterval <> aStatusInterval then
        aStatusInterval := NewInterval;
  end;

  procedure TApdCustomProtocol.SetStatusDisplay(
                               const NewDisplay : TApdAbstractStatus);
    {-Set a new status display}
  begin
    if NewDisplay <> FStatusDisplay then begin
      FStatusDisplay := NewDisplay;
      if Assigned(FStatusDisplay) then
        FStatusDisplay.FProtocol := Self;
    end;
  end;

  procedure TApdCustomProtocol.SetProtocolLog(const NewLog : TApdProtocolLog);
    {-Set a new protocol log}
  begin
    if NewLog <> FProtocolLog then begin
      FProtocolLog := NewLog;
      if Assigned(FProtocolLog) then
        FProtocolLog.FProtocol := Self;
    end;
  end;

  function TApdCustomProtocol.GetInProgress : Boolean;
    {-Return True if protocol is in progress}
  begin
    Result := PData^.aInProgress <> 0;
  end;

  function TApdCustomProtocol.GetBlockErrors : Cardinal;
    {-Return the number of block errors}
  begin
    Result := PData^.aBlockErrors;
  end;

  function TApdCustomProtocol.GetTotalErrors : Cardinal;
    {-Return the number of total errors}
  begin
    Result := PData^.aTotalErrors;
  end;

  function TApdCustomProtocol.GetBytesRemaining : LongInt;
    {-Return the number of bytes remaining to be transferred}
  begin
    Result := apGetBytesRemaining(PData);
  end;

  function TApdCustomProtocol.GetBytesTransferred : LongInt;
    {-Return the number of bytes transferred so far}
  begin
    Result := apGetBytesTransferred(PData);
  end;

  function TApdCustomProtocol.GetElapsedTicks : LongInt;
    {-Return the ticks elapsed for this transfer}
  begin
    Result := PData^.aElapsedTicks;
  end;

  function TApdCustomProtocol.GetFileName : String;
    {-Return the current file name}
  begin
    Result := StrPas(PData^.aPathname);
  end;

  procedure TApdCustomProtocol.SetFileName(const NewName : String);
    {-Set/change the incoming file name}
  var
    P : array[0..255] of Char;
    S : String;
  begin
    {Allow changes only when WorkFile is *not* open}
    case TFileRec(PData^.aWorkFile).Mode of
      fmInput, fmOutput, fmInOut : ;
      else begin
        {$IFDEF Win32}
        if Length(NewName) > 255 then begin
          S := NewName;
          SetLength(S, 255);
          StrPCopy(P, S);
        end else
        {$ENDIF}
          StrPCopy(P, NewName);
        apSetReceiveFileName(PData, P);
      end;
    end;
  end;

  function TApdCustomProtocol.GetXYmodemBlockWait : Cardinal;
    {-Return the X/Ymodem block wait value in ticks}
  begin
    case TProtocolType(PData^.aCurProtocol) of
      ptXmodem..ptYmodemG :
        begin
          FXYmodemBlockWait := PData^.xBlockWait;
          Result := FXYmodemBlockWait;
        end;
      else
        Result := FXYmodemBlockWait;
    end;
  end;

  procedure TApdCustomProtocol.SetXYmodemBlockWait(const NewWait : Cardinal);
    {-Set a new X/Ymodem block wait}
  begin
    if (NewWait <> FXYmodemBlockWait) or Force then begin
      FXYmodemBlockWait := NewWait;
      case TProtocolType(PData^.aCurProtocol) of
        ptXmodem..ptYmodemG :
          PData^.xBlockWait := NewWait;
      end;
    end;
  end;

  function TApdCustomProtocol.GetZmodemOptionOverride : Boolean;
    {-Return the zmodem override option}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodemOptionOverride := PData^.ZFileMgmtOverride;
    Result := FZmodemOptionOverride;
  end;

  procedure TApdCustomProtocol.SetZmodemOptionOverride(
                               const NewOverride : Boolean);
    {-Enable/disable the zmodem option override option}
  begin
    if (NewOverride <> FZmodemOptionOverride) or Force then begin
      FZmodemOptionOverride := NewOverride;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        PData^.ZFileMgmtOverride := NewOverride;
    end;
  end;

  function TApdCustomProtocol.GetZmodemSkipNoFile : Boolean;
    {-Return the zmodem skip no file option}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      with PData^ do
        FZmodemSkipNoFile := (zFileMgmtOpts and FileSkipMask) <> 0;
    Result := FZmodemSkipNoFile;
  end;

  procedure TApdCustomProtocol.SetZmodemSkipNoFile(const NewSkip : Boolean);
    {-Enable/disable the skipnofile option}
  begin
    if (NewSkip <> FZmodemSkipNoFile) or Force then begin
      FZmodemSkipNoFile := NewSkip;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        with PData^ do
          if NewSkip then
            zFileMgmtOpts := zFileMgmtOpts or FileSkipMask
          else
            zFileMgmtOpts := zFileMgmtOpts and not FileSkipMask;
    end;
  end;

  function TApdCustomProtocol.GetZmodemFileOption : TZmodemFileOptions;
    {-Return the zmodem file managment option}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodemFileOption :=
        TZmodemFileOptions(PData^.zFileMgmtOpts and not FileSkipMask);
    Result := FZmodemFileOption;
  end;

  procedure TApdCustomProtocol.SetZmodemFileOption(
                               const NewOpt : TZmodemFileOptions);
    {-Set new file management options}
  var
    OldSkip : Boolean;
  begin
    if (NewOpt <> FZmodemFileOption) or Force then begin

      {Disallow zfoWriteCrc, it's not supported yet}
      if NewOpt = zfoWriteCrc then
        Exit;

      FZmodemFileOption := NewOpt;
      with PData^ do begin
        if aCurProtocol = Ord(ptZmodem) then begin
          OldSkip := ZmodemSkipNoFile;
          zFileMgmtOpts := Ord(NewOpt);
          if OldSkip then
            zFileMgmtOpts := zFileMgmtOpts or FileSkipMask;
        end;
      end;
    end;
  end;

  function TApdCustomProtocol.GetZmodemRecover : Boolean;
    {-Return the recovery option}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodemRecover := PData^.zReceiverRecover;
    Result := FZmodemRecover;
  end;

  procedure TApdCustomProtocol.SetZmodemRecover(const NewRecover : Boolean);
    {-Enable/disable Zmodem crash recovery}
  begin
    if (NewRecover <> FZmodemRecover) or Force then begin
      FZmodemRecover := NewRecover;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        PData^.zReceiverRecover := NewRecover;
    end;
  end;

  function TApdCustomProtocol.GetZmodem8K : Boolean;
    {-Return the state Zmodem's 8K mode}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodem8K := PData^.zUse8KBlocks;
    Result := FZmodem8K;
  end;

  procedure TApdCustomProtocol.SetZmodem8K(const New8K : Boolean);
    {-Enable/disable 8K blocks}
  begin
    if (New8K <> FZmodem8K) or Force then begin
      FZmodem8K := New8K;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        CheckException(Self, zpSetBigSubpacketOption(PData, New8K));
    end;
  end;

  function TApdCustomProtocol.GetZmodemZRQINITValue : LongInt;
    {-Return the Zmodem's ZRQINIT value}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodemZRQINITValue := PData^.zZRQINITValue;
    Result := FZmodemZRQINITValue;
  end;

  procedure TApdCustomProtocol.SetZmodemZRQINITValue(const NewZRQINITValue : LongInt);
    {-Set the Zmodem's ZRQINIT value}
  begin
    if (NewZRQINITValue <> FZmodemZRQINITValue) or Force then begin
      FZmodemZRQINITValue := NewZRQINITValue;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        PData^.zZRQINITValue := NewZRQINITValue;
    end;
  end;

  function TApdCustomProtocol.GetZmodemFinishRetry : Cardinal;
    {-Return the Zmodem finish retry count}
  begin
    if PData^.aCurProtocol = Ord(ptZmodem) then
      FZmodemFinishRetry := PData^.zFinishRetry;
    Result := FZmodemFinishRetry;
  end;

  procedure TApdCustomProtocol.SetZmodemFinishRetry(const NewRetry : Cardinal);
    {-Enable/disable 8K blocks}
  begin
    if (NewRetry <> FZmodemFinishRetry) or Force then begin
      FZmodemFinishRetry := NewRetry;
      if PData^.aCurProtocol = Ord(ptZmodem) then
        CheckException(Self,
          zpSetZmodemFinishWait(PData, PData^.aFinishWait, FZmodemFinishRetry));
    end;
  end;

  function TApdCustomProtocol.GetKermitMaxLen : Cardinal;
    {-Return the max packet len (normal)}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then begin
      FKermitMaxLen := PData^.kKermitOptions.MaxLongPacketLen;
      if FKermitMaxLen = 0 then
        FKermitMaxLen := PData^.kKermitOptions.MaxPacketLen;
    end;
    Result := FKermitMaxLen;
  end;

  procedure TApdCustomProtocol.SetKermitMaxLen(const NewLen : Cardinal);
    {-Set a new max len}
  begin
    if (NewLen <> FKermitMaxLen) or Force then begin
      if NewLen <= 94 then begin
        FKermitMaxLen := NewLen;
        if PData^.aCurProtocol = Ord(ptKermit) then begin
          CheckException(Self, kpSetMaxPacketLen(PData, NewLen));
          CheckException(Self, kpSetMaxLongPacketLen(PData, 0));
        end;
      end else begin
        if NewLen > MaxKermitLongLen then
          FKermitMaxLen := MaxKermitLongLen
        else
          FKermitMaxLen := NewLen;
        if PData^.aCurProtocol = Ord(ptKermit) then
          CheckException(Self, kpSetMaxLongPacketLen(PData, NewLen));
      end;
    end;
  end;

  function TApdCustomProtocol.GetKermitMaxWindows : Cardinal;
    {-Return the maximum number of windows}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitMaxWindows := PData^.kKermitOptions.WindowSize;
    Result := FKermitMaxWindows;
  end;

  procedure TApdCustomProtocol.SetKermitMaxWindows(const NewMax : Cardinal);
    {-Set new max windows}
  begin
    if (NewMax <> FKermitMaxWindows) or Force then begin
      if NewMax > MaxKermitWindows then
        FKermitMaxWindows := MaxKermitWindows
      else
        FKermitMaxWindows := NewMax;

      {If not really using windows then disable SWC}
      if (NewMax = 0) or (NewMax = 1) then
        FKermitMaxWindows := 0;

      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetMaxWindows(PData, FKermitMaxWindows));
    end;
  end;

  function TApdCustomProtocol.GetKermitSWCTurnDelay : Cardinal;
    {-Return the turn delay for when sliding windows are in use}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitSWCTurnDelay := PData^.kSWCTurnDelay;
    Result := FKermitSWCTurnDelay;
  end;

  procedure TApdCustomProtocol.SetKermitSWCTurnDelay(const NewDelay : Cardinal);
    {-Set new turn delay value for sliding windows}
  begin
    if (NewDelay <> FKermitSWCTurnDelay) or Force then begin
      FKermitSWCTurnDelay := NewDelay;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetSWCTurnDelay(PData, NewDelay));
    end;
  end;

  function TApdCustomProtocol.GetKermitTimeoutSecs : Cardinal;
    {-Return the packet timeout, in seconds}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitTimeoutSecs := PData^.kKermitOptions.MaxTimeout;
    Result := FKermitTimeoutSecs;
  end;

  procedure TApdCustomProtocol.SetKermitTimeoutSecs(const NewTimeout : Cardinal);
    {-Set a new timeout value}
  begin
    if (NewTimeout <> FKermitTimeoutSecs) or Force then begin
      FKermitTimeoutSecs := NewTimeout;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetMaxTimeoutSecs(PData, NewTimeout));
    end;
  end;

  function TApdCustomProtocol.GetKermitPadCharacter : Char;
    {-Return the new pad character}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitPadCharacter := PData^.kKermitOptions.PadChar;
    Result := FKermitPadCharacter;
  end;

  procedure TApdCustomProtocol.SetKermitPadCharacter(NewChar : Char);
    {-Set a new pad character}
  begin
    if (NewChar <> FKermitPadCharacter) or Force then begin
      FKermitPadCharacter := NewChar;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self,
          kpSetPacketPadding(PData, FKermitPadCharacter, FKermitPadCount));
    end;
  end;

  function TApdCustomProtocol.GetKermitPadCount : Cardinal;
    {-Return the pad count}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitPadCount := PData^.kKermitOptions.PadCount;
    Result := FKermitPadCount;
  end;

  procedure TApdCustomProtocol.SetKermitPadCount(NewCount : Cardinal);
    {-Set a new pad count}
  begin
    if (NewCount <> FKermitPadCount) or Force then begin
      FKermitPadCount := NewCount;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self,
          kpSetPacketPadding(PData, FKermitPadCharacter, FKermitPadCount));
    end;
  end;

  function TApdCustomProtocol.GetKermitTerminator : Char;
    {-Return the kermit terminator}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitTerminator := PData^.kKermitOptions.Terminator;
    Result := FKermitTerminator;
  end;

  procedure TApdCustomProtocol.SetKermitTerminator(const NewTerminator : Char);
    {-Set new terminator}
  begin
    if (NewTerminator <> FKermitTerminator) or Force then begin
      FKermitTerminator := NewTerminator;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetTerminator(PData, NewTerminator));
    end;
  end;

  function TApdCustomProtocol.GetKermitCtlPrefix : Char;
    {-Return the control char prefix}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitCtlPrefix := PData^.kKermitOptions.CtlPrefix;
    Result := FKermitCtlPrefix;
  end;

  procedure TApdCustomProtocol.SetKermitCtlPrefix(const NewPrefix : Char);
    {-Set new ctrl char prefix}
  begin
    if (NewPrefix <> FKermitCtlPrefix) or Force then begin
      FKermitCtlPrefix := NewPrefix;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetCtlPrefix(PData, NewPrefix));
    end;
  end;

  function TApdCustomProtocol.GetKermitHighbitPrefix : Char;
    {-Return the highbit prefix}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitHighbitPrefix := PData^.kKermitOptions.HibitPrefix;
    Result := FKermitHighbitPrefix;
  end;

  procedure TApdCustomProtocol.SetKermitHighbitPrefix(const NewPrefix : Char);
    {-Set new highbit prefix}
  begin
    if (NewPrefix <> FKermitHighbitPrefix) or Force then begin
      FKermitHighbitPrefix := NewPrefix;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetHibitPrefix(PData, NewPrefix));
    end;
  end;

  function TApdCustomProtocol.GetKermitRepeatPrefix : Char;
    {-Return the repeat prefix}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      FKermitRepeatPrefix := PData^.kKermitOptions.RepeatPrefix;
    Result := FKermitRepeatPrefix;
  end;

  procedure TApdCustomProtocol.SetKermitRepeatPrefix(const NewPrefix : Char);
    {-Set a new repeat prefix}
  begin
    if (NewPrefix <> FKermitRepeatPrefix) or Force then begin
      FKermitRepeatPrefix := NewPrefix;
      if PData^.aCurProtocol = Ord(ptKermit) then
        CheckException(Self, kpSetRepeatPrefix(PData, NewPrefix));
    end;
  end;

  function TApdCustomProtocol.GetKermitWindowsTotal : Cardinal;
    {-Return the total number of windows negotiated}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      Result := kpGetSWCSize(PData)
    else
      Result := KermitMaxWindows;
  end;

  function TApdCustomProtocol.GetKermitWindowsUsed : Cardinal;
    {-Return the total number of windows filled with data}
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then
      Result := kpWindowsUsed(PData)
    else
      Result := 0;
  end;

  function TApdCustomProtocol.GetKermitLongBlocks : Boolean;
    {-Return True if long blocks are requested or negotiated}
  var
    Dummy : Cardinal;
    InUse : Bool;
  begin
    if PData^.aCurProtocol = Ord(ptKermit) then begin
      kpGetLPStatus(PData, InUse, Dummy);
      Result := InUse;
    end else
      Result := False;
  end;

  function TApdCustomProtocol.GetAsciiCharDelay : Cardinal;
    {-Return the inter-char delay}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiCharDelay := PData^.sInterCharDelay;
    Result := FAsciiCharDelay;
  end;

  procedure TApdCustomProtocol.SetAsciiCharDelay(const NewDelay : Cardinal);
    {-Set a new inter-char delay}
  begin
    if (NewDelay <> FAsciiCharDelay) or Force then begin
      FAsciiCharDelay := NewDelay;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self,
          spSetDelays(PData, FAsciiCharDelay, FAsciiLineDelay));
    end;
  end;

  function TApdCustomProtocol.GetUpcaseFileNames : Boolean;
    {-Return the UpcaseFileNames value}
  begin
    Result := PData^.aUpcaseFileNames;
  end;

  procedure TApdCustomProtocol.SetUpcaseFileNames(NewUpcase : Boolean);
    {-Set a new UpcaseFileNames value}
  begin
    PData^.aUpcaseFileNames := NewUpcase;
  end;

  function TApdCustomProtocol.GetAsciiLineDelay : Cardinal;
    {-Return the inter-line delay}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiLineDelay := PData^.sInterLineDelay;
    Result := FAsciiLineDelay;
  end;

  procedure TApdCustomProtocol.SetAsciiLineDelay(const NewDelay : Cardinal);
    {-Set a new inter-line delay}
  begin
    if (NewDelay <> FAsciiLineDelay) or Force then begin
      FAsciiLineDelay := NewDelay;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self,
          spSetDelays(PData, FAsciiCharDelay, FAsciiLineDelay));
    end;
  end;

  function TApdCustomProtocol.GetAsciiEOLChar : Char;
    {-Return the EOL character}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiEOLChar := PData^.sEOLChar;
    Result := FAsciiEOLChar;
  end;

  procedure TApdCustomProtocol.SetAsciiEOLChar(const NewChar : Char);
    {-Set new EOL char}
  begin
    if (NewChar <> FAsciiEOLChar) or Force then begin
      FAsciiEOLChar := NewChar;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self, spSetEOLChar(PData, FAsciiEOLChar));
    end;
  end;

  function TApdCustomProtocol.GetAsciiCRTranslation : TAsciiEOLTranslation;
    {-Return the CR translation option}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiCRTranslation := TAsciiEOLTranslation(PData^.sCRTransMode);
    Result := FAsciiCRTranslation;
  end;

  procedure TApdCustomProtocol.SetAsciiCRTranslation(
                            const NewTrans : TAsciiEOLTranslation);
    {-Set a new CR translation}
  begin
    if (NewTrans <> FAsciiCRTranslation) or Force then begin
      FAsciiCRTranslation := NewTrans;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self,
          spSetEOLTranslation(PData, Ord(FAsciiCRTranslation),
                                     Ord(FAsciiLFTranslation)));
    end;
  end;

  function TApdCustomProtocol.GetAsciiLFTranslation : TAsciiEOLTranslation;
    {-Return LF translation option}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiLFTranslation := TAsciiEOLTranslation(PData^.sLFTransMode);
    Result := FAsciiLFTranslation;
  end;

  procedure TApdCustomProtocol.SetAsciiLFTranslation(
                            const NewTrans : TAsciiEOLTranslation);
    {-Set a new LF translation}
  begin
    if (NewTrans <> FAsciiLFTranslation) or Force then begin
      FAsciiLFTranslation := NewTrans;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self,
          spSetEOLTranslation(PData, Ord(FAsciiCRTranslation),
                                     Ord(FAsciiLFTranslation)));
    end;
  end;

  function TApdCustomProtocol.GetAsciiEOFTimeout : Cardinal;
    {-Return the EOF timeout value, in ticks}
  begin
    if PData^.aCurProtocol = Ord(ptAscii) then
      FAsciiEOFTimeout := PData^.aRcvTimeout;
    Result := FAsciiEOFTimeout;
  end;

  procedure TApdCustomProtocol.SetAsciiEOFTimeout(const NewTimeout : Cardinal);
    {-Set a new ascii timeout value}
  begin
    if (NewTimeout <> FAsciiEOFTimeout) or Force then begin
      FAsciiEOFTimeout := NewTimeout;
      if PData^.aCurProtocol = Ord(ptAscii) then
        CheckException(Self,
          spSetEOFTimeout(PData, FAsciiEOFTimeout));
    end;
  end;

  function TApdCustomProtocol.GetHonorDirectory : Boolean;
    {-Return the honor directory option}
  begin
    Result := PData^.aFlags and apHonorDirectory <> 0;
  end;

  procedure TApdCustomProtocol.SetHonorDirectory(const NewOpt : Boolean);
    {-Set the honordirectory option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apHonorDirectory <> 0) then
        if NewOpt then
          aFlags := aFlags or apHonorDirectory
        else
          aFlags := aFlags and not apHonorDirectory;
  end;

  function TApdCustomProtocol.GetIncludeDirectory : Boolean;
    {-Return the includedirectory option}
  begin
    Result := PData^.aFlags and apIncludeDirectory <> 0;
  end;

  procedure TApdCustomProtocol.SetIncludeDirectory(const NewOpt : Boolean);
    {-Set the include directory option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apIncludeDirectory <> 0) then
        if NewOpt then
          aFlags := aFlags or apIncludeDirectory
        else
          aFlags := aFlags and not apIncludeDirectory;
  end;

  function TApdCustomProtocol.GetRTSLowForWrite : Boolean;
    {-Return the RTSLowForWrite option}
  begin
    Result := PData^.aFlags and apRTSLowForWrite <> 0;
  end;

  procedure TApdCustomProtocol.SetRTSLowForWrite(const NewOpt : Boolean);
    {-Set the RTSLowForWrite option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apRTSLowForWrite <> 0) then
        if NewOpt then
          aFlags := aFlags or apRTSLowForWrite
        else
          aFlags := aFlags and not apRTSLowForWrite;
  end;

  function TApdCustomProtocol.GetAbortNoCarrier : Boolean;
    {-Return the AbortNoCarrier option}
  begin
    Result := PData^.aFlags and apAbortNoCarrier <> 0;
  end;

  procedure TApdCustomProtocol.SetAbortNoCarrier(const NewOpt : Boolean);
    {-Set the AbortNoCarrier option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apAbortNoCarrier <> 0) then
        if NewOpt then
          aFlags := aFlags or apAbortNoCarrier
        else
          aFlags := aFlags and not apAbortNoCarrier;
  end;

  function TApdCustomProtocol.GetBP2KTransmit : Boolean;
    {-Return the BP2KTransmit option}
  begin
    Result := PData^.aFlags and apBP2KTransmit <> 0;
  end;

  procedure TApdCustomProtocol.SetBP2KTransmit(const NewOpt : Boolean);
    {-Set the BP2KTransmit option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apBP2KTransmit <> 0) then
        if NewOpt then
          aFlags := aFlags or apBP2KTransmit
        else
          aFlags := aFlags and not apBP2KTransmit;
  end;

  function TApdCustomProtocol.GetAsciiSuppressCtrlZ : Boolean;
    {-Return the AscciSuppressCtrlZ option}
  begin
    Result := PData^.aFlags and apAsciiSuppressCtrlZ <> 0;
  end;

  procedure TApdCustomProtocol.SetAsciiSuppressCtrlZ(const NewOpt : Boolean);
    {-Set the AsciiSuppressCtrlZ option}
  begin
    with PData^ do
      if NewOpt <> (aFlags and apAsciiSuppressCtrlZ <> 0) then
        if NewOpt then
          aFlags := aFlags or apAsciiSuppressCtrlZ
        else
          aFlags := aFlags and not apAsciiSuppressCtrlZ;
  end;

  procedure TApdCustomProtocol.SetBlockCheckMethod(
                               const NewMethod : TBlockCheckMethod);
    {-Set a new block check method}
  begin
    with PData^ do begin
      if (NewMethod <> TBlockCheckMethod(aCheckType)) and
         (aInProgress = 0) then begin
        case TProtocolType(PData^.aCurProtocol) of
           ptNoProtocol,
           ptXmodem1K, ptXmodem1KG,
           ptYmodem, ptYmodemG,
           ptAscii :
             {Don't change} ;
           ptXmodem :
             {Allow only switch to CRC}
             if NewMethod = bcmCrc16 then
               ProtocolType := ptXmodemCRC;
           ptXmodemCRC :
             {Allow only switch to checksum}
             if NewMethod = bcmChecksum then
               ProtocolType := ptXmodem;
           ptZmodem :
             {Allow only CRC16 and CRC32}
             case NewMethod of
               bcmCrc16, bcmCrc32 :
                 aCheckType := Cardinal(NewMethod);
             end;
           ptKermit :
             {Allow only Kermit types}
             case NewMethod of
               bcmChecksum, bcmChecksum2, bcmCrcK :
                 aCheckType := Cardinal(NewMethod);
             end;
        end;
      end;
    end;
  end;

  function TApdCustomProtocol.GetHandshakeRetry : Cardinal;
    {-Return the handshake retry count}
  begin
    Result := PData^.aHandshakeRetry;
  end;

  procedure TApdCustomProtocol.SetHandshakeRetry(const NewRetry : Cardinal);
    {-Set a new handshake retry value}
  begin
    with PData^ do
      if NewRetry <> aHandshakeRetry then
        aHandshakeRetry := NewRetry
  end;

  function TApdCustomProtocol.GetHandshakeWait : Cardinal;
    {-Return the handshake wait ticks}
  begin
    Result := PData^.aHandshakeWait;
  end;

  procedure TApdCustomProtocol.SetHandshakeWait(const NewWait : Cardinal);
    {-Set the handshake wait ticks}
  begin
    with PData^ do
      if NewWait <> aHandshakeWait then
        aHandshakeWait := NewWait;
  end;

  function TApdCustomProtocol.GetBlockLength : Cardinal;
    {-Return the current block length}
  begin
    if PData^.aInProgress <> 0 then begin
      Result := PData^.aLastBlockSize;
      if Result = 0 then
        Result := PData^.aBlockLen;
    end else
      Result := PData^.aBlockLen;
  end;

  function TApdCustomProtocol.GetBlockNumber : Cardinal;
    {-Return the current block number}
  begin
    Result := PData^.aBlockNum;
  end;

  function TApdCustomProtocol.GetTransmitTimeout : Cardinal;
    {-Return the current transmit timeout}
  begin
    Result := PData^.aTransTimeout;
  end;

  procedure TApdCustomProtocol.SetTransmitTimeout(const NewTimeout : Cardinal);
    {-Set a new transmit timeout}
  begin
    with PData^ do
      if NewTimeout <> aTransTimeout then
        aTransTimeout := NewTimeout;
  end;

  function TApdCustomProtocol.GetFinishWait : Cardinal;
    {-Return finish wait ticks}
  begin
    Result := PData^.aFinishWait;
  end;

  procedure TApdCustomProtocol.SetFinishWait(const NewWait : Cardinal);
    {-Set new finish wait ticks}
  begin
    with PData^ do
      if NewWait <> aFinishWait then
        aFinishWait := NewWait;
  end;

  function TApdCustomProtocol.GetActualBPS : LongInt;
    {-Return actual CPS for protocol}
  begin
    Result := LongInt(PData^.aActCPS) * 10;
  end;

  procedure TApdCustomProtocol.SetActualBPS(const NewBPS : LongInt);
    {-Set the actual CPS for the protocol}
  begin
    with PData^ do begin
      NeedBPS := False;
      apSetActualBPS(PData, NewBPS);
    end;
  end;

  function TApdCustomProtocol.GetTurnDelay : Cardinal;
    {-Return the turnaround delay, in ticks}
  begin
    Result := PData^.aTurnDelay;
  end;

  procedure TApdCustomProtocol.SetTurnDelay(const NewDelay : Cardinal);
    {-Set the turnaround delay, in ticks}
  begin
    with PData^ do
      if NewDelay <> aTurnDelay then
        aTurnDelay := NewDelay;
  end;

  function TApdCustomProtocol.GetOverhead : Cardinal;
    {-Return number of overhead bytes}
  begin
    Result := PData^.aOverhead;
  end;

  procedure TApdCustomProtocol.SetOverhead(const NewOverhead : Cardinal);
    {-Set new number of overhead bytes}
  begin
    with PData^ do
      if NewOverhead <> aOverhead then
        aOverhead := NewOverhead;
  end;

  function TApdCustomProtocol.GetWriteFailAction : TWriteFailAction;
    {-Return writefail action}
  begin
    Result := TWriteFailAction(PData^.aWriteFailOpt);
  end;

  procedure TApdCustomProtocol.SetWriteFailAction(
                               const NewAction : TWriteFailAction);
    {-Set a new write fail action}
  begin
    with PData^ do
      if Ord(NewAction) <> aWriteFailOpt then
        aWriteFailOpt := Ord(NewAction);
  end;

  procedure TApdCustomProtocol.apwProtocolAccept(CP : TObject;
                                                 var Accept : Boolean;
                                                 var FName : TPassString);
    {-Internal event handling}
  begin
    Accept := True;
    if Assigned(FOnProtocolAccept) then
      FOnProtocolAccept(CP, Accept, FName);
  end;

  procedure TApdCustomProtocol.apwProtocolError(CP : TObject;
                                                ErrorCode : Integer);
    {-Internal event handling}
  begin
    if Assigned(FOnProtocolError) then
      FOnProtocolError(CP, ErrorCode);
  end;

  procedure TApdCustomProtocol.apwProtocolFinish(CP : TObject;
                                                 ErrorCode : Integer);
      {-Internal event handling}
  begin
    if Assigned(FOnProtocolFinish) then
      FOnProtocolFinish(CP, ErrorCode);
  end;

  procedure TApdCustomProtocol.apwProtocolLog(CP : TObject; Log : Cardinal);
    {-Internal event handling}
  begin
    {If LogProc is assigned then call it}
    if Assigned(FProtocolLog) then
      FProtocolLog.UpdateLog(Log);

    {If event handler is assigned then call it}
    if Assigned(FOnProtocolLog) then
      FOnProtocolLog(CP, Log);
  end;

  procedure TApdCustomProtocol.apwProtocolNextFile(CP : TObject;
                                                   var FName : TPassString);
    {-Internal event handling}
  var
    P : array[0..255] of Char;
  begin
    if Assigned(FOnProtocolNextFile) then
      FOnProtocolNextFile(CP, FName)
    else begin
      FillChar(P, SizeOf(P), 0);
      if apNextFileMask(PData, P) then
        FName := StrPas(P)
      else
        FName := '';
    end;
  end;

  procedure TApdCustomProtocol.apwProtocolResume(CP : TObject;
                                                 var Resume : TWriteFailAction);
    {-Internal event handling}
  begin
    if Assigned(FOnProtocolResume) then
      FOnProtocolResume(CP, Resume)
  end;

  procedure TApdCustomProtocol.apwProtocolStatus(CP : TObject; Options : Cardinal);
    {-Internal event handling}
  begin
    {Automatically hand off to status display, if one is attached}
    if Assigned(FStatusDisplay) then
      StatusDisplay.UpdateDisplay(Options and apFirstCall <> 0,
                                  Options and apLastCall <> 0);

    {Call user's event handler}
    if Assigned(FOnProtocolStatus) then
      FOnProtocolStatus(CP, Options);
  end;

  constructor TApdCustomProtocol.Create(AOwner : TComponent);
    {-Create the object instance}
{$IFDEF TRIALRUN}
  {$I TRIAL06.INC}
{$ENDIF}
  begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
    inherited Create(AOwner);

    {Inits}
    PData                := nil;
    Force                := False;
    FComPort             := nil;
    FProtocolType        := awpDefProtocolType;
    FStatusDisplay       := nil;
    FProtocolLog         := nil;
    FXYmodemBlockWait    := awpDefXYmodemBlockWait;
    FZmodemFileOption    := awpDefZmodemFileOption;
    FZmodemOptionOverride := awpDefZmodemOptionOverride;
    FZmodemSkipNoFile    := awpDefZmodemSkipNoFile;
    FZmodemRecover       := awpDefZmodemRecover;
    FZmodem8K            := awpDefZmodem8k;
    FZmodemZRQINITValue  := awpDefZmodemZRQINITValue;
    FKermitMaxLen        := awpDefKermitMaxLen;
    FKermitMaxWindows    := awpDefKermitMaxWindows;
    FKermitSWCTurnDelay  := awpDefKermitSWCTurnDelay;
    FKermitTimeoutSecs   := awpDefKermitTimeoutSecs;
    FKermitTerminator    := awpDefKermitTerminator;
    FKermitCtlPrefix     := awpDefKermitCtlPrefix;
    FKermitHighbitPrefix := awpDefKermitHighbitPrefix;
    FKermitRepeatPrefix  := awpDefKermitRepeatPrefix;
    FAsciiCharDelay      := awpDefAsciiCharDelay;
    FAsciiLineDelay      := awpDefAsciiLineDelay;
    FAsciiEOLChar        := awpDefAsciiEOLChar;
    FAsciiCRTranslation  := awpDefAsciiCRTranslation;
    FAsciiLFTranslation  := awpDefAsciiLFTranslation;
    FAsciiEOFTimeout     := awpDefAsciiEOFTimeout;

    {Create the protocol element}
    NeedBPS := True;
    CheckException(Self, apInitProtocolData(PData, nil, DefProtocolOptions));

    {PData inits}
    HandshakeWait := awpDefHandshakeWait;
    HandshakeRetry := awpDefHandshakeRetry;
    TransmitTimeout := awpDefTransTimeout;
    FinishWait := awpDefFinishWait;
    TurnDelay := awpDefTurnDelay;
    Overhead := awpDefOverhead;
    HonorDirectory := awpDefHonorDirectory;
    IncludeDirectory := awpDefIncludeDirectory;
    RTSLowForWrite := awpDefRTSLowForWrite;
    AbortNoCarrier := awpDefAbortNoCarrier;
    BP2KTransmit := awpDefBP2KTransmit;
    AsciiSuppressCtrlZ := awpDefAsciiSuppressCtrlZ;
    UpcaseFileNames := awpDefUpcaseFileNames;

    {Option inits}
    with PData^ do begin
      aFlags := 0;
      if awpDefHonorDirectory then
        aFlags := aFlags or apHonorDirectory;
      if awpDefIncludeDirectory then
        aFlags := aFlags or apIncludeDirectory;
      if awpDefRTSLowForWrite then
        aFlags := aFlags or apRTSLowForWrite;
      if awpDefAbortNoCarrier then
        aFlags := aFlags or apAbortNoCarrier;
      if awpDefBP2KTransmit then
        aFlags := aFlags or apBP2KTransmit;
      if awpDefAsciiSuppressCtrlZ then
        aFlags := aFlags or apAsciiSuppressCtrlZ;
    end;

    {Search for comport}
    FComPort := SearchComPort(Owner);

    {Search for protocol status display}
    StatusDisplay := SearchStatusDisplay(Owner);

    {Search for protocol log}
    FProtocolLog := SearchProtocolLog(Owner);
    if Assigned(FProtocolLog) then
      ProtocolLog.FProtocol := Self;

    {Create the message handler instance...}
    if not (csDesigning in ComponentState) then begin
      RegisterMessageHandlerClass;
      CreateMessageHandler;
      FProtocolType := ptNoProtocol;
    end else begin
      FProtocolType := ptNoProtocol;
      SetProtocolType(awpDefProtocolType);
    end;
  end;

  destructor TApdCustomProtocol.Destroy;
    {-Destroy the object instance}
  var
    I : Cardinal;
    P : PProtocolWindowNode;
  begin
    {Get rid of msg handler window and node}
    if not (csDesigning in ComponentState) then
      with ProtList do
        if Count > 0 then
          for I := 0 to Count-1 do begin
            P := PProtocolWindowNode(Items[I]);
            if P^.pwProtocol = Self then begin
              DestroyWindow(P^.pwWindow);
              Remove(Items[I]);
              Dispose(P);
              break;
            end;
          end;

    ProtocolType := ptNoProtocol;
    apDoneProtocol(PData);
    inherited Destroy;
  end;

  procedure TApdCustomProtocol.Assign(Source : TPersistent);
    {-Assign Source to Self}
  var
    SrcType : TProtocolType;

  begin
    if Source is TApdCustomProtocol then begin
      {Note the current protocol type, then force deallocation of
       internal pointers}
      SrcType := TApdCustomProtocol(Source).ProtocolType;
      TApdCustomProtocol(Source).ProtocolType := ptNoProtocol;

      {Force the destination to noprotocol as well}
      ProtocolType := ptNoProtocol;

      {$IFDEF Win32}
      {Free the existing critsection pointer}
      DeleteCriticalSection(PData^.aProtSection);
      {$ENDIF}

      {Assign new property values}
      Move(TApdCustomProtocol(Source).PData^, PData^, SizeOf(TProtocolData));

      {$IFDEF Win32}
      {Overwrite the copied critsection pointer with our own}
      InitializeCriticalSection(PData^.aProtSection);
      {$ENDIF}

      NeedBPS           := TApdCustomProtocol(Source).NeedBPS;
      ProtFunc          := TApdCustomProtocol(Source).ProtFunc;
      Force             := TApdCustomProtocol(Source).Force;
      FMsgHandler       := TApdCustomProtocol(Source).FMsgHandler;
      FComPort          := TApdCustomProtocol(Source).FComPort;
      FStatusDisplay    := TApdCustomProtocol(Source).FStatusDisplay;
      FProtocolLog      := TApdCustomProtocol(Source).FProtocolLog;
      FXYmodemBlockWait := TApdCustomProtocol(Source).FXYmodemBlockWait;
      FZmodemOptionOverride := TApdCustomProtocol(Source).FZmodemOptionOverride;
      FZmodemSkipNoFile := TApdCustomProtocol(Source).FZmodemSkipNoFile;
      FZmodemFileOption := TApdCustomProtocol(Source).FZmodemFileOption;
      FZmodemRecover    := TApdCustomProtocol(Source).FZmodemRecover;
      FZmodem8K         := TApdCustomProtocol(Source).FZmodem8K;
      FZmodemZRQINITValue := TApdCustomProtocol(Source).FZmodemZRQINITValue;
      FKermitMaxLen     := TApdCustomProtocol(Source).FKermitMaxLen;
      FKermitMaxWindows := TApdCustomProtocol(Source).FKermitMaxWindows;
      FKermitSWCTurnDelay := TApdCustomProtocol(Source).FKermitSWCTurnDelay;
      FKermitTimeoutSecs := TApdCustomProtocol(Source).FKermitTimeoutSecs;
      FKermitTerminator := TApdCustomProtocol(Source).FKermitTerminator;
      FKermitCtlPrefix  := TApdCustomProtocol(Source).FKermitCtlPrefix;
      FKermitHighbitPrefix := TApdCustomProtocol(Source).FKermitHighbitPrefix;
      FKermitRepeatPrefix := TApdCustomProtocol(Source).FKermitRepeatPrefix;
      FAsciiCharDelay   := TApdCustomProtocol(Source).FAsciiCharDelay;
      FAsciiLineDelay   := TApdCustomProtocol(Source).FAsciiLineDelay;
      FAsciiEOLChar     := TApdCustomProtocol(Source).FAsciiEOLChar;
      FAsciiCRTranslation := TApdCustomProtocol(Source).FAsciiCRTranslation;
      FAsciiLFTranslation := TApdCustomProtocol(Source).FAsciiLFTranslation;
      FAsciiEOFTimeout  := TApdCustomProtocol(Source).FAsciiEOFTimeout;
      FOnProtocolAccept   := TApdCustomProtocol(Source).FOnProtocolAccept;
      FOnProtocolError    := TApdCustomProtocol(Source).FOnProtocolError;
      FOnProtocolFinish   := TApdCustomProtocol(Source).FOnProtocolFinish;
      FOnProtocolLog      := TApdCustomProtocol(Source).FOnProtocolLog;
      FOnProtocolNextFile := TApdCustomProtocol(Source).FOnProtocolNextFile;
      FOnProtocolResume   := TApdCustomProtocol(Source).FOnProtocolResume;
      FOnProtocolStatus   := TApdCustomProtocol(Source).FOnProtocolStatus;

      {Set both protocols back to the src protocol type}
      ProtocolType        := SrcType;
      TApdCustomProtocol(Source).ProtocolType := SrcType;
    end;
  end;

  function TApdCustomProtocol.EstimateTransferSecs(const Size : Longint) : Longint;
    {-Returns ticks to send Size bytess}
  begin
    Result := apEstimateTransferSecs(PData, Size);
  end;

  function TApdCustomProtocol.StatusMsg(const Status : Cardinal) : String;
    {-Return a resource string for Status}
  var
    P : array[0..MaxMessageLen] of Char;
  begin
    apStatusMsg(P, Status);
    Result := StrPas(P);
  end;

  procedure TApdCustomProtocol.StartTransmit;
    {-Start a transmit protocol session}
  begin
    with PData^ do begin
      {Exit quitely if no protocol selected}
      if FProtocolType = ptNoProtocol then
        Exit;

      {Make sure comport is open, pass handle to protocol}
      CheckPort;
      if Assigned(FComPort) then
        apSetProtocolPort(PData, FComPort)
      else
        raise EPortNotAssigned.Create(ecPortNotAssigned, False);

      {Set the protocol's aActCPS field if it isn't already set}
      if NeedBPS then with FComPort do begin
        ActualBPS := Baud;
        NeedBPS := False;
      end;

      {Start the protocol}
      if (FProtocolType >= ptNoProtocol) and
         (FProtocolType <= ptBPlus) then begin
        ProtFunc := ProtFuncs[FProtocolType, True];
        apStartProtocol(PData, Ord(FProtocolType), True,
                        PrepProcs[FProtocolType, True],
                        ProtFunc);
      end;
    end;
  end;

  procedure TApdCustomProtocol.StartReceive;
    {-Start a protocol receive session}
  begin
    with PData^ do begin
      {Exit quietly if no protocol selected}
      if FProtocolType = ptNoProtocol then
        Exit;

      {Make sure comport is open, pass handle to protocol}
      if Assigned(FComPort) then
        apSetProtocolPort(PData, FComPort)
      else
        raise EPortNotAssigned.Create(ecPortNotAssigned, False);

      {Set the protocol's aActCPS field if it isn't already set}
      if NeedBPS then with FComPort do begin
        ActualBPS := Baud;
        NeedBPS := False;
      end;

      {Start the protocol}
      if (FProtocolType >= ptNoProtocol) and
         (FProtocolType <= ptBPlus) then begin
        ProtFunc := ProtFuncs[FProtocolType, False];
        apStartProtocol(PData, Ord(FProtocolType), True,
                        PrepProcs[FProtocolType, False],
                        ProtFunc);
      end;
    end;
  end;

  procedure TApdCustomProtocol.CancelProtocol;
    {-Sends apw_ProtocolCancel message to protocol function}
  begin
    with PData^ do
      if (@ProtFunc <> nil) and InProgress then
        ProtFunc(APW_PROTOCOLCANCEL, 0, LongInt(aHC.ValidDispatcher.handle) shl 16)
  end;

{TApdAbstractStatus}

  procedure TApdAbstractStatus.Notification(AComponent : TComponent;
                                            Operation: TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      if AComponent = FProtocol then
        FProtocol := nil;
    end;
  end;

  procedure TApdAbstractStatus.SetPosition(const NewPosition : TPosition);
  begin
    if NewPosition <> FPosition then begin
      FPosition := NewPosition;
      if Assigned(FDisplay) then
        FDisplay.Position := NewPosition;
    end;
  end;

  procedure TApdAbstractStatus.SetCtl3D(const NewCtl3D : Boolean);
  begin
    if NewCtl3D <> FCtl3D then begin
      FCtl3D := NewCtl3D;
      if Assigned(FDisplay) then
        FDisplay.Ctl3D := NewCtl3D;
    end;
  end;

  procedure TApdAbstractStatus.SetVisible(const NewVisible : Boolean);
  begin
    if NewVisible <> FVisible then begin
      FVisible := NewVisible;
      if Assigned(FDisplay) then
        FDisplay.Visible := NewVisible;
    end;
  end;

  procedure TApdAbstractStatus.SetCaption(const NewCaption : TCaption);
  begin
    if NewCaption <> FCaption then begin
      FCaption := NewCaption;
      if Assigned(FDisplay) then
        FDisplay.Caption := NewCaption;
    end;
  end;

  procedure TApdAbstractStatus.GetProperties;
  begin
    if Assigned(FDisplay) then begin
      Position := FDisplay.Position;
      Ctl3D    := FDisplay.Ctl3D;
      Visible  := FDisplay.Visible;
      Caption  := FDisplay.Caption;
    end;
  end;

  constructor TApdAbstractStatus.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);
    CreateDisplay;
    GetProperties;
    Caption := 'Protocol Status';
  end;

  destructor TApdAbstractStatus.Destroy;
  begin
    DestroyDisplay;
    inherited Destroy;
  end;

  procedure TApdAbstractStatus.Show;
  begin
    if Assigned(FDisplay) then
      FDisplay.Show;
  end;

{TApdProtocolLog}

  procedure TApdProtocolLog.Notification(AComponent : TComponent;
                                         Operation: TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      {Owned components going away}
      if AComponent = FProtocol then
        FProtocol := nil;
    end;
  end;

  constructor TApdProtocolLog.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);

    {Inits}
    HistoryName := awpDefHistoryName;
    DeleteFailed := awpDefDeleteFailed;
  end;

  procedure TApdProtocolLog.UpdateLog(const Log : Cardinal);
    {-Update the standard log}
  var
    CPS : Cardinal;
    HisFile : TextFile;

    function DirectionString : String;
    begin
      case Log of
        lfReceiveStart, lfReceiveOk, lfReceiveSkip, lfReceiveFail :
          DirectionString := ' receive ';
        lfTransmitStart, lfTransmitOk, lfTransmitFail, lfTransmitSkip :
          DirectionString := ' transmit ';
      end;
    end;

  begin
    {Exit if no name specified}
    if FHistoryName = '' then
      Exit;

    {Create or open the history file}
    try
      AssignFile(HisFile, FHistoryName);
      Append(HisFile);
    except
      on E : EInOutError do
        if E.ErrorCode = 2 then
          {File not found, open as new}
          Rewrite(HisFile)
        else
          {Unexpected error, forward the exception}
          raise;
    end;

    {Write the log entry}
    with Protocol, pData^ do begin
      case Log of
        lfReceiveStart,
        lfTransmitStart :
          WriteLn(HisFile, ProtocolName(ProtocolType),
                           DirectionString,
                           'started on  ',
                           DateTimeToStr(Now), ' : ',
                           FileName);

        lfReceiveOk,
        lfTransmitOK :
          begin
            WriteLn(HisFile, ProtocolName(ProtocolType),
                             DirectionString,
                             'finished OK ',
                             DateTimeToStr(Now), ' : ',
                             FileName);
            if ElapsedTicks < 18 then
              CPS := FileLength
            else
              CPS := (FileLength div Ticks2Secs(ElapsedTicks));
            WriteLn(HisFile, '   Elapsed time: ',
                             FormatMinSec(Ticks2Secs(ElapsedTicks)),
                          '   CPS: ', CPS,
                          '   Size: ', FileLength, ^M^J);
          end;

        lfReceiveSkip :
          WriteLn(HisFile, ProtocolName(ProtocolType),
                           ' receive skipped ', FileName, ' ',
                           StatusMsg(ProtocolStatus), ^M^J);

        lfReceiveFail :
          begin
            WriteLn(HisFile, ProtocolName(ProtocolType),
                             ' receive failed ', FileName, ' ',
                             StatusMsg(ProtocolStatus), ^M^J);

            case FDeleteFailed of
              dfNever  :
                {Leave the partial file intact} ;
              dfAlways :
                if aProtocolError <> ecCantWriteFile then
                  DeleteFile(FileName);
              dfNonRecoverable :
                if (ProtocolType <> ptZmodem) and
                   (ProtocolType <> ptBPlus) and
                   (aProtocolError <> ecCantWriteFile) then
                  DeleteFile(FileName);
            end;
          end;

        lfTransmitFail :
          WriteLn(HisFile, ProtocolName(ProtocolType),
                           ' transmit failed ', FileName, ' ',
                           StatusMsg(ProtocolStatus), ^M^J);
        lfTransmitSkip :
          WriteLn(HisFile, ProtocolName(ProtocolType),
                           ' transmit skipped ', FileName, ' ',
                           StatusMsg(ProtocolStatus), ^M^J);
      end;
    end;

    Close(HisFile);
    if IOResult <> 0 then ;
  end;

{Miscellaneous functions}

  function ProtocolName(const ProtocolType : TProtocolType) : String;
    {-Return a string of the protocol type}
  begin
    if (ProtocolType >= ptNoProtocol) and (ProtocolType <= ptBPlus) then
      Result := StrPas(ProtocolString[Ord(ProtocolType)])
    else
      Result := StrPas(ProtocolString[0]);
  end;

  function CheckNameString(const Check : TBlockCheckMethod) : String;
    {-Return a string of the block check type}
  begin
    case Check of
      bcmChecksum   : Result := bcsChecksum1;
      bcmChecksum2  : Result := bcsChecksum2;
      bcmCrc16      : Result := bcsCrc16;
      bcmCrc32      : Result := bcsCrc32;
      bcmCrcK       : Result := bcsCrcK;
      else            Result := bcsNone;
    end;
  end;

  function FormatMinSec(const TotalSecs : LongInt) : String;
    {-Format TotalSecs as minutes:seconds, leftpadded to 6}
  var
    Min, Sec : LongInt;
    S : String;
  begin
    Min := TotalSecs div 60;
    Sec := TotalSecs mod 60;
    Str(Sec:2, S);
    if S[1] = ' ' then
      S[1] := '0';
    FormatMinSec := LeftPad(IntToStr(Min) + ':' + S, 6);
  end;

{$IFNDEF Win32}
procedure ProtExitProc; far;
begin
  ProtList.Free;
end;
{$ENDIF}

initialization
  ProtList := TList.Create;

{$IFNDEF Win32}
  AddExitProc(ProtExitProc);
{$ELSE}
finalization
  ProtList.Free;
{$ENDIF}
end.

