adpgr.pas

测试用例

end;

procedure TApdCustomPager.DoneModemInitTimer;
begin
  if Assigned(tpModemInitTimer) then begin                               {!!.06}
    tpModemInitTimer.Enabled := False;                                   {!!.06}
    if Assigned(tpModemInitTimer) then                                   {!!.06}
      tpModemInitTimer.Free;                                             {!!.06}
      tpModemInitTimer := nil;                                           {!!.06}
  end;                                                                   {!!.06}
end;

procedure TApdCustomPager.DonePingTimer;
  { TAP: Logged on now, Shut off tpPingTimer }
begin    
  if Assigned(tpPingTimer) then begin
    tpPingTimer.Enabled := False;
    tpPingTimer.Free;                                                    {!!.06}
    tpPingTimer := nil;                                                  {!!.06}
  end;
end;

procedure TApdCustomPager.DoNextMessageBlock;
  { TAP: Set next message block to current message block to send }
begin    
  Inc(FMsgIdx);
  FDialAttempt := 0;
  DoCurMessageBlock;
end;

procedure TApdCustomPager.DoOpenPort;
  { TAP: Open the port if not already open }
begin
  if not(Assigned (FPort)) then
    Exit;
  if FPort.Open then
    Exit;
  FPort.Open := True;
end;

procedure TApdCustomPager.DoPageError(Error: Integer);
  { PageError event could be time sensitive, PostMessage to call event }
begin
  if Assigned(FOnPageError) then
    FOnPageError(self, Error)
  else begin
    case Error of

      ecModemDetectedBusy:  begin
        raise EModemDetectedBusy.Create(Error, False);
      end;

      ecModemNoDialtone: begin
        raise ENoDialtone.Create(Error, False);
      end;

      ecModemNoCarrier: begin
          raise ENoCarrier.Create(Error, False);
      end;

      ecInitFail: begin
        raise EApdPagerException.Create(Error, sInitFail);
      end;

      ecLoginFail: begin
        raise EApdPagerException.Create(Error, sLoginFail);
      end;

    end; { end case statement - Unknown or no error }
  end; { end else }
end;

procedure TApdCustomPager.DoPageStatus(Status: TPageStatus);
  { Page Status could be time sensitive, PostMessage to call status}
begin
    PostMessage(FHandle, Apw_PgrStatusEvent, Ord(Status), TempWait);
end;

procedure TApdCustomPager.DoPageStatusTrig(Trig: Cardinal);
  { TAP: All these Triggers call DoPageStatus }
var
  Stat: TPageStatus;
begin
  Stat := psNone;
  if Trig = ConnectTrig then
    Stat := psConnected     { line has connected }
  else if Trig = BusyTrig then
    Stat := psLineBusy      { line is busy }
  else if Trig = NoCarrierTrig then
    Stat := psDisconnect    { no response from modem }
  else if Trig = NoDialtoneTrig then
    Stat := psNoDialtone    { no dialtone }
  else if Trig = FtrgIDPrompt then
    Stat := psLoginPrompt   { got login prompt }
  else if Trig = FtrgLoginSucc then
    Stat := psLoggedIn      { login accept }
  else if Trig = FtrgLoginRetry then
    Stat := psLoginRetry    { login error }
  else if Trig = FtrgOkToSend then
    Stat := psMsgOkToSend   { okay start sending message }
  else if Trig = FtrgMsgAck then
    Stat := psMsgAck        { received okay, send next block or end }
  else if Trig = FtrgMsgNak then
    Stat := psMsgNak        { received error, resend message }
  else if Trig = FtrgMsgRs then
    Stat := psMsgRs         { unable to send page }
  else if Trig = FtrgDCon then
    Stat := psDone;         { logging out of paging server }
  DoPageStatus(Stat);
end;

procedure TApdCustomPager.DoPortOpenCloseEx(CP: TObject;
                                 CallbackType : TApdCallbackType);
  { TAP: To Notify when the port opens or is closing }
begin
  case CallbackType of
    ctOpen   : begin
      DoStartCall;
      if Assigned(FTapiDevice) and (PagerMode = pmTAP) then
        DoPageStatus(psConnected);
    end;
    ctClosing: FPort.DeregisterUserCallbackEx(DoPortOpenCloseEx);
    ctClosed : {Nothing for now}
  end;
end;

procedure TApdCustomPager.DoServerDataMsg(Sender: TObject; Data: String);
  { SNPP: Ready to Send }
begin   
  FOkayToSend := True;
end;

procedure TApdCustomPager.DoServerError(Sender: TObject; Data: String);
  { SNPP: Minor Server Error }
begin
  FCancelled := ExitOnError;
  FEventLog.AddLogString(True, sMinorSrvErr);
  if Assigned(FOnPageError) then
    FOnPageError(self, ecMinorSrvErr);
end;

procedure TApdCustomPager.DoServerFatalError(Sender: TObject;
  Data: String);
  { SNPP: Fatal Server Error }
begin
  FCancelled := True;
  FEventLog.AddLogString(True, sFatalSrvErr);
  if Assigned(FOnPageError) then
    FOnPageError(self, ecFatalSrvErr);
end;

procedure TApdCustomPager.DoServerSucc(Sender: TObject; Data: String);
  { SNPP: A packet has returned }
var
  Code: Integer;
  Msg: string;
begin
  Code := StrToInt(Copy(Data,1,3));
  Msg  := Copy(Data, 5, Length(Data)-4);
  Data := Copy(Data, 1, Length(Data) - 1);
  FEventLog.AddLogString(True, Data);
  if not FGotSuccess then begin
    FGotSuccess := True;
  end else begin
    if Assigned(FOnPageFinish) then
      FOnPageFinish(self, Code, Msg);
  end;
end;

procedure TApdCustomPager.DoStartCall;
  { TAP: Get Trigger Handler/State Machine ready }
begin
  tpPingCount := 0;
  FPort.Dispatcher.RegisterEventTriggerHandler(DataTriggerHandler);
end;

procedure TApdCustomPager.FreeLoginTriggers;
  { TAP: Free Triggers used for logging in }
begin
  FreeTrigger(FPort, FtrgIDPrompt);
  FreeTrigger(FPort, FtrgLoginSucc);
  FreeTrigger(FPort, FtrgLoginRetry);
  FreeTrigger(FPort, FtrgLoginFail);
end;

procedure TApdCustomPager.FreeLogoutTriggers;
  { TAP: Free Logout Triggers used for Logging Out }
begin 
    FreeTrigger(FPort, FtrgDCon);
end;

procedure TApdCustomPager.FreeMsgTriggers;
  { TAP: Free Triggers used for results of sending Page }
begin 
  FreeTrigger(FPort, FtrgOkToSend);
  FreeTrigger(FPort, FtrgMsgAck);
  FreeTrigger(FPort, FtrgMsgNak);
  FreeTrigger(FPort, FtrgMsgRs);
end;

procedure TApdCustomPager.FreePackets;
  { SNPP: Free Packets used for SNPP Pages }
begin  
  FLoginPacket.Free;
  FServerSuccPacket.Free;
  FServerDataMsgPacket.Free;
  FServerErrorPacket.Free;
  FServerFatalErrorPacket.Free;
  FServerDonePacket.Free;
end;

procedure TApdCustomPager.FreeResponseTriggers;
  { TAP: Free Triggers used by the Modem }
begin    
    FreeTrigger(FPort, OKTrig);
    FreeTrigger(FPort, ErrorTrig);
    FreeTrigger(FPort, ConnectTrig);
    FreeTrigger(FPort, BusyTrig);
    FreeTrigger(FPort, NoCarrierTrig);
    FreeTrigger(FPort, NoDialtoneTrig);
    FreeTrigger(FPort, FtrgSendTimer);
end;

procedure TApdCustomPager.FreeTrigger(Port: TApdCustomComPort;
  var Trigger: Word);
  { Used to remove a trigger }
begin
  if (Assigned(Port)) and (Port.Open) and (Trigger <> 0) then begin
    Port.RemoveTrigger(Trigger);
    Trigger := 0;
  end;
end;

procedure TApdCustomPager.InitCallStateFlags;
  { TAP: Initializing Flags }
begin
  FAborted    := False;
  FCancelled  := False;
  FConnected  := False;
  FTerminating := False;
end;

procedure TApdCustomPager.InitLoginTriggers;
  { TAP: Add Triggers for logging on the TAP server }
begin
  FtrgIDPrompt   := FPort.AddDataTrigger(TAP_ID_PROMPT,    False);
  FtrgLoginSucc  := FPort.AddDataTrigger(TAP_LOGIN_ACK,    False);
  FtrgLoginFail  := FPort.AddDataTrigger(TAP_LOGIN_FAIL,   False);
  FtrgLoginRetry := FPort.AddDataTrigger(TAP_LOGIN_NAK,    False);
end;

procedure TApdCustomPager.InitLogoutTriggers;
  { TAP: Add Triggers to Logout of TAP server }
begin
  FtrgDCon := FPort.AddDataTrigger(TAP_DISCONNECT, False);
end;

procedure TApdCustomPager.InitMsgTriggers;
  { TAP: Add Triggers used for TAP Server Page results from message }
begin   
  FtrgOkToSend  := FPort.AddDataTrigger(TAP_MSG_OKTOSEND, False);
  FtrgMsgAck    := FPort.AddDataTrigger(TAP_MSG_ACK, True);
  FtrgMsgNak    := FPort.AddDataTrigger(TAP_MSG_NAK, True);
  FtrgMsgRs     := FPort.AddDataTrigger(TAP_MSG_RS,  True);
end;

procedure TApdCustomPager.InitPackets;
  { SNPP: Make packets for SNPP Server replies or results }
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 TApdCustomPager.LogOutTAP;
  { TAP: Logging out of TAP service }
begin
  DoPageStatus(psLoggingOut);
  if Assigned(FPort) and FPort.Open then
    FPort.Output := TAP_LOGOUT;
end;

procedure TApdCustomPager.MakePacket(ThePacket: TApdDataPacket; StartStr,
  EndStr: string; HandlerMethod: TStringPacketNotifyEvent);
  { SNPP: Setup a DataPacket to look for characters } 
begin
  if not Assigned(ThePacket) then 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;
end;

procedure TApdCustomPager.ModemInitTimerOnTimer(Sender: TObject);
begin
  if Port.Open and (Port.OutBuffFree > 0) then begin                     {!!.06}
    FAborted := True;                                                    {!!.06}
  end;                                                                   {!!.06}
end;

procedure TApdCustomPager.Notification(AComponent: TComponent;
  Operation: TOperation);
  { Find Port }
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 TApdCustomPager.PingTimerOnTimer(Sender: TObject);
  { TAP: Timer event used while logging on }
begin
  if Port.Open and (Port.OutBuffFree > 0) then begin
    FPort.Output := cCr;
  end;
  Inc(tpPingCount, 2);
  if tpPingCount > FTapWait then begin
    tpPingTimer.Enabled := False;
    FAborted := True;                                                    {!!.06}
    DoPageStatus(psLoginRetry);
  end;
end;

procedure TApdCustomPager.PutMessage;
  { SNPP: Put out a Message unless more than one line }
begin 
  if FMessage.Count > 1 then
    DoMultiLine
  else
    PutString(SNPP_CMD_MESSAGE + ' ' + FMessage[0] + atpCRLF);
end;

procedure TApdCustomPager.PutQuit;
  { SNPP: Command to quit sending message }
begin 
  PutString(SNPP_CMD_QUIT + atpCRLF);
end;

procedure TApdCustomPager.PutSend;
  { SNPP: Command to send message }
begin    
  PutString(SNPP_CMD_SEND + atpCRLF);
end;

procedure TApdCustomPager.PutString(const S: string);
  { SNPP: Put a string out the port }
var
  i: Integer;
begin
  if Assigned(FPort) then
    FPort.Output := S;
  if FCommDelay > 0 then begin
    i := 1;
    repeat
      FEventLog.AddLogString(True, 'Output Delay');
      DelayTicks(STD_DELAY * 2, True);
      Inc(i);
    until i > FCommDelay;
  end;
end;

procedure TApdCustomPager.Quit;
  { SNPP: Public Access Method for quitting a Page in progress }
begin
  FCancelled := True;
end;

procedure TApdCustomPager.Send;
  { Send a page }
begin
  case FPagerMode of

    { PagerMode is using TAP }
    pmTAP: begin
      FPageMode := 'TAP';
//      tpPingTimer := TTimer.Create(nil);                               {!!.06}
//      tpPingTimer.Enabled := False;                                    {!!.06}
//      tpPingTimer.Interval := 2000;                                    {!!.06}
//      tpPingTimer.OnTimer := PingTimerOnTimer;                         {!!.06}
      if FTapHotLine then begin
        DoInitializePort;
        DoPageStatus(psConnected);
      end else begin
        { TAP uses DoDial unless TapHotLine is true }
        DoDial;
      end;
    end; // End TAP Send

    { Pager mode is using SNPP }
    pmSNPP: begin
      { make sure we have a winsock port }
      if not(FPort is TApdCustomWinsockPort) then
        raise EBadArgument.Create(ecBadArgument, True);
      FPageMode := 'SNPP';

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

      FPort.Open := True;

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

      if not FCancelled then begin
        FGotSuccess := False;
        PutString(SNPP_CMD_PAGEREQ + ' ' + FPagerID + atpCRLF);
        repeat
          DelayTicks(2, True);
        until FGotSuccess or FCancelled;
      end;

      if not FCancelled then begin
        FEventLog.AddLogString(True, sMsgOkToSend);
        FGotSuccess := False;
        PutMessage;
        repeat
          DelayTicks(STD_DELAY * 2, True);
        until FGotSuccess or FCancelled;
      end;
      { FSent := False; }
      if not FCancelled then begin   
        DoPageStatus(psSendingMsg);
        FEventLog.AddLogString(True, sSendingMsg);
        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
        FEventLog.AddLogString(True, sDone)
      else
        FEventLog.AddLogString(True, sCancelled);

      FreePackets;
    end; // End SNPP Send
  end;
end;

procedure TApdCustomPager.SetMessage(Msg: TStrings);
  { Set Message for TStrings Message List }
begin
  FMessage.Assign(Msg);
end;

procedure TApdCustomPager.SetPagerID(ID: string);
  { Set PagerID property }
begin
  FPagerID := ID;
end;

procedure TApdCustomPager.SetPortOpts; 
{ Not using TAPI, but setting the port options to the PortOpts property }
begin
  if (Assigned(TapiDevice)) or (FPortOpts = pCustom) then
    exit;
  if FPortOpts = p7E1 then begin
  { setting port to 7 DataBits, Parity Even, StopBits 1 }
    FPort.DataBits := 7;
    FPort.Parity := pEven;
    FPort.StopBits := 1;
  end else begin
  { setting port to 8 DataBits, Parity None, StopBits 1 }
    FPort.DataBits := 8;
    FPort.Parity := pNone;
    FPort.StopBits := 1;