adpager.pas

Async Professional 4.04

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

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

    procedure FreeLoginTriggers;
    procedure FreeLogoutTriggers;
    procedure FreeMsgTriggers;
    procedure FreeResponseTriggers;
    function HandleToTrigger(TriggerHandle: Word): string;
    procedure InitLoginTriggers;
    procedure InitLogoutTriggers;
    procedure InitMsgTriggers;
    procedure DoCurMessageBlock;
    procedure DoFirstMessageBlock;
    procedure DoNextMessageBlock;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Send; override;
    procedure ReSend;
    procedure Disconnect;

    function TAPStatusMsg(Status: TTAPStatus): string;

  published
    property Port;
    property PagerID;
    property Message;
    property PagerLog;

    property AbortNoConnect;
    property BlindDial;
    property DialAttempt;
    property DialAttempts;
    property DialPrefix;
    property DialRetryWait;
    property DialWait;
    property ExitOnError;
    property ModemHangup;
    property ModemInit;
    property PhoneNumber;
    property ToneDial;