adpgr.pas

测试用例

  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
      read FTapProperties write FTapProperties;

    { General Events }
    property OnPageError;
    property OnPageStatus;
    property OnPageFinish;
    { TAP }
    property OnGetNextMessage;
  end;

implementation

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';
  TAP_LOGOUT      : string = cEot + cCr;

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';

{ TApdCustomPager }

procedure TApdCustomPager.AddInitModemDataTrigs;
  { TAP: Add Data Trigger unless we have it already }
begin
  if OKTrig = 0 then
    OKTrig := FPort.AddDataTrigger(FapOKTrig, True);
  if ErrorTrig = 0 then
    ErrorTrig := FPort.AddDataTrigger(FapErrorTrig, True);
  if ConnectTrig = 0 then
    ConnectTrig := FPort.AddDataTrigger(FapConnectTrig, True);
  if BusyTrig = 0 then
    BusyTrig := FPort.AddDataTrigger(FapBusyTrig, True);
  if NoCarrierTrig = 0 then
    NoCarrierTrig := FPort.AddDataTrigger(FapNoCarrierTrig, True);
  if NoDialtoneTrig = 0 then
    NoDialtoneTrig := FPort.AddDataTrigger(FapNoDialtoneTrig, True);
end;

procedure TApdCustomPager.BuildTapMessages;
  { TAP: Build a string list of the TAP message using TStringList }

  function SumChars(const S: string): LongInt;
    {sum ASCII values of chars in string (for checksum)}
  var
    Ct,CurChar: LongInt;
  begin
    Result := 0;
    for Ct := 1 to Length(S) do begin
      CurChar := Ord(S[Ct]);
      CurChar := CurChar - (Trunc(CurChar/128) * 128);
      Result := Result + CurChar;
    end;
  end;

  function CheckSum(N: LongInt): string;
    { Bit check }
  var
    Sum, nTemp: LongInt;
    Chr1,Chr2,Chr3: char;
  begin
    Sum := N;

    nTemp := Sum and $000F; {LS 4 bit}
    Chr3  := Chr(nTemp + $30);

    nTemp := Sum and $00F0; {MS 4 bits of lowbyte}
    nTemp := nTemp shr 4;
    Chr2  := Chr(nTemp + $30);

    nTemp := Sum and $0F00;    {LS 4 bits of hibyte}
    nTemp := nTemp shr 8;
    Chr1  := Chr(nTemp + $30);

    Result := Chr1 + Chr2 + Chr3;
  end;

var
  TempMsg,                 { temp parsed message }
  MsgBlock : string;       { the block that we're working with }
  ChkSum : string;         { Check sum for message }
  NumOfBlocks,             { Keep track of number of blocks in message }
  StartB,                  { Start of this block }
  EndB,                    { End of this block }
  TotMessLen : Integer;    { Total length of the blocks thus far }
  EndOfBlock : boolean;    { End of message - no more blocks }
begin
  if Assigned(FMsgBlockList) then
    FMsgBlockList.Clear
  else
    FMsgBlockList := TStringList.Create;
  NumOfBlocks := 1;        { First block of message }
  EndOfBlock := True;  { Under FMaxMessageLength unless True }
  TempMsg := TrimRight(FMessage.Text);
  if Length(TempMsg) > FMaxMessageLength then begin
    EndOfBlock := False;
    MsgBlock := TempMsg;
    TempMsg := Copy(TempMsg, 1, FMaxMessageLength);
  end;
  TotMessLen := Length(MsgBlock);
  TempMsg := #2 + FPagerID + #13 + TempMsg + #13#3;
  ChkSum := CheckSum(SumChars(TempMsg));
  FMsgBlockList.Add (TempMsg + ChkSum + #13);
  { Enter while loop if message > FMaxMessageLength }
  while not(EndOfBlock) do
    if TotMessLen > Length(TempMsg) then
      EndOfBlock := True
    else begin
      StartB := FMaxMessageLength * NumOfBlocks;
      EndB := FMaxMessageLength * (NumOfBlocks + 1);
      TotMessLen := TotMessLen - FMaxMessageLength;
      TempMsg := Copy(MsgBlock, StartB, EndB);
      TempMsg := TrimRight(TempMsg);
      TempMsg := #2 + FPagerID + #13 + TempMsg + #13#3;
      ChkSum := CheckSum(SumChars(TempMsg));
      FMsgBlockList.Add (TempMsg + ChkSum + #13);
      Inc(NumOfBlocks);
    end;
end;

procedure TApdCustomPager.CancelCall;
  { TAP: Public Access method for cancelling a call }
begin
  Quit;
  TerminatePage;
end;

constructor TApdCustomPager.Create(AOwner: TComponent);
  { General initializations and search for ComPort }
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
      SearchComPort(FPort);

  { General Inits }
    FTapHotLine := False;
    FAbortNoConnect := adpgDefAbortNoConnect;
    FExitOnError    := adpgDefExitOnError;
    FDialAttempts   := adpgDefDialAttempts;
    FBlindDial      := adpgDefBlindDial;
    FToneDial       := adpgDefToneDial;
    FUseEscapes     := adpgDefUseEscapes;
    FDialPrefix  := '';
    FTonePrefix  := 'DT';
    FModemHangup := adpgDefModemHangupCmd;
    FModemInit   := adpgDefModemInitCmd;
    FRedialFlag  := False;
    FLoginRetry  := True;
    FPassword := '';
    FMessage := TStringList.Create;
    FEventLog := TApdPgrLog.Create(Self);
    FEventLog.FLogName := 'Pager.Log';                                     
    FHandle := AllocateHWnd(WndProc);
    FCancelled := False;
  { TAP inits }
    FPagerMode := adpgDefPagerMode;
    FPortOpts := adpgDefPortOpts;
    FTapWait := adpgDefDialRetryWait;
    FMaxMessageLength := MAX_MSG_LEN;
    FPortOpenedByUser := False;                                          {!!.06}
  { SNPP inits }
    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;
end;

procedure TApdCustomPager.DataTriggerHandler(Msg, wParam: Cardinal;
  lParam: Integer);
  { State machine used for handling triggers received }
var
  I : Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  if Msg = APW_TRIGGERAVAIL then begin
    for I := 1 to wParam do
      FPort.GetChar;
    Exit;
  end;
  
  { Send had no response back }
  if (Msg = APW_TRIGGERTIMER) and (wParam = FtrgSendTimer) then begin
    DoPageStatus(psSendTimedOut);
  end;

  if (Msg = APW_TRIGGERDATA) and (wParam <> 0) then begin
    if FtrgSendTimer = 0 then
      FtrgSendTimer := FPort.AddTimerTrigger;
    FPort.SetTimerTrigger(FtrgSendTimer, adpgDefTimerTrig, True);

    try
      if wParam = OKTrig then begin
        { Received OK back from modem }
        mpGotOkay := True
      end else if wParam = ErrorTrig then begin
        { modem error }
        FConnected := False;
        FCancelled := True;
        FAborted := True;
      end else if wParam = FtrgLoginFail then begin  { login failure }
        DoPageError(ecLoginFail);
      end else if wParam in [ConnectTrig,    { line has connected }
                             BusyTrig,       { line is busy }
                             NoCarrierTrig,  { no response from modem }
                             NoDialtoneTrig, { no dialtone }
                             FtrgIDPrompt,   { got login prompt }
                             FtrgLoginSucc,  { login accept }
                             FtrgLoginRetry, { login error }
                             FtrgOkToSend,   { okay start sending message }
                             FtrgMsgAck,     { received okay }
                             FtrgMsgNak,     { recept error, resend message }
                             FtrgMsgRs,      { unable to send page }
                             FtrgDCon] { logging out of paging server } then
        DoPageStatusTrig(wParam);
    except
      { do nothing }
    end;
  end;

end;

destructor TApdCustomPager.Destroy;
  { Free what we create }
begin
  if Assigned(FPort) then
    FPort.Open := False;
  FMessage.Free;
  FMsgBlockList.Free;
  if Assigned(tpPingTimer) then begin                                    {!!.06}
    tpPingTimer.Free;
    tpPingTimer := nil;                                                  {!!.06}
  end;                                                                   {!!.06}
  if Assigned(tpModemInitTimer) then begin                               {!!.06}
    tpModemInitTimer.Free;                                               {!!.06}
    tpModemInitTimer := nil;                                             {!!.06}
  end;                                                                   {!!.06}
  if Assigned(WaitTimer) then begin                                      {!!.06}
    WaitTimer.Free;
    WaitTimer := nil;                                                    {!!.06}
  end;                                                                   {!!.06}
  FEventLog.Free;
  DeallocateHwnd(FHandle);
  inherited;
end;

procedure TApdCustomPager.Disconnect;
  { Public Access method to Logout of TAP Service }
begin
  LogOutTAP;
end;

procedure TApdCustomPager.DoCurMessageBlock;
  { TAP: Current message block to be Sent }
begin
  DoPageStatus(psSendingMsg);
  Inc(FDialAttempt);
  FPort.Output := FMsgBlockList[FMsgIdx];
end;

procedure TApdCustomPager.DoDial;
  { TAP: Dialing using a modem }
var
  Res : Integer;
  S : string;  { dial string }
  
begin
  FSent := False;
  TempWait := FTapWait;
  InitCallStateFlags; { Set FCancelled and FAbort to False }
  
  if not FRedialFlag then begin
    FDialAttempt := 0;
    FEventLog.AddLogString(True, sDialing);
    DoPageStatus(psDialing);
    DoInitializePort;
  end else begin
    FPort.SetTimerTrigger(FtrgSendTimer, 0, False);
    FPort.RemoveTrigger(FtrgSendTimer);
    FtrgSendTimer := 0;
  end;

  case FToneDial of
    True : FTonePrefix := adpgToneDialPrefix;
    False: FTonePrefix := adpgPulseDialPrefix;
  end;

  if Assigned(FTapiDevice) then begin
  { Using Tapi to dial }
    FTapiDevice.Dial(FDialPrefix + FPhoneNumber);
  end else begin
  { Not using Tapi to dial }
    mpGotOkay := False;
    AddInitModemDataTrigs;
    FPort.TapiMode := tmOff;
    if Assigned(FPort) and FPort.Open and (FModemInit <> '') then begin  {!!.06}
      tpModemInitTimer := TTimer.Create(nil);                            {!!.06}
      tpModemInitTimer.Enabled := False;                                 {!!.06}
      tpModemInitTimer.Interval := 10000; // ten seconds                 {!!.06}
      tpModemInitTimer.OnTimer := ModemInitTimerOnTimer;                 {!!.06}
      tpModemInitTimer.Enabled := True;                                  {!!.06}
      FPort.Output := FModemInit + #13;                                  {!!.06}
      repeat                                                             {!!.06}
        Res := SafeYield;                                                {!!.06}
      until mpGotOkay or FAborted or FCancelled or (Res = wm_Quit);      {!!.06}
      DoneModemInitTimer;                                                {!!.06}
      if not mpGotOkay then begin                                        {!!.06}
        DoPageStatus(psInitFail);                                        {!!.06}
        exit;                                                            {!!.06}
      end;                                                               {!!.06}
    end;
    if FBlindDial then begin
      { Make BlindDial prefix }
      S := 'ATX3' + FTonePrefix + FDialPrefix + FPhoneNumber + #13
    end else begin
      { Normal dial prefix }
      S := 'AT' + FTonePrefix + FDialPrefix + FPhoneNumber + #13;
    end;
    { Dialing phone here }
    FPort.Output := S;
  end; { Done dialing }
end;

procedure TApdCustomPager.DoFailedToSend;
  { TAP: Failed to send }
begin
  FEventLog.AddLogString(True, sMsgNotSent);
  DoPageStatus(psMsgNotSent);
end;

procedure TApdCustomPager.DoFirstMessageBlock;
  { TAP: First Message block of Page Message }
begin  
  if Assigned(FPort) then begin
    BuildTapMessages;
    FMsgIdx := 0;
    FDialAttempt := 0;
    DoCurMessageBlock;
  end;
end;

procedure TApdCustomPager.DoInitializePort;
  { TAP: Get port ready, open unless using TAPI to dial }
var
  TempTapiCfg : TTapiConfigRec;
begin  
  if csDestroying in ComponentState then
    Exit;
  if Assigned(FPort) then begin
    FPort.RegisterUserCallbackEx(DoPortOpenCloseEx);
    if Assigned(TapiDevice) then begin
      { Port will open when TAPI is dialing }
      FPort.TapiMode := tmOn;
      FTapiDevice.ComPort := FPort;
      FTapiDevice.EnableVoice := False;

      { pCustom will take what TAPI gives us }
      if FPortOpts = pCustom then exit;

      FOrigTapiConfig := FTapiDevice.GetDevConfig;
      TempTapiCfg := FOrigTapiConfig;
      { Set port options before TAPI dials }
      case FPortOpts of
        p7E1: begin  
        TempTapiCfg.Data[38] := 7; { 7 data bits }
        TempTapiCfg.Data[39] := 2; { 2=Even parity, 0=None }
        TempTapiCfg.Data[40] := 0; { stop bit 0=1, 1=1.5, 2=2 }
        end;
        p8N1: begin
        TempTapiCfg.Data[38] := 8; { 8 data bits }
        TempTapiCfg.Data[39] := 0; { 2=Even parity, 0=None }
        TempTapiCfg.Data[40] := 0; { stop bit 0=1, 1=1.5, 2=2 }
        end;
      end;
      FTapiDevice.SetDevConfig(TempTapiCfg);
    end else begin
      if not FPort.Open then begin                                       {!!.06}
        SetPortOpts;
        DoOpenPort;
      end else begin                                                     {!!.06}
        FPortOpenedByUser := True;                                       {!!.06}
        {Port already opened}
        DoPortOpenCloseEx(FPort, ctOpen);                                {!!.06}
      end;                                                               {!!.06}
    end;
  end else    
    raise EPortNotAssigned.Create(ecPortNotAssigned, False);
end;


procedure TApdCustomPager.DoLoginString(Sender: TObject; Data: String);
  { SNPP: Login was a success }
begin
  FSessionOpen := True;
  DonePingTimer;
  DoPageStatus(psLoggedIn);
end;

procedure TApdCustomPager.DoLogoutString(Sender: TObject; Data: String);
  { SNPP: Logging out }
begin
  FQuit := True;
  DoPageStatus(psLoggingOut);
end;

procedure TApdCustomPager.DoMultiLine;
  { SNPP: More than one line to PutString out the port }
var
  i: Integer;
begin
  FOkayToSend := False;

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

  repeat
    FEventLog.AddLogString(True, '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(SNPP_DATA_TERMINATE);