adpgr.pas

Async Professional 4.04

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

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

    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 PingTimerOnTimer(Sender: TObject);
    procedure WaitTimerOnTimer(Sender: TObject);
    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;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Port;
    property PagerID;
    property EventLog;
    property Message;
    property ExitOnError;
    property Name;
    property Password;
    property PagerMode;
    property UseEscapes;

    { Properties only used for TAP messages }
    property TapProperties : TApdTapProperties