adpager.pas

测试用例

      C := MakeCtrlChar(Ctl);
      Tail := Copy(Tail,P+i,Length(Tail)); { get rest of string }

      if not (C in [#0..#31,#127]) then begin  { ignore anything not in range }
        Start := Start + Ctl;
      end
      else begin
        if not Strip then begin
          Start :=
            Start + BuildTAPCtrlChar(C); { convert '#nnn' to char add to Start }
        end
        else begin

          {** DO NOTHING **}; {eliminate "#nnn" string by leaving Start alone}

        end;
      end;
    end;

    P := Pos('#', Tail);
  end;

  Tail := Start + Tail;  { concat whatever's left of Tail}

  { find all "^l" style escapes}
  P := Pos('^', Tail);
  Start := '';

  while P > 0 do begin

    if not(UpCase(Tail[P+1]) in ['@', 'A'..'Z','[', '\', ']', '^', '_']) then
    begin
      Start := Start + Copy(Tail,1,P);    { copy past '^' }
      Tail  := Copy(Tail,P+1,Length(Tail)-P);
    end
    else begin {legitimate Control char}
      Start := Start + Copy(Tail,1,P-1);  { copy up to '^' }

      if Strip then begin  { eliminate "^l" string }
        Tail := Copy(Tail,P+2,Length(Tail)); { get rest of string }
      end

      else begin
        Ctl  := Copy(Tail,P,2);  { extract "^l" control char string }
        Tail := Copy(Tail,P+2,Length(Tail)-2); { get rest of string }
        Start := Start +
          BuildTAPCtrlChar(MakeCtrlChar(Ctl)); { convert "^l" to char add to Start }
      end;
    end;

    P := Pos('^', Tail);
  end;

  Result := Start + Tail;
end;

function ExpandCtrlChars(const S: string): string;
begin
  Result := ProcessCtrlChars(S, False);
end;

function StripCtrlChars(const S: string): string;
begin
  Result := ProcessCtrlChars(S, True);
end;

procedure BuildTapMessages
  (
  const ID:string;
  {in}  Msg:TStrings;
  const UseEscapes: Boolean;
  const MaxLen: Integer;
  {out} Blocks: TStrings);
var
  OutMsg: TAdStr;
  Ct: Integer;
  EOMsg: Boolean;
  MsgPtr : PChar;
begin
  Blocks.Clear;

  { build long message from string list }
  MsgPtr := Msg.GetText;
  OutMsg := TAdStr.Create(StrLen(MsgPtr)*2);
  StrDispose(MsgPtr);
  OutMsg.Clear;

  for Ct := 0 to Pred(Msg.Count) do begin
    if UseEscapes then
      OutMsg.Append(ExpandCtrlChars(Msg[Ct]))
    else
      OutMsg.Append(StripCtrlChars(Msg[Ct]));
  end;

  { Add header and trailer }
  OutMsg.PrePend(cStx + ID + cCr);
  OutMsg.Append(cCr);
  { start counting at beginning of string }
  Ct  := 1;

  EOMsg := False;
  while not EOMsg do begin
    { Block full and not end of message }
    if (Ct = MaxLen) and (Ct <= OutMsg.Len) then begin  { reached block length }

      if OutMsg[Ct-1] = cCr then begin
        {at end of field: insert <ETB> + CheckSum + <CR> }
        OutMsg.Insert(cEtb, Ct);
        Inc(Ct);
        OutMsg.Insert(CheckSum(SumChars(OutMsg.Copy(1,Ct-1))) + cCr, Ct);
      end

      else begin
      {inside a field: insert <US> + CheckSum + <CR>}
        OutMsg.Insert(cUs, Ct);
        Inc(Ct);
        OutMsg.Insert(CheckSum(SumChars(OutMsg.Copy(1,Ct-1))) + cCr, Ct);
      end;

      { save block into block list }
      Inc(Ct, 3);  {move to end of block}
      Blocks.Add(OutMsg.Copy(1,Ct));

      { and start new block }
      OutMsg.Delete(1,Ct); { start new block }
      OutMsg.PrePend(cStx);
      Ct := 1;
    end

    { End of message }
    else if Ct = OutMsg.Len then begin
    { at end of message: append <ETX> + CheckSum + <CR> }
      OutMsg.Append(cEtx);
      Inc(Ct);
      Blocks.Add(OutMsg.Copy(1,Ct) + CheckSum(SumChars(OutMsg.Copy(1,Ct))) + cCr);
      EOMsg := True;
    end

    { counting chars }
    else begin
      Inc(Ct);
    end;
  end;
  OutMsg.Free;
end;

constructor TApdTAPPager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBlocks := TStringList.Create;
  FPageMode := 'TAP';
  FFailReason := '';
  tpPingTimer := TTimer.Create(nil);
  tpPingTimer.Enabled := False;
  tpPingTimer.Interval := 2000;
  tpPingTimer.OnTimer := PingTimerOnTimer;
end;

destructor TApdTAPPager.Destroy;
begin
  FBlocks.Free;
  tpPingTimer.Free;
  inherited Destroy;
end;

procedure TApdTAPPager.DoStartCall;
begin
  tpPingCount := 0; 
  if not DirectToPort then
    inherited DoStartCall;
  WriteToEventLog(FormatLogEntry(FPageMode, PagerID, PhoneNumber,
    FFailReason, pcStart));
  FPort.Dispatcher.RegisterEventTriggerHandler(DataTriggerHandler);
end;

procedure TApdTAPPager.DoFirstMessageBlock;
begin
  if Assigned(FPort) then begin
    BuildTapMessages(FPagerID,FMessage,FUseEscapes,FMaxMsgLen,FBlocks);
    FMsgIdx := 0;
    tpTAPRetries := 0;
    DoCurMessageBlock;
  end;
end;

procedure TApdTAPPager.DoCurMessageBlock;
begin
  DoTAPStatus(psSendingMsg);
  Inc(tpTAPRetries);
  FPort.Output := FBlocks[FMsgIdx];
end;

procedure TApdTAPPager.DoNextMessageBlock;
begin
  Inc(FMsgIdx);
  tpTAPRetries := 0;
  DoCurMessageBlock;
end;

procedure TApdTAPPager.ReSend;
begin
  DoFirstMessageBlock;
end;


procedure TApdTAPPager.PingTimerOnTimer(Sender: TObject);
begin
  if Port.Open and (Port.OutBuffFree > 0) then begin
    Port.Output := cCr;
  end;
  Inc(tpPingCount, 2);
  if tpPingCount > FTapWait then begin
    tpPingTimer.Enabled := False;
    DoTAPStatus(psLoginFail);
    FreeLoginTriggers;
    TerminatePage;                                                       {!!.02}
    DoDialStatus(dsCancelling);
    DelayTicks(STD_DELAY * 2, True);
    FAborted := True;
  end;
end;

procedure TApdTAPPager.StartPingTimer;
begin
  {if Port.OutBuffFree > 0 then
    Port.Output := cCr; }                                                {!!.04}
  tpPingTimer.Enabled := True;
end;

procedure TApdTAPPager.DonePingTimer;
begin
  if Assigned(tpPingTimer) then begin
    tpPingTimer.Enabled := False;
  end;
end;

procedure TApdTAPPager.DoTAPStatus(Status: TTapStatus);
begin
  FPageStatus := Status;
  if Assigned(FOnTAPStatus) then
    FOnTAPStatus(self, Status);
end;

{ trigger management }
function TApdTAPPager.HandleToTrigger(TriggerHandle:Word): string;
begin
  if TriggerHandle      = 0 then Result := 'Null Trigger'
  else if TriggerHandle = FtrgIDPrompt  then  Result := 'FtrgIDPrompt'
  else if TriggerHandle = FtrgLoginSucc then  Result := 'FtrgLoginSucc'
  else if TriggerHandle = FtrgLoginFail then  Result := 'FtrgLoginFail'
  else if TriggerHandle = FtrgLoginErr  then  Result := 'FtrgLoginErr'
  else if TriggerHandle = FtrgOkToSend  then  Result := 'FtrgOkToSend'
  else if TriggerHandle = FtrgMsgAck    then  Result := 'FtrgMsgAck'
  else if TriggerHandle = FtrgMsgNak    then  Result := 'FtrgMsgNak'
  else if TriggerHandle = FtrgMsgRs     then  Result := 'FtrgMsgRs'
  else if TriggerHandle = FtrgDCon      then  Result := 'FtrgDCon'
  else Result := 'Unknown Trigger: ' + IntToStr(TriggerHandle);
end;

procedure TApdTAPPager.InitLoginTriggers;
begin
  FtrgIDPrompt  := FPort.AddDataTrigger(TAP_ID_PROMPT,    False);
  FtrgLoginSucc := FPort.AddDataTrigger(TAP_LOGIN_ACK,    False);
  FtrgLoginFail := FPort.AddDataTrigger(TAP_LOGIN_FAIL,   False);
  FtrgLoginErr  := FPort.AddDataTrigger(TAP_LOGIN_NAK,    False);
end;

procedure TApdTAPPager.FreeLoginTriggers;
begin
  FreeTrigger(FPort,FtrgIDPrompt,  HandleToTrigger(FtrgIDPrompt));
  FreeTrigger(FPort,FtrgLoginSucc, HandleToTrigger(FtrgLoginSucc));
  FreeTrigger(FPort,FtrgLoginErr,  HandleToTrigger(FtrgLoginErr));
  FreeTrigger(FPort,FtrgLoginFail, HandleToTrigger(FtrgLoginFail));
end;

procedure TApdTAPPager.InitLogoutTriggers;
begin
  FtrgDCon := FPort.AddDataTrigger(TAP_DISCONNECT, False);
end;

procedure TApdTAPPager.FreeLogoutTriggers;
begin
    FreeTrigger(FPort, FtrgDCon, HandleToTrigger(FtrgDCon));
end;

procedure TApdTAPPager.InitMsgTriggers;
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 TApdTAPPager.FreeResponseTriggers;
begin
    FreeTrigger(FPort, OKTrig, FapOKTrig);
    FreeTrigger(FPort, ErrorTrig, FapErrorTrig);
    FreeTrigger(FPort, ConnectTrig, FapConnectTrig);
    FreeTrigger(FPort, BusyTrig, FapBusyTrig);
    FreeTrigger(FPort, VoiceTrig, FapVoiceTrig);
    FreeTrigger(FPort, NoCarrierTrig, FapNoCarrierTrig);
    FreeTrigger(FPort, NoDialtoneTrig, FapNoDialtoneTrig);
    FPort.SetTimerTrigger(FtrgSendTimer, 0, False);                      {!!.04}
    FPort.RemoveTrigger(FtrgSendTimer);                                  {!!.04}
    FtrgSendTimer := 0;                                                  {!!.05}
end;

procedure TApdTAPPager.FreeMsgTriggers;
begin
  FreeTrigger(FPort,FtrgOkToSend, HandleToTrigger(FtrgOkToSend));
  FreeTrigger(FPort,FtrgMsgAck,   HandleToTrigger(FtrgMsgAck));
  FreeTrigger(FPort,FtrgMsgNak,   HandleToTrigger(FtrgMsgNak));
  FreeTrigger(FPort,FtrgMsgRs,    HandleToTrigger(FtrgMsgRs));
end;

procedure TApdTAPPager.DataTriggerHandler(Msg, wParam: Cardinal; lParam: LongInt);
var
  Done : Boolean;
  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    {!!.04}
    DoTAPStatus(psSendTimedOut);                                         {!!.04}
    if FMsgIdx < Pred(FBlocks.Count) then begin                          {!!.04}
      DoNextMessageBlock;                                                {!!.04}
    end                                                                  {!!.04}
  end;                                                                   {!!.04}


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

    try
      if wParam = OKTrig then
        mpGotOkay := True
      else if wParam = ErrorTrig then begin
        FConnected := False;
        FCancelled := True;
        FAborted := True;
        Waiting := False;
      end

      else if wParam = ConnectTrig then begin
        FConnected := True;
        Waiting := False;
        DoDialStatus(dsConnected);
        InitLoginTriggers;
        StartPingTimer;
      end

      else if wParam = BusyTrig then begin
        FConnected := False;
        Waiting := False;
        DoDialStatus(deLineBusy);
      end

      else if wParam = VoiceTrig then begin

      end

      else if wParam = NoCarrierTrig then begin
        FConnected := False;
        FCancelled := True;
        Waiting := False;
        DoDialStatus(dsDisconnect);
      end

      else if wParam = NoDialtoneTrig then begin
        FConnected := False;
        Waiting := False;
        DoDialStatus(deNoDialTone);
      end

      else if wParam = FtrgIDPrompt then begin       { got login prompt }
        DonePingTimer;
        DoTAPStatus(psLoginPrompt);
        if FPassword <> '' then
          FPort.Output := TAP_AUTO_LOGIN + FPassword + cCr
        else
          FPort.Output := TAP_AUTO_LOGIN + cCr;

        FreeTrigger(FPort,FtrgIDPrompt,  HandleToTrigger(FtrgIDPrompt));
      end

      else if wParam = FtrgLoginSucc then begin { login accept }
        DoTAPStatus(psLoggedIn);
        FreeLoginTriggers;
        InitMsgTriggers;
      end

      else if wParam = FtrgLoginFail then begin { login failure }
        DoTAPStatus(psLoginFail);
        FreeLoginTriggers;
        InitLogoutTriggers;
        TerminatePage;                                                   {!!.02}
        DoDialStatus(dsCancelling);
        DelayTicks(STD_DELAY * 2, True);
        FAborted := True;
      end

      else if wParam = FtrgLoginErr then begin  { login error }
        DoTAPStatus(psLoginErr);
        FreeLoginTriggers;
        InitLogoutTriggers;
        TerminatePage;                                                   {!!.02}
        DoDialStatus(dsCancelling);
        DelayTicks(STD_DELAY * 2, True);
        FAborted := True;
      end

      else if wParam = FtrgOkToSend then begin  { okay to start sending message }
        DoTAPStatus(psMsgOkToSend);
        DoFirstMessageBlock;
      end

      else if wParam = FtrgMsgAck then begin