adprotcl.pas

Async Professional 4.04

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

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

{Options required for this unit}
{$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,
  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,
    ptKermit,
    ptAscii);

  {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, just use the ones in OOMisc}
  {apFirstCall          = OoMisc.apFirstCall;}                           {!!.02}
  {apLastCall           = OoMisc.apLastCall;}                            {!!.02}

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

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

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

type
  TApdAbstractStatus = class;
  TApdProtocolLog = class;

  {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;

  TProtocolNextFileEvent = procedure(CP : TObject; var FName : TPassString)
                           of object;
  TProtocolAcceptEvent   = procedure(CP : TObject;
                                     var Accept : Boolean;
                                     var FName : TPassString) of object;

  {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;