adpgr.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                    ADPGR.PAS 4.06                     *}
{*********************************************************}
{* TApdPager component                                   *}
{*********************************************************}

{
  Due to the many little problems with the TApdTAPPager and TApdSNPPPager,
  we rewrote them in the consolidated TApdPager component. Both TAP and
  SNPP are supported in this one component. This should be a lot cleaner,
  easier to maintain, and easier to enhance component than the dedicated
  TAP and SNPP pager components.
}

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

unit AdPgr;

interface

uses                                                           
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  OoMisc,
  AdPort,
  AdExcept,
  AdTapi,
  AdTUtil,
  AdWnPort,
  AdPacket;

type
  
  { PortOpts property for TAP }
  TPortOpts = (p7E1, p8N1, pCustom);
  TPortOptsSet = set of TPortOpts;

  { types of PagerMode property options }
  TApdPagerMode = (pmTAP, pmSNPP);
  TPagerModeSet = set of TApdPagerMode;

  { Pager Status }
  TPageStatus = (psNone, psInitFail, psConnected, psLineBusy, psDisconnect,
  psNoDialtone, psMsgNotSent, psWaitingToRedial, psLoginPrompt, psLoggedIn,
  psDialing, psRedialing, psLoginRetry, psMsgOkToSend, psSendingMsg,
  psMsgAck, psMsgNak, psMsgRs, psMsgCompleted, psSendTimedOut, psLoggingOut,
  psDone);


const
  atpCRLF = cCR + cLF;     { carriage return, line feed }
  MAX_MSG_LEN = 80;        { default message length }
  STD_DELAY: Integer = 9;  { wait half a sec.}

  { Default values }
  adpgDefAbortNoConnect = False;
  adpgDefBlindDial      = False;
  adpgDefToneDial       = True;
  adpgDefExitOnError    = False;
  adpgDefUseEscapes     = False;
  adpgDefDialAttempts   = 3;
  adpgDefDialRetryWait  = 30;
  adpgDefTimerTrig      = 1080;
  adpgDefPagerMode      = pmTap;
  adpgDefPortOpts       = p7E1;

  { FTonePrefix options }
  adpgPulseDialPrefix   = 'DP';
  adpgToneDialPrefix    = 'DT';

  { Modem commands }
  adpgDefModemInitCmd   = 'ATZ';
  adpgDefModemHangupCmd = '+++~~~ATH';

    { DataTriggerHandlers for modem response }
  FapOKTrig         : string = 'OK';
  FapErrorTrig      : string = 'ERROR';
  FapConnectTrig    : string = 'CONNECT';
  FapBusyTrig       : string = 'BUSY';
  FapNoCarrierTrig  : string = 'NO CARRIER';
  FapNoDialtoneTrig : string = 'NO DIALTONE';   

type
  { forwards }
  TApdCustomPager = class;

  { Event declarations }
  TPageStatusEvent = procedure(Pager: TApdCustomPager;
                                Event: TPageStatus;
                               Param1: Integer;
                               Param2: Integer) of object;
  TPageErrorEvent = procedure(Pager: TApdCustomPager;
                                Code: Integer) of object;
  TPageFinishEvent = procedure(Pager: TApdCustomPager; Code: Integer; Msg: string)
    of object;
  TTapGetNextMessageEvent = procedure (Pager: TApdCustomPager;
                                   var DoneMessages: Boolean) of object;

  { Undocumented log class. }
  TApdPgrLog = class(TPersistent)
    private
      FOwner : TApdCustomPager;
      FVerboseLog: Boolean;
      FEnabled: Boolean;
      FLogName: string;
    public
      constructor Create(Owner : TApdCustomPager);
      procedure AddLogString(Verbose : Boolean;
                           const StatusString : string);
      procedure ClearLog;
    published
      property LogName : string
        read FLogName write FLogName;
      property VerboseLog : Boolean
        read FVerboseLog write FVerboseLog;
      property Enabled : Boolean
        read FEnabled write FEnabled;
  end;

  { class declaration }
  TApdCustomPager = class(TApdBaseComponent)

  private
    FPort       : TApdCustomComPort;
    FTapiDevice : TApdTapiDevice;
    FOrigTapiConfig: TTapiConfigRec;
    FEventLog   : TApdPgrLog;
    FPagerID    : string;
    FMessage    : TStrings;
    FExitOnError: Boolean;
    FUseEscapes : Boolean;

    FHandle: THandle;

    mpGotOkay,
    FConnected,
    FSent,
    FAborted,
    FRedialFlag,
    FLoginRetry,
    FTerminating,
    FCancelled  : Boolean;

    {property storage fields}
    FAbortNoConnect,
    FBlindDial,
    FToneDial,
    FTapHotLine: Boolean;

    FDialAttempt,
    FDialAttempts: Word;

    FDialPrefix,
    FModemHangup,
    FModemInit: string;

    FPhoneNumber : string;      { phone number to dial }
    FTonePrefix  : string;       { phone tone prefix - FTonePrefix }

    { Modem response data trigger handler fields }
    OKTrig,
    ErrorTrig,
    ConnectTrig,
    BusyTrig,
    NoCarrierTrig,
    NoDialtoneTrig : Word;

        { SNPP private data fields}
    FOkayToSend,
    FSessionOpen,
    FQuit: Boolean;

    FGotSuccess : Boolean;

    FLoginPacket,
    FServerSuccPacket,
    FServerDataMsgPacket,
    FServerErrorPacket,
    FServerFatalErrorPacket,
    FServerDonePacket: TApdDataPacket;

    { TAP private data fields }
    FPassword    : string;

    FMsgBlockList: TStringList;
    FMsgIdx: Integer;

    FtrgIDPrompt,
    FtrgLoginSucc,
    FtrgLoginFail,
    FtrgLoginRetry,
    FtrgOkToSend,
    FtrgMsgAck,
    FtrgMsgNak,
    FtrgMsgRs,
    FtrgSendTimer,
    FtrgDCon: Word;

    tpPingTimer,
    tpModemInitTimer,                                                    {!!.06}
    WaitTimer  : TTimer;
    tpPingCount,
    FTapWait,
    TempWait : Integer;

    { Pager Events }
    FOnPageFinish    : TPageFinishEvent;
    FOnPageStatus    : TPageStatusEvent;
    FOnPageError     : TPageErrorEvent;
    FOnGetNextMessage: TTapGetNextMessageEvent;

    { property storage }
    FServerInitString,
    FServerDoneString,
    FServerSuccStr,
    FServerDataInp,
    FServerRespFailCont,
    FServerRespFailTerm: string;

    FCommDelay: Integer;

    FMaxMessageLength: Integer;
    FPagerMode: TApdPagerMode;
    FPortOpts: TPortOpts;
    FPortOpenedByUser: Boolean;                                          {!!.06}

    FPageMode,
    FLogName: string;


        { TAP }
    procedure DoDial;
    procedure DoInitializePort;
    procedure DoPortOpenCloseEx(CP: TObject; CallbackType : TApdCallbackType);
    procedure InitCallStateFlags;
    procedure SetUseEscapes(UseEscapesVal: Boolean);
    procedure AddInitModemDataTrigs;
    procedure SetPortOpts;
    procedure DoOpenPort;
    procedure BuildTapMessages;
    procedure ModemInitTimerOnTimer(Sender: TObject);                    {!!.06}
    procedure PingTimerOnTimer(Sender: TObject);
    procedure WaitTimerOnTimer(Sender: TObject);
    procedure DoneModemInitTimer;                                        {!!.06}
    procedure DonePingTimer;
    procedure FreeTrigger(Port: TApdCustomComPort;
                       var Trigger: Word);

    { SNPP }
    procedure FreePackets;
    procedure InitPackets;
    procedure DoLoginString(Sender: TObject; Data: String);
    procedure DoServerSucc(Sender: TObject; Data: String);
    procedure DoServerDataMsg(Sender: TObject; Data: String);
    procedure DoServerError(Sender: TObject; Data: String);
    procedure DoServerFatalError(Sender: TObject; Data: String);
    procedure DoLogoutString(Sender: TObject; Data: String);
    procedure PutString(const S: string);
    procedure DoMultiLine;
    procedure MakePacket(ThePacket: TApdDataPacket; StartStr, EndStr: string;
      HandlerMethod: TStringPacketNotifyEvent);

  protected
    procedure Notification(AComponent: TComponent;
                            Operation: TOperation); override;
    procedure SetMessage(Msg: TStrings);
    procedure SetPagerID(ID: string);

    { Events to Call }
    procedure DoPageStatus(Status: TPageStatus);
    procedure DoPageError(Error: Integer);

    property Handle : THandle read FHandle;
    procedure WndProc(var Message: TMessage);

    { TAP }
    procedure DoStartCall;
    procedure TerminatePage;
    procedure DoFailedToSend;
    procedure LogOutTAP;
    procedure DataTriggerHandler(Msg, wParam: Cardinal; lParam: LongInt);
    procedure DoPageStatusTrig(Trig: Cardinal);
    procedure FreeLoginTriggers;
    procedure FreeLogoutTriggers;
    procedure FreeMsgTriggers;
    procedure FreeResponseTriggers;
    procedure InitLoginTriggers;
    procedure InitLogoutTriggers;
    procedure InitMsgTriggers;
    procedure DoCurMessageBlock;
    procedure DoFirstMessageBlock;
    procedure DoNextMessageBlock;

    { SNPP }
    property ServerInitString: string
      read FServerInitString write FServerInitString;
    property ServerSuccessString: string
      read FServerSuccStr write FServerSuccStr;
    property ServerDataInput: string
      read FServerDataInp write FServerDataInp;
    property ServerResponseFailContinue: string
      read FServerRespFailCont write FServerRespFailCont;
    property ServerResponseFailTerminate: string
      read FServerRespFailTerm write FServerRespFailTerm;
    property ServerDoneString: string
      read FServerDoneString write FServerDoneString;

    procedure PutMessage; virtual;
    procedure PutSend; virtual;
    procedure PutQuit; virtual;

  public

    { Message }
    property Message: TStrings
      read FMessage write SetMessage;
    { PagerID }
    property PagerID: string
      read FPagerID write SetPagerID;
    { Exit if an error occurs }
    property ExitOnError: Boolean
      read FExitOnError write FExitOnError;
    { Use Escape sequences }
    property UseEscapes: Boolean
      read FUseEscapes write SetUseEscapes;
    { Port used in AdPgr unit }
    property Port: TApdCustomComPort
      read FPort write FPort;
    { Assigned TAPI device for AdPgr - if any }
    property TapiDevice: TApdTapiDevice
      read FTapiDevice write FTapiDevice;
    { Type of Pager used: pmTAP or pmSNPP }
    property PagerMode: TApdPagerMode
      read FPagerMode write FPagerMode;

    property PortOpts: TPortOpts
      read FPortOpts write FPortOpts;
    property AbortNoConnect: Boolean
      read FAbortNoConnect write FAbortNoConnect;

    property LogName : string
      read FLogName write FLogName;

    property Password : string
      read FPassword write FPassword;

    { constructor }
    constructor Create(AOwner: TComponent); override;
    { Destructor }
    destructor Destroy; override;

    { Both }
    procedure Send;
    { TAP - Disconnect current call}
    procedure Disconnect;
    { TAP - Cancel Call and Terminate }
    procedure CancelCall;
    { Max Dial Attempts }
    property DialAttempts: Word
      read FDialAttempts write FDialAttempts;
    { TAP Phone Number }
    property PhoneNumber: string
      read FPhoneNumber write FPhoneNumber;
    { ToneDial - False for pulse phones }
    property ToneDial: Boolean
      read FToneDial write FToneDial;
    { Modem Initialization string - Default "ATZ" }
    property ModemInit : string
      read FModemInit write FModemInit;
    { Modem Hangup command - default "+++~~~ATH"}
    property ModemHangup : string
      read FModemHangup write FModemHangup;
    { Line always open to TAP server }
    property TapHotLine : Boolean
      read FTapHotLine write FTapHotLine;
    { Dial prefix - i.e. 9, to get an outside line }
    property DialPrefix : string
      read FDialPrefix write FDialPrefix;
    { Blind Dial - }
    property BlindDial : Boolean
      read FBlindDial write FBlindDial;
    { Seconds to redial - default 60 }
    property TapWait : Integer
      read FTapWait write FTapWait;
    { Maximum Message Length per message block }
    property MaxMessageLength: Integer
      read FMaxMessageLength write FMaxMessageLength;
    { SNPP }
    procedure Quit;
    property EventLog: TApdPgrLog
      read FEventLog write FEventLog;

    { events }
    property OnPageStatus : TPageStatusEvent
      read FOnPageStatus write FOnPageStatus;
    property OnPageFinish : TPageFinishEvent
      read FOnPageFinish write FOnPageFinish;
    property OnPageError : TPageErrorEvent
      read FOnPageError write FOnPageError;
    property OnGetNextMessage : TTapGetNextMessageEvent
      read FOnGetNextMessage write FOnGetNextMessage;

  end;

  { types to make the design-time interface easier to use }
  TApdTapProperties = class (TPersistent)
  private
    FOwner : TApdCustomPager;

    function GetTapWait: Integer;
    procedure SetTapWait(const Value: Integer);
    function GetTapiDevice: TApdTapiDevice;
    procedure SetTapiDevice(const Value: TApdTapiDevice);
    function GetModemInit: string;
    procedure SetModemInit(const Value: string);
    function GetModemHangup: string;
    procedure SetModemHangup(const Value: string);
    function GetDialAttempts: Word;
    procedure SetDialAttempts(const Value: Word);
    function GetDialPrefix: string;
    procedure SetDialPrefix(const Value: string);
    function GetTapHotLine: Boolean;
    procedure SetTapHotLine(const Value: Boolean);
    function GetBlindDial: Boolean;
    procedure SetBlindDial(const Value: Boolean);
    function GetToneDial: Boolean;
    procedure SetToneDial(const Value: Boolean);
    function GetMaxMessageLength: Integer;
    procedure SetMaxMessageLength(const Value: Integer);
    function GetPortOpts: TPortOpts;
    procedure SetPortOpts(const Value: TPortOpts);

  public
    constructor Create(Owner : TApdCustomPager);
  published
    property TapWait : Integer
      read GetTapWait write SetTapWait;
    property DialAttempts : Word
      read GetDialAttempts write SetDialAttempts;
    property DialPrefix : string
      read GetDialPrefix write SetDialPrefix;
    property MaxMessageLength : Integer
      read GetMaxMessageLength write SetMaxMessageLength;
    property TapHotLine : Boolean
      read GetTapHotLine write SetTapHotLine;
    property BlindDial : Boolean
      read GetBlindDial write SetBlindDial;
    property ToneDial : Boolean
      read GetToneDial write SetToneDial;
    property TapiDevice : TApdTapiDevice
      read GetTapiDevice write SetTapiDevice;
    property ModemHangup : string
      read GetModemHangup write SetModemHangup;
    property ModemInit : string
      read GetModemInit write SetModemInit;
    property PortOpts : TPortOpts
      read GetPortOpts write SetPortOpts;

  end;

  TApdPager = class(TApdCustomPager)
  private
    FTapProperties: TApdTapProperties;