adpager.pas

测试用例

    if (FDialError = deNoDialTone) then
      case FBlindDial of
        False: begin
          Error := True;
          FFailReason := 'No Dial Tone';
        end;
        True:  DialNumber
      end
    else { got dial tone }
      if not FConnected then                                             {!!.05}
        DialNumber;

    if Error then
      FAborted := ExitOnError;
    if FCancelled or FAborted then
      TerminatePage                                                      {!!.02}
    else begin
      if (FDialAttempt < FDialAttempts) and Error then begin             {!!.04}
        Wait(FDialRetryWait, dsWaitingToRedial);                         {!!.02}
        Error := False;                                                  {!!.04}
      end;                                                               {!!.04}
      Inc(FDialAttempt);
    end;
  end;

  if not FSent then
    DoFailedToSend
  else
    WriteToEventLog(FormatLogEntry(FPageMode, PagerID, PhoneNumber, '', pcDone));
end;

{ rewritten to use TApdDataPacket.WaitForString !!.04 }
procedure TApdCustomModemPager.TerminatePage;                            {!!.04}
// This procedure is called when not using TAPI
var
  TheCommand : String;
  FPacket : TApdDataPacket;
  Data: String;
begin
{ this is a 'when all else fails' method to terminate the connection, }
{ the server is supposed to disconnect when it sends its final ACK }
  if DirectToPort or
     not FPort.Open or
     not FPort.DCD then
    exit;

  FPacket := nil;

  if FPort.TapiMode = tmOn then begin
    FTapiDev.CancelCall;
    Exit;
  end;

  try
    TheCommand := '';
    FPacket := TApdDataPacket.Create(Self);
    FPacket.StartString := 'OK';
    FPacket.StartCond := scString;
    FPacket.ComPort := FPort;
    FPacket.Timeout := 91; { 5 second timeout }

    {assume ModemHangup = '+++~~~ATH' }
    TheCommand := ModemHangup;

    if Pos('+++', TheCommand) = 1 then begin
      FPort.Output := '+++';
      FPacket.WaitForString(Data); { ignoring the result }
      TheCommand := Copy(TheCommand, 4, Length(TheCommand)); {remove the escape}
      { assume TheCommand = '~~~ATH' }
    end;

    while (Length(TheCommand) > 1) and (TheCommand[1] = '~') do
      TheCommand := Copy(TheCommand, 2, Length(TheCommand));  { remove any tildas }
    { assume TheCommand = 'ATH' }

    { append a CR if needed }
    if Pos(#13, ModemHangup) <> Length(ModemHangup) - 2 then
      TheCommand := TheCommand + #13;
    { assume TheCommand = 'ATH'#13 }
    FPort.Output := TheCommand;
    FPacket.WaitForString(Data);
    { we should be hung up by now, lower DTR just in case }
    FPort.DTR := False;

  finally
    FPacket.Free;
  end;
end;

procedure TApdCustomModemPager.DoFailedToSend;
begin
  DoDialStatus(dsMsgNotSent);
  WriteToEventLog(FormatLogEntry(FPageMode, PagerID, PhoneNumber,
    FFailReason, pcError));
end;

procedure TApdCustomModemPager.DoDialStatus(Event: TDialingCondition);
begin
  case Event of
    {TDialingStatus} dsNone..dsCleanup: begin
      FDialStatus := Event;
      if Assigned(FOnDialStatus) then
        FOnDialStatus(self,Event);
    end;

    {TDialError} deNone..deNoConnection: begin
      FDialError := Event;
      if Assigned(FOnDialError) then
        FOnDialError(self,Event);
    end;
  end;
end;

procedure TApdCustomModemPager.DoStartCall;
begin
  { Do Nothing for now }
end;


procedure TApdCustomModemPager.SetTapiDev(const Value: TApdTapiDevice);
begin
  FTapiDev := Value;
  if Assigned(FTapiDev) then begin
    if Assigned(FPort) then begin
      FTapiDev.ComPort := FPort;
      if FUseTapi then
        FPort.TapiMode := tmOn;
    end;
    FTapiDev.EnableVoice := False;
  end;
end;

function TApdCustomModemPager.GetTapiDev: TApdTapiDevice;
begin
  Result := FTapiDev;
end;

procedure TApdCustomModemPager.InitCallStateFlags;
begin
  FAborted    := False;
  FCancelled  := False;
  FConnected  := False;
  FDialStatus := dsNone;
  FDialError  := deNone;
end;


procedure TApdCustomModemPager.InitProperties;
begin
  FDirectToPort := False;
  FAbortNoConnect := adpgDefAbortNoConnect;
  FExitOnError    := adpgDefExitOnError;
  FDialAttempts   := adpgDefDialAttempts;
  FDialRetryWait  := adpgDefDialRetryWait;
  FDialWait       := adpgDefDialWait;
  FBlindDial    := adpgDefBlindDial;
  FToneDial     := adpgDefToneDial;

  DialPrefix := 'AT' + adpgToneDialPrefix;
  ModemHangup := adpgDefModemHangupCmd;
  ModemInit := adpgDefModemInitCmd;
  FUseTapi    := False;
end;

procedure TApdCustomModemPager.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
  begin
    DoInitializePort;
  end;
  InitCallStateFlags;
end;

procedure TApdCustomModemPager.SetBlindDial(BlindDialVal: Boolean);
begin
  FBlindDial := BlindDialVal;
end;

procedure TApdCustomModemPager.SetDialPrefix(CmdStr: TCmdString);
begin
  if FDialPrefix <> CmdStr then
  begin
    FDialPrefix := CmdStr;
  end;
end;

procedure TApdCustomModemPager.SetModemHangup(CmdStr: TCmdString);
var
  I : Integer;                                                           {!!.02}
  StripM : Boolean;                                                      {!!.02}
begin
  Stripm := False;                                                       {!!.02}
  for I := 1 to Length(CmdStr) do begin                                  {!!.02}
    if CmdStr[I] = '^' then                                              {!!.02}
      StripM := True;                                                    {!!.02}
  end;                                                                   {!!.02}
  if StripM then                                                         {!!.02}
    CmdStr := Copy(CmdStr, 1, Pos('^',CmdStr) - 1);                      {!!.02}
  if FModemHangup <> CmdStr then begin
    FModemHangup := CmdStr;
  end;
end;

procedure TApdCustomModemPager.SetModemInit(CmdStr: TCmdString);
var
  I : Integer;                                                           {!!.02}
  StripM : Boolean;                                                      {!!.02}
begin
  Stripm := False;                                                       {!!.02}
  for I := 1 to Length(CmdStr) do begin                                  {!!.02}
    if CmdStr[I] = '^' then                                              {!!.02}
      StripM := True;                                                    {!!.02}
  end;                                                                   {!!.02}
  if StripM then                                                         {!!.02}
    CmdStr := Copy(CmdStr, 1, Pos('^',CmdStr) - 1);                      {!!.02}
  if FModemInit <> CmdStr then begin
    FModemInit := CmdStr;
  end;
end;

function TApdCustomModemPager.GetPort : TApdCustomComPort;
begin
  Result := FPort;
end;

procedure TApdCustomModemPager.SetPort(ThePort: TApdCustomComPort);
begin
  FPort := ThePort;
end;

procedure TApdCustomModemPager.SetPortOpts;
begin
  FPort.Parity := pEven;
  FPort.DataBits := 7;
  FPort.StopBits := 1;
end;

procedure TApdCustomModemPager.SetToneDial(ToneDial: Boolean);
var
  P : Integer;
begin
  if FToneDial <> ToneDial then begin
    FToneDial := ToneDial;

    case FToneDial of
      True: begin
        P := Pos(adpgPulseDialPrefix, DialPrefix);
        if P > 0 then begin
          Delete(FDialPrefix, P, 2);
          Insert(adpgToneDialPrefix, FDialPrefix, P);
        end
        else
          DialPrefix := DialPrefix + adpgToneDialPrefix;
      end;

      False: begin
        P := Pos(adpgToneDialPrefix, DialPrefix);
        if P > 0 then begin
          Delete(FDialPrefix, P, 2);
          Insert(adpgPulseDialPrefix, FDialPrefix, P);
        end
        else
          DialPrefix := DialPrefix + adpgPulseDialPrefix;
      end;
    end;
  end;
end;
 
procedure TApdCustomModemPager.DoDirect;
begin
  {override for speicalized features }
end;

procedure TApdTAPPager.Send;
begin
  if FDirectToPort then begin
    DoDirect;
  end else
    DoDial;
end;

function TApdCustomModemPager.DialStatusMsg(
  Status: TDialingCondition): string;
begin
  case Status of
    {TDialingStatus} dsNone..dsCleanup:
      Result := AproLoadStr(Ord(Status) + STRRES_DIAL_STATUS);
    {TDialError} deNone..deNoConnection:
      Result := AproLoadStr(Ord(Status) + STRRES_DIAL_ERROR);
  end;
end;

procedure TApdCustomModemPager.AddInitModemDataTrigs;
begin
  OKTrig := FPort.AddDataTrigger(FapOKTrig, True);
  ErrorTrig := FPort.AddDataTrigger(FapErrorTrig, True);
  ConnectTrig := FPort.AddDataTrigger(FapConnectTrig, True);
  BusyTrig := FPort.AddDataTrigger(FapBusyTrig, True);
  VoiceTrig := FPort.AddDataTrigger(FapVoiceTrig, True);
  NoCarrierTrig := FPort.AddDataTrigger(FapNoCarrierTrig, True);
  NoDialtoneTrig := FPort.AddDataTrigger(FapNoDialtoneTrig, True);
end;


procedure TApdCustomModemPager.SetUseTapi(const Value: Boolean);
begin
  FUseTapi := Value;
  case FUseTapi of
    True:  FPort.TapiMode := tmOn;
    False: FPort.TapiMode := tmOff;
  end;
end;

procedure TApdCustomModemPager.Notification(AComponent: TComponent;      {!!.02}
  Operation: TOperation);                                                {!!.02}
begin                                                                    {!!.02}
  inherited Notification(AComponent, Operation);                         {!!.02}
  if Operation = opRemove then begin                                     {!!.02}
    if AComponent = FTapiDev then                                        {!!.02}
      FTapiDev := nil;                                                   {!!.02}
  end else begin                                                         {!!.02}
    if (AComponent is TApdTapiDevice) and (FTapiDev = nil) then          {!!.02}
      FTapiDev := TApdTapiDevice(AComponent);                            {!!.02}
  end;                                                                   {!!.02}
end;                                                                     {!!.02}

{ TApdTAPPager }

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

function BuildTAPCtrlChar(C: char): string;
{add "SUB" character + C shifted up by 64 chars (^A -> "A")}
begin
  Result := cSub + Chr(Ord(c) + $40);
end;

function MakeCtrlChar(const S: string): char;
{convert string of the form "#nnn" or "^l" into
equivalent ASCII control character}
begin
  case S[1] of
    '#':begin
      Result := Chr(StrToInt(Copy(S, 2,Length(S)-1)));
    end;

    '^': begin
      Result := Chr(Ord(S[2]) - $40);
    end;

  else
    Result := S[1];
  end; {case}
end;

function ProcessCtrlChars(const S: string; Strip: Boolean): string;
var
  Start, Tail, Ctl: string;
  P,i: Integer;
  C: Char;

begin
  Start := '';
  Tail  := S;

  {find all "#nnn" escapes}
  P := Pos('#', Tail);

  while P > 0 do begin

    if Tail[P+1] = '#' then begin
      Start := Start + Copy (Tail, 1, P);    { copy past '#' }
      Tail  := Copy (Tail, P + 2, Length (Tail) - P);
    end else if not(Tail[P+1] in ['0'..'9','$']) then begin
      Start := Start + Copy(Tail,1,P);    { copy past '#' }
      Tail  := Copy(Tail,P+1,Length(Tail)-P);
    end
    else begin
      Start := Start + Copy(Tail,1,P-1);  { copy up to '#' }


      i := 1;

      if Tail[P+1] = '$' then begin {it's in hex format}
        Inc(i); { count "$" }
        while (UpCase(Tail[P+i]) in ['0'..'9', 'A'..'F']) and (i <= 3) do
          Inc(i);
      end

      else { decimal format }
        while (Tail[P+i] in ['0'..'9']) and (i <= 3) do
          Inc(i); { count digits}

      Ctl  := Copy(Tail,P,i);  { extract '#nnn' control char string }