adpager.pas

测试用例

    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;
    property DirectToPort;
    property TapiDevice;
    property UseTapi;

    property TapPassword : string
      read FPassword write FPassword;
    property TapWait : Integer
      read FTapWait write FTapWait default 30;

    property MaxMessageLength: Integer
      read FMaxMsgLen write FMaxMsgLen default MAX_MSG_LEN;
    property UseEscapes: Boolean
      read FUseEscapes write FUseEscapes default False;

    property OnDialError;
    property OnDialStatus;
    property OnTAPFinish: TNotifyEvent
      read FOnTAPFinish write FOnTAPFinish;
    property OnTAPStatus: TTAPStatusEvent
      read FOnTAPStatus write FOnTAPStatus;
    property OnGetNextMessage: TTapGetNextMessageEvent
      read FOnGetNextMessage write FOnGetNextMessage;
  end;

type
  TApdCustomINetPager = class(TApdAbstractPager)
  protected
    function GetPort: TApdWinsockPort;
    procedure SetPort(ThePort: TApdWinsockPort);
  public
    constructor Create(AOwner: TComponent); override;

    property Port: TApdWinsockPort
      read GetPort write SetPort;
  end;

  TSNPPMessage = procedure(Sender: TObject; Code: Integer; Msg: string)
    of object;

  TApdSNPPPager = class(TApdCustomINetPager)
  private
  { private data fields }
    FSent, FCancelled, FOkayToSend, FSessionOpen, FQuit: Boolean;
    FGotSuccess : Boolean;

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

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

    FCommDelay: Integer;

    FOnLogin: TNotifyEvent;
    FOnLogout: TNotifyEvent;
    FOnSNPPSuccess: TSNPPMessage;
    FOnSNPPError: TSNPPMessage;

    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(S: string);
    procedure DoMultiLine;
    procedure MakePacket(ThePacket: TApdDataPacket; StartStr, EndStr: string;
      HandlerMethod: TStringPacketNotifyEvent);
    procedure ReleasePacket(var ThePacket: TApdDataPacket);
    procedure DoClose;
    procedure DoStart;

  public
    procedure PutPagerID; virtual;
    procedure PutMessage; virtual;
    procedure PutSend; virtual;
    procedure PutQuit; virtual;

    procedure Send; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Quit;

    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;

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

    property CommDelay: Integer
      read FCommDelay write FCommDelay default 0;

    property OnLogin: TNotifyEvent
      read FOnLogin write FOnLogin;
    property OnSNPPSuccess: TSNPPMessage
      read FOnSNPPSuccess write FOnSNPPSuccess;
    property OnSNPPError: TSNPPMessage
      read FOnSNPPError write FOnSNPPError;
    property OnLogout: TNotifyEvent
      read FOnLogout write FOnLogout;
  end;

implementation

const
  { string resource offsets }
  STRRES_DIAL_STATUS = TDS_NONE;  {MODEM/Dialing status messages}
  STRRES_DIAL_ERROR  = TDE_NONE;  {MODEM/Dialing error messages }
  STRRES_TAP_STATUS  = TPS_NONE;  {TAP Specific status/error messages }

{utility procedures}

type
  TPageLogCondition = (pcStart, pcDone, pcError);

procedure FreeTrigger(Port: TApdCustomComPort;
  var Trigger: TTriggerHandle; TriggerName: string);
begin
  if (Assigned(Port)) and (Port.Open) and (Trigger <> 0) then begin
    Port.RemoveTrigger(Trigger);
    Trigger := 0;
  end else
  if (Trigger <> 0) then
    raise Exception.Create('Unable to free trigger: ' + TriggerName);
end;

function FormatLogEntry(PageMode, ID, Dest, Reason: string;
                        Condition                 : TPageLogCondition): string;
var
  S: string;
begin
  case Condition of
    pcStart:  S := ' Started    ';
    pcDone:   S := ' Completed  ';
    pcError:  S := ' Failed: Reason: ' ;
  end;
  Result := FormatDateTime('mm/dd/yyyy hh:mm:ss ', Now ) + ' ' + PageMode +
    ' page to ' + ID + ' at ' + Dest + S + Reason;
end;

{TApdAbstractPager}

constructor TApdAbstractPager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMessage := TStringList.Create;
end;

destructor TApdAbstractPager.Destroy;
begin
  FMessage.Free;
  inherited Destroy;
end;

procedure TApdAbstractPager.Notification(AComponent: TComponent;
                                         Operation : TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    if AComponent = FPort then
      FPort := nil;
  end else begin
    if (AComponent is TApdCustomComPort) and (FPort = nil) then
      FPort := TApdCustomComPort(AComponent);
  end;
end;

procedure TApdAbstractPager.SetMessage(Msg: TStrings);
begin
  FMessage.Assign(Msg);
end;

procedure TApdAbstractPager.SetPagerID(ID: string);
begin
  if FPagerID <> ID then
    FPagerID := ID;
end;

procedure TApdAbstractPager.SetPagerLog(const NewLog: TApdPagerLog);
begin
  if NewLog <> FPagerLog then
    FPagerLog := NewLog;
end;

procedure TApdAbstractPager.WriteToEventLog(const S: string);
begin
  if Assigned(FPagerLog) then
    FPagerLog.UpdateLog(S);
end;


{TApdCustomModemPager}
constructor TApdCustomModemPager.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);

  InitProperties;

  {search our owner for a com port}
  if Assigned(AOwner) and (AOwner.ComponentCount > 0) then begin         {!!.02}
    for I := 0 to Pred(AOwner.ComponentCount) do                         {!!.02}
      if AOwner.Components[I] is TApdCustomComPort then begin            {!!.02}
        SetPort(TApdCustomComPort(AOwner.Components[I]));                {!!.02}
        Break;                                                           {!!.02}
      end;                                                               {!!.02}
    for I := 0 to pred(AOwner.ComponentCount) do                         {!!.02}
      if AOwner.Components[I] is TApdTapiDevice then begin               {!!.02}
        FTapiDev := TApdTapiDevice(AOwner.Components[I]);                {!!.02}
        Break;                                                           {!!.02}
      end;                                                               {!!.02}
  end;                                                                   {!!.02}
end;

destructor TApdCustomModemPager.Destroy;
begin
  inherited Destroy;
end;

procedure TApdCustomModemPager.CancelCall;
begin
  FCancelled := True;
end;

procedure TApdCustomModemPager.DoCleanup;
begin
  DoDialStatus(dsCleanup);
end;

procedure TApdCustomModemPager.DoInitializePort;
begin
  if csDestroying in ComponentState then
    Exit;

  if Assigned(FPort) then begin
    { open the port }
    if Assigned(TapiDev) then begin                                      {!!.02}
      FUseTapi := True;                                                  {!!.02}
      SetTapiDev(TapiDev);                                               {!!.02}
      FTapiDev.ComPort := FPort;                                         {!!.02}
      FTapiDev.EnableVoice := False;                                     {!!.02}
    end;                                                                 {!!.02}
  end else
    raise Exception.Create('No ComPort Component Assigned');
end;

procedure TApdCustomModemPager.DoOpenPort;
begin
  if not(Assigned (FPort)) then                                          {!!.02}
    Exit;                                                                {!!.02}
  if not FPort.Open then                                                 {!!.02}
    if Assigned(FTapiDev) then begin                                     {!!.02}
      FTapiDev.ConfigAndOpen;                                            {!!.02}
      FPort.TapiMode := tmOn                                             {!!.02}
    end else                                                             {!!.02}
      FPort.Open := True;
  DelayTicks(STD_DELAY, True);
  SetPortOpts;                                                           {!!.02}
  DelayTicks(STD_DELAY*2, True);
end;

procedure TApdCustomModemPager.DoDial;
{Dialing Algorithm for Paging}
var
  Error: Boolean;

  procedure Wait(Interval: Integer; Status: TDialingStatus);
  var
    WaitTimer: EventTimer;
    Res : Integer;
  begin
    Waiting := True;
    NewTimer(WaitTimer, Secs2Ticks(Interval));
    DoDialStatus(Status);
    repeat
      Res := SafeYield;
    until Error or FAborted or FCancelled or TimerExpired(WaitTimer) or
          (Res = wm_Quit);
  end;

  procedure DialNumber;
  var
    Res : Integer;

    { Make the appropriate dial prefix }
    procedure MakeDialPrefix;
    var
      S : string;
    begin
      if BlindDial then begin
      { Make BlindDial prefix }
        if Pos('X', FDialPrefix) > 0 then exit;
        S := Copy(FDialPrefix, 1, Pos('T', FDialPrefix)) + adpgDefBlindInit +
                  Copy(FDialPrefix, Pos('T', FDialPrefix), Length(FDialPrefix));
        FPort.Output := S + FPhoneNumber + cCR;                          {!!.05}
      end else
      begin
      { Normal prefix dial }
        FPort.Output := FDialPrefix + FPhoneNumber + cCR;                {!!.05}
      end;
    end;
  begin
    if FDialAttempt > 1 then
      DoDialStatus(dsRedialing)
    else
      DoDialStatus(dsDialing);

    mpGotOkay := False;
    if Assigned(FPort) and FPort.Open then
      FPort.Output := FModemInit + cCR;                                  {!!.05}
    AddInitModemDataTrigs;
    repeat
      Res := SafeYield;
    until mpGotOkay or FAborted or FCancelled or (Res = wm_Quit)
          or FSent;                                                      {!!.04}

    if not mpGotOkay then
      exit;

    { modify the dial command and dial }
    MakeDialPrefix;
    repeat
      Res := SafeYield;
    until FConnected or FAborted or FCancelled or (Res = wm_Quit);

    if FConnected then
      DoDialStatus(dsConnected);

    if FDialError = deLineBusy then begin
      FFailReason := 'Line Busy';
      Error := True;
    end else begin
      if (not FConnected) and FAbortNoConnect then begin
        FAborted := True;
        FFailReason := 'Unable to Complete Connection';
      end;
    end;
  end;

begin
  DoOpenPort;

  FDialAttempt := 1;
  FSent := False;
  InitCallStateFlags;

  DoStartCall;
  Error := False;
  FCancelled := False;
  FAborted := False;

  while
    (not FSent) and
    (not FCancelled) and
    (not FAborted) and
    (FDialAttempt <= FDialAttempts)
  do begin

    { go off hook}
    DelayTicks(STD_DELAY * 4, True);