adpager.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 ***** *)

{*********************************************************}
{*                   ADPAGER.PAS 4.06                    *}
{*********************************************************}
{* TApdTAPPager, TApdSNPPPager components                *}
{*********************************************************}

{
  These components have lots of little problems that pop up
  occasionally.  The TApdPager component in AdPgr.pas is an
  initial stab at cleaning the code up to make it more efficient
  and maintainable.
}

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

{ Changes too numerous for !!.01 markings to be effective }
{ Many changes for .02 also to fix several known problems, there are still     }
{ several known problems, which will be addressed through interim code changes }
{ leading up to a rewrite for .03.  The rewrite will primarily serve to make   }
{ the code more maintainable and expandable.}
unit AdPager;

interface

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

const
  atpCRLF = cCR + cLF;
  CmdLen = 41;
  MAX_MSG_LEN = 80;
  STD_DELAY: Integer = 9;  { wait half a sec.}

  adpgDefAbortNoConnect = False;
  adpgDefBlindDial      = False;
  adpgDefToneDial       = True;
  adpgDefExitOnError    = False;
  adpgDefDialAttempts   = 3;
  adpgDefDialRetryWait  = 30;
  adpgDefDialWait       = 60;
  adpgDefTimerTrig      = 1080;                                          {!!.04}
  adpgPulseDialPrefix   = 'DP';
  adpgToneDialPrefix    = 'DT';
  adpgDefDialPrefix     = adpgToneDialPrefix;
  adpgDefModemInitCmd   = 'ATZ' {+ atpCRLF};
  adpgDefNormalInit       = 'X4';
  adpgDefBlindInit        = 'X3';
  adpgDefNoDetectBusyInit = 'X2';
  adpgDefX1Init           = 'X1';
  adpgDefInit             = adpgDefNormalInit;
  adpgDefModemHangupCmd = '+++~~~ATH';
  adpgDefPagerHistoryName     = 'APROPAGR.HIS';

const
  { TDialingStatus }
  TDS_NONE              = 4600;
  TDS_OFFHOOK           = 4601;
  TDS_DIALING           = 4602;
  TDS_RINGING           = 4603;
  TDS_WAITFORCONNECT    = 4604;
  TDS_CONNECTED         = 4605;
  TDS_WAITINGTOREDIAL   = 4606;
  TDS_REDIALING         = 4607;
  TDS_MSGNOTSENT        = 4608;
  TDS_CANCELLING        = 4609;
  TDS_DISCONNECT        = 4610;
  TDS_CLEANUP           = 4611;

  { TDialingError }
  TDE_NONE              = 4630;
  TDE_NODIALTONE        = 4631;
  TDE_LINEBUSY          = 4632;
  TDE_NOCONNECTION      = 4633;

  { TTapStatus }
  TPS_NONE              = 4660;
  TPS_LOGINPROMPT       = 4661;
  TPS_LOGGEDIN          = 4662;
  TPS_LOGINERR          = 4663;
  TPS_LOGINFAIL         = 4664;
  TPS_MSGOKTOSEND       = 4665;
  TPS_SENDINGMSG        = 4666;
  TPS_MSGACK            = 4667;
  TPS_MSGNAK            = 4668;
  TPS_MSGRS             = 4669;
  TPS_MSGCOMPLETED      = 4670;
  TPS_DONE              = 4671;

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

type
  TTriggerHandle = Word;
  TCmdString = string{[CmdLen]};                                         {!!.02}

  { forward class declaration }
  TApdPagerLog = class;

  TApdAbstractPager = class(TApdBaseComponent)
  private
    FPort      : TApdCustomComPort;
    FPagerID   : string;
    FMessage   : TStrings;
    FPagerLog  : TApdPagerLog;  {Logging component}
    FExitOnError: Boolean;
    FPageMode, FFailReason: string;
    procedure WriteToEventLog(const S: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;

    procedure Send; virtual; abstract;

    procedure SetMessage(Msg: TStrings); virtual;
    procedure SetPagerID(ID: string); virtual;
    procedure SetPagerLog(const NewLog : TApdPagerLog);

    property Message: TStrings
      read FMessage write SetMessage;

    property PagerID: string
      read FPagerID write SetPagerID;

    property PagerLog : TApdPagerLog
      read FPagerLog write SetPagerLog;

    property ExitOnError: Boolean
      read FExitOnError write FExitOnError default adpgDefExitOnError;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  end;

  {Builtin log procedure}
  TApdPagerLog = class(TApdBaseComponent)
  protected {private}
    {.Z+}
    FHistoryName   : String;
    FPager         : TApdAbstractPager;

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

  public
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdPagerLog component}
    {.Z-}
    procedure UpdateLog(const LogStr: string); virtual;
      {-Add a log entry}
  published
    property Pager : TApdAbstractPager
      read FPager write FPager;
    property HistoryName : String
      read FHistoryName write FHistoryName;
  end;

type
  TDialingCondition = (
    dsNone, dsOffHook, dsDialing, dsRinging, dsWaitForConnect, dsConnected,
    dsWaitingToRedial, dsRedialing, dsMsgNotSent, dsCancelling, dsDisconnect,
    dsCleanup, deNone, deNoDialTone, deLineBusy, deNoConnection);

  TDialingStatus = dsNone..dsCleanup;
  TDialStatusEvent = procedure(Sender: TObject; Event: TDialingStatus) of object;

  TDialError = deNone..deNoConnection;
  TDialErrorEvent = procedure(Sender: TObject; Error: TDialError) of object;

  TApdCustomModemPager = class(TApdAbstractPager)

  private
  {private data fields}
    FTapiDev     : TApdTapiDevice; 

    { dialing status }
    mpGotOkay,
    FConnected,
    FSent,
    FAborted,
    Waiting, FCancelled  : Boolean;
    FDialStatus : TDialingStatus;
    FDialError  : TDialError;
    FDirectToPort : Boolean;

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

    FDialAttempt,
    FDialAttempts,
    FDialRetryWait,
    FDialWait: Word;

    FDialPrefix,
    FModemHangup,
    FModemInit: TCmdString;

    FPhoneNumber : string;      { phone number to dial }

    FUseTapi     : Boolean;

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

    {event handler fields}
    FOnDialStatus: TDialStatusEvent;
    FOnDialError : TDialErrorEvent;

    procedure AddInitModemDataTrigs;
    procedure DoOpenPort;  
    procedure DoDirect; virtual;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);{!!.02}
      override;                                                          {!!.02}
    {overridables for custom descendants}
    procedure DoCleanup; virtual;
    procedure DoDial; virtual;

    procedure DoStartCall; virtual;
    procedure TerminatePage; virtual;                                    {!!.02}
    procedure DoFailedToSend; virtual;

    procedure DoInitializePort;

    function GetTapiDev: TApdTapiDevice;
    property TapiDev : TApdTapiDevice
      read GetTapiDev;
    procedure SetUseTapi(const Value: Boolean);
    procedure SetTapiDev(const Value: TApdTapiDevice);
    procedure InitProperties; virtual;
    procedure SetPortOpts; virtual;

    procedure DoDialStatus(Event: TDialingCondition);
    procedure InitCallStateFlags;

    {property access methods}
    procedure SetBlindDial(BlindDialVal: Boolean);
    procedure SetDialPrefix(CmdStr: TCmdString);
    procedure SetModemHangup(CmdStr: TCmdString);
    procedure SetModemInit(CmdStr: TCmdString);
    function GetPort : TApdCustomComPort;
    procedure SetPort(ThePort: TApdCustomComPort); virtual;
    procedure SetToneDial(ToneDial: Boolean);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    function DialStatusMsg(Status: TDialingCondition): string;

    property Port: TApdCustomComPort
      read GetPort write SetPort;

    property AbortNoConnect: Boolean
      read FAbortNoConnect write FAbortNoConnect default adpgDefAbortNoConnect;
    property BlindDial : Boolean
      read FBlindDial write SetBlindDial default adpgDefBlindDial;
    property DialAttempt: Word
      read FDialAttempt write FDialAttempt;
    property DialAttempts: Word
      read FDialAttempts write FDialAttempts default adpgDefDialAttempts;
    property DialPrefix: TCmdString
      read FDialPrefix write SetDialPrefix;
    property DialRetryWait: Word
      read FDialRetryWait write FDialRetryWait default adpgDefDialRetryWait;
    property DialWait: Word
      read FDialWait write FDialWait default adpgDefDialWait;
    property ModemHangup: TCmdString
      read FModemHangup write SetModemHangup;
    property ModemInit: TCmdString
      read FModemInit write SetModemInit;
    property PhoneNumber: string
      read FPhoneNumber write FPhoneNumber;
    property ToneDial: Boolean
      read FToneDial write SetToneDial default adpgDefToneDial;
    property DirectToPort : Boolean
      read FDirectToPort write FDirectToPort default False;
    property UseTapi: Boolean
      read FUseTapi write SetUseTapi default False;
    property TapiDevice: TApdTapiDevice
      read FTapiDev write SetTapiDev;
    property OnDialError: TDialErrorEvent
      read FOnDialError write FOnDialError;
    property OnDialStatus: TDialStatusEvent
      read FOnDialStatus write FOnDialStatus;

    //procedure Send; override;                                          {!!.04}
    procedure CancelCall; virtual;

  end;

{utility definitions and routines }
const
  {TAP server repsonse sequences}
  TAP_ID_PROMPT   : string = 'ID=';
  TAP_LOGIN_ACK   : string = cAck + cCr;
  TAP_LOGIN_NAK   : string = cNak + cCr;
  TAP_LOGIN_FAIL  : string = cEsc + cEot + cCr;

  TAP_MSG_OKTOSEND: string = cEsc + '[p';
  TAP_MSG_ACK     : string = cAck + cCr;
  TAP_MSG_NAK     : string = cNak + cCr;
  TAP_MSG_RS      : string = cRs + cCr;

  TAP_DISCONNECT  : string = cEsc + cEot + cCr;


  TAP_AUTO_LOGIN  : string = cEsc + 'PG1' {+ cCr};
  TAP_LOGOUT      : string = cEot + cCr;

  MAX_TAP_RETRIES = 3;

type
  TTapStatus = (psNone, psLoginPrompt, psLoggedIn, psLoginErr,
    psLoginFail, psMsgOkToSend, psSendingMsg, psMsgAck, psMsgNak,
    psMsgRs, psMsgCompleted, psDone, psSendTimedOut);
  TTAPStatusEvent = procedure(Sender: TObject; Event: TTapStatus) of object;

  TTapGetNextMessageEvent = procedure (Sender      : TObject;
                                   var DoneMessages: Boolean) of object;


  TApdTAPPager = class(TApdCustomModemPager)
  private
  {private data fields}
    FUseEscapes  : Boolean;  { use escaping mechanism when sending; }
                             { otherwise strip chars}
    FMaxMsgLen   : Integer;
    FPassword    : string;

    FBlocks: TStrings;
    FMsgIdx: Integer;

    FtrgIDPrompt,
    FtrgLoginSucc,
    FtrgLoginFail,
    FtrgLoginErr,
    FtrgOkToSend,
    FtrgMsgAck,
    FtrgMsgNak,
    FtrgMsgRs,
    FtrgSendTimer,                                                       {!!.04}
    FtrgDCon: TTriggerHandle;

    tpPingTimer : TTimer;
    tpPingCount : Integer;
    tpTAPRetries : Integer;
    FTapWait : Integer;
  {event handler fields}
    FPageStatus : TTAPStatus;

    FOnTAPFinish: TNotifyEvent;
    FOnTAPStatus: TTAPStatusEvent;
    FOnGetNextMessage: TTapGetNextMessageEvent;
    procedure PingTimerOnTimer(Sender: TObject);
    procedure StartPingTimer;
    procedure DonePingTimer;

  protected
    procedure DoDirect; override;
    procedure DoTAPStatus(Status: TTapStatus);
    procedure DoStartCall; override;
    procedure InitProperties; override;

    procedure SetPort(ThePort: TApdCustomComPort); override;
    procedure TerminatePage; override;                                   {!!.02}

    procedure DataTriggerHandler(Msg, wParam: Cardinal; lParam: LongInt);