adpager.pas

测试用例

      { receipt okay, send next block or end if no more }
        DoTAPStatus(psMsgAck);
        if FMsgIdx < Pred(FBlocks.Count) then begin
          DoNextMessageBlock;
        end
        else begin
          DoTAPStatus(psMsgCompleted);
          Done := True;                                                  {!!.02}

          if Assigned(FOnGetNextMessage) then begin
            OnGetNextMessage(self, Done);
            if not Done then begin
              DoFirstMessageBlock;
              Exit;
            end;
          end;

          FSent := True;
          FreeMsgTriggers;
          InitLogoutTriggers;
          TerminatePage;                                                 {!!.02}
          DoDialStatus(dsCancelling);
          DelayTicks(STD_DELAY * 2, True);
        end;
      end

      else if wParam = FtrgMsgNak then begin    { recept error, resend message }
        DoTAPStatus(psMsgNak);
        if tpTapRetries < MAX_TAP_RETRIES then
          DoCurMessageBlock
        else
          TerminatePage                                                  {!!.02}
      end

      else if wParam = FtrgMsgRs then begin     { unable to send page }
        DoTAPStatus(psMsgRs);
        if FMsgIdx < Pred(FBlocks.Count) then begin                      {!!.02}
          DoNextMessageBlock;                                            {!!.02}
        end else begin                                                   {!!.02}
          Done := True;                                                  {!!.02}
          if Assigned(FOnGetNextMessage) then begin                      {!!.02}
            OnGetNextMessage(self, Done);                                {!!.02}
            if not Done then begin                                       {!!.02}
              DoFirstMessageBlock;                                       {!!.02}
              Exit;                                                      {!!.02}
            end;                                                         {!!.02}
          end else                                                       {!!.02}
            TerminatePage;                                               {!!.02}
        end;                                                             {!!.02}
      end

      else if wParam = FtrgDCon then begin      { logging out of paging server }
        FreeLogoutTriggers;
        FreeResponseTriggers;                                            {!!.02}

        if Assigned(FTapiDev) then begin                                 {!!.02}
          FPort.Dispatcher.DeregisterEventTriggerHandler
                              (DataTriggerHandler);                      {!!.02}
          FTapiDev.CancelCall                                            {!!.02}
        end else begin                                                   {!!.02}
          if FPort.DCD then                                              {!!.04}
            inherited TerminatePage;                                     {!!.02}
          FPort.Dispatcher.DeregisterEventTriggerHandler
                              (DataTriggerHandler);                      {!!.02}
          if FPort.Open and not DirectToPort then                        {!!.02}
            FPort.Open := False;                                         {!!.02}

        end;                                                             {!!.02}
        if Assigned(FOnTAPFinish) then                                   {!!.02}
          FOnTAPFinish(self);                                            {!!.02}
        DoTAPStatus(psDone);
      end;

    except

      on EBadTriggerHandle do
        ShowMessage('Bad Trigger: ' + HandleToTrigger(wParam));
    end;
  end;

  if FAborted then begin
    DonePingTimer;
    TerminatePage;                                                       {!!.02}
  end;
end;

procedure TApdTAPPager.InitProperties;
begin
  inherited InitProperties;
  FTapWait := 30;
  FPassword := '';
  FMaxMsgLen  := MAX_MSG_LEN;
  FUseEscapes := False;
end;

procedure TApdTAPPager.SetPort(ThePort: TApdCustomComPort);
begin
  inherited SetPort(ThePort);
end;

function TApdTAPPager.TAPStatusMsg(Status: TTAPStatus): string;
begin
  case Status of
    {TTAPStatus} psNone..psDone: Result := AproLoadStr(Ord(Status) + STRRES_TAP_STATUS);
  end;
end;

procedure TApdTAPPager.DoDirect;
begin
  inherited DoDirect;
  DoStartCall;
  InitLoginTriggers;
  DelayTicks(STD_DELAY, True);
  StartPingTimer;
end;

procedure TApdTAPPager.TerminatePage;
begin
  if Assigned(FPort) and FPort.Open then                                 {!!.02}
    FPort.Output := TAP_LOGOUT;                                          {!!.02}
  DelayTicks(36, True);                                                  {!!.04}
end;

procedure TApdTAPPager.Disconnect;
begin
  TerminatePage;                                                         {!!.02}
end;

{ TApdCustomINetPager }

constructor TApdCustomINetPager.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);

  {search our owner for a Winsock port}
  if Assigned(AOwner) and (AOwner.ComponentCount > 0) then
    for I := 0 to Pred(AOwner.ComponentCount) do
      if AOwner.Components[I] is TApdWinsockPort then begin
        SetPort(TApdWinsockPort(AOwner.Components[I]));
        Break;
      end;
end;

function TApdCustomINetPager.GetPort: TApdWinsockPort;
begin
  Result := TApdWinsockPort(FPort);
end;

procedure TApdCustomINetPager.SetPort(ThePort: TApdWinsockPort);
begin
  if FPort <> TApdCustomComPort(ThePort) then
    FPort := TApdCustomComPort(ThePort);
end;

const
  { SNPP server response codes }
  SNPP_RESP_SUCCESS       = '25? ';
  SNPP_RESP_DATAINPUT     = '3?? ';
  SNPP_RESP_FAILTERMINATE = '4?? ';
  SNPP_RESP_FAILCONTINUE  = '5?? ';

  { SNPP v.3 responses, included for completeness, not presently supported }
  SNPP_RESP_2WAYFAIL      = '7?? ';
  SNPP_RESP_2WAYSUCCESS   = '8?? ';
  SNPP_RESP_2WAYQUEUESUCC = '9?? ';

  { SNPP server commands }
  SNPP_CMD_PAGEREQ    = 'PAGE';
  SNPP_CMD_MESSAGE    = 'MESS';
  SNPP_CMD_DATA       = 'DATA';
  SNPP_DATA_TERMINATE = atpCRLF + '.' + atpCRLF;
  SNPP_CMD_RESET      = 'RESE';
  SNPP_CMD_SEND       = 'SEND';
  SNPP_CMD_HELP       = 'HELP';
  SNPP_CMD_QUIT       = 'QUIT';

  { SNPP v.3 commands, included for completeness, not presently supported }
  SNPP_CMD_LOGIN      = 'LOGI';
  SNPP_CMD_LEVEL      = 'LEVE';
  SNPP_CMD_ALERT      = 'ALER';
  SNPP_CMD_COVERAGE   = 'COVE';
  SNPP_CMD_HOLDUNTIL  = 'HOLD';
  SNPP_CMD_CALLERID   = 'CALL';
  SNPP_CMD_SUBJECT    = 'SUBJ';
  SNPP_CMD_2WAY       = '2WAY';
  SNPP_CMD_PING       = 'PING';
  SNPP_CMD_EXPIRETAG  = 'EXPT';
  SNPP_CMD_MSGSTATUS  = 'MSTA';
  SNPP_CMD_NOQUEUEING = 'NOQU';
  SNPP_CMD_ACKREAD    = 'ACKR';
  SNPP_CMD_REPLYTYPE  = 'RTYP';
  SNPP_CMD_MULTRESP   = 'MCRE';
  SNPP_CMD_KILLTAG    = 'KTAG';


{ TApdSNPPPager }

constructor TApdSNPPPager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommDelay := 0;
  FServerInitString := '220';
  FServerDoneString := '221';
  FServerSuccStr         :=   SNPP_RESP_SUCCESS;
  FServerDataInp         :=   SNPP_RESP_DATAINPUT;
  FServerRespFailCont    :=   SNPP_RESP_FAILCONTINUE;
  FServerRespFailTerm    :=   SNPP_RESP_FAILTERMINATE;
  FOkayToSend := False;
  FSessionOpen := False;
  FQuit := False;
  FCancelled := False;

  FPageMode := 'SNPP';
  FFailReason := '';
end;

destructor TApdSNPPPager.Destroy;
begin
  FCancelled := True;
  if Assigned(FPort) then
    FPort.Open := False;
  inherited Destroy;
end;

procedure TApdSNPPPager.DoClose;
begin
end;

procedure TApdSNPPPager.DoStart;
begin
end;

procedure TApdSNPPPager.DoLoginString(Sender: TObject; Data: String);
begin
  FSessionOpen := True;
  if Assigned(FOnLogin) then
    FOnLogin(self);
end;

procedure TApdSNPPPager.DoServerSucc(Sender: TObject; Data: String);
var
  Code: Integer;
  Msg: string;
begin
  FGotSuccess := True;                                                   
  Code := StrToInt(Copy(Data,1,3));
  Msg  := Copy(Data, 5, Length(Data)-4);
  if Assigned(FOnSNPPSuccess) then
    FOnSNPPSuccess(self, Code, Msg);
end;

procedure TApdSNPPPager.DoServerDataMsg(Sender: TObject; Data: String);
begin
  FOkayToSend := True;
end;

procedure TApdSNPPPager.DoServerError(Sender: TObject; Data: String);
begin
  FFailReason := 'Minor Error ' + Data;
  if ExitOnError then
    FCancelled := True;
  if Assigned(FOnSNPPError) then
    FOnSNPPError(self, StrToInt(Copy(Data,1,3)), Copy(Data, 5, Length(Data)-4));
end;

procedure TApdSNPPPager.DoServerFatalError(Sender: TObject; Data: String);
begin
  FFailReason := 'Fatal Error ' + Data;
  FCancelled := True;
  if Assigned(FOnSNPPError) then
    FOnSNPPError(self, StrToInt(Copy(Data,1,3)), Copy(Data, 5, Length(Data)-4));
end;

procedure TApdSNPPPager.DoLogoutString(Sender: TObject; Data: String);
begin
  FQuit := True;
  if Assigned(FOnLogout) then
    FOnLogout(self);
end;

procedure TApdSNPPPager.MakePacket(ThePacket: TApdDataPacket; StartStr, EndStr: string;
  HandlerMethod: TStringPacketNotifyEvent);
begin
  ThePacket := TApdDataPacket.Create(self);
  ThePacket.ComPort := FPort;
  ThePacket.StartString := StartStr;
  ThePacket.StartCond := scString;
  ThePacket.EndString := EndStr;
  ThePacket.EndCond := [];
  if EndStr <> '' then
    ThePacket.EndCond := [ecString];
  ThePacket.IncludeStrings := True;
  ThePacket.OnStringPacket := HandlerMethod;
  ThePacket.Enabled := True;
end;

procedure TApdSNPPPager.InitPackets;
begin
  MakePacket(FLoginPacket,            FServerInitString   , ^M, DoLoginString);
  MakePacket(FServerSuccPacket,       FServerSuccStr      , ^M, DoServerSucc);
  MakePacket(FServerDataMsgPacket,    FServerDataInp      , ^M, DoServerDataMsg);
  MakePacket(FServerErrorPacket,      FServerRespFailCont , ^M, DoServerError);
  MakePacket(FServerFatalErrorPacket, FServerRespFailTerm , ^M, DoServerFatalError);
  MakePacket(FServerDonePacket,       FServerDoneString   , ^M, DoLogoutString);
end;

procedure TApdSNPPPager.ReleasePacket(var ThePacket: TApdDataPacket);
var
  TempPacket: TApdDataPacket;
begin
  if Assigned(ThePacket) then
  begin
    TempPacket := ThePacket;
    ThePacket := nil;
    TempPacket.Free;
  end;
end;

procedure TApdSNPPPager.FreePackets;
begin
  ReleasePacket(FLoginPacket);
  ReleasePacket(FServerSuccPacket);
  ReleasePacket(FServerDataMsgPacket);
  ReleasePacket(FServerErrorPacket);
  ReleasePacket(FServerFatalErrorPacket);
  ReleasePacket(FServerDonePacket);
end;

procedure TApdSNPPPager.Send;
begin
  WriteToEventLog(FormatLogEntry(FPageMode, PagerID, Port.WsAddress + ':' +
    Port.wsPort, '', pcStart));

  FSessionOpen := False;
  FSent := False;                                                        
  FQuit := False;                                                        

  FPort.Open := True;

  DoStart;
  InitPackets;
  repeat
    DelayTicks(STD_DELAY * 2, True);
  until FSessionOpen or FCancelled;

  if not FCancelled then begin                                           
    FGotSuccess := False;                                                
    PutPagerID;
    repeat                                                               
      DelayTicks(STD_DELAY * 2, True);                                   
    until FGotSuccess or FCancelled;                                     
  end;

  if not FCancelled then begin                                           
    FGotSuccess := False;                                                
    PutMessage;
    repeat                                                               
      DelayTicks(STD_DELAY * 2, True);                                   
    until FGotSuccess or FCancelled;                                     
  end;                                                                   

  { FSent := False; }                                                    
  if not FCancelled then begin                                           
    PutSend;
    repeat
      DelayTicks(STD_DELAY * 2, True);
    until FGotSuccess or FCancelled;                                     
  end;                                                                   

  if FGotSuccess then                                                    
    FSent := True;

  { FQuit := False; }                                                    
  if not FCancelled then begin                                           
    PutQuit;
    repeat
      DelayTicks(Secs2Ticks(1), True);
    until FQuit or FCancelled;                                           
  end;

  if FQuit then
    WriteToEventLog(FormatLogEntry(FPageMode, PagerID, Port.WsAddress + ':' +
      Port.wsPort, '', pcDone))
  else
    WriteToEventLog(FormatLogEntry(FPageMode, PagerID, Port.WsAddress + ':' +
      Port.wsPort, FFailReason, pcError));

  DoClose;
  FreePackets;
end;

procedure TApdSNPPPager.PutString(S: string);
var
  i: Integer;
begin
  if Assigned(FPort) then
    FPort.Output := S;
  if FCommDelay > 0 then begin
    i := 1;
    repeat
      WriteToEventLog('Output Delay');
      DelayTicks(STD_DELAY * 2, True);
      Inc(i);
    until i > FCommDelay;
  end;
end;

procedure TApdSNPPPager.DoMultiLine;
var
  i: Integer;
begin
  FOkayToSend := False;

  PutString(SNPP_CMD_DATA + ' ' + FMessage[0] + atpCRLF);

  repeat
    WriteToEventLog('Waiting to Output');
    DelayTicks(STD_DELAY * 2, True);
  until FOkayToSend or FCancelled;

  for i := 0 to Pred(FMessage.Count) do
    PutString(FMessage[i] + atpCRLF);
  PutString(