adpgr.pas

测试用例

  end;
end;

procedure TApdCustomPager.SetUseEscapes(UseEscapesVal: Boolean);
  { Set UseEscapes property }
begin
  FUseEscapes := UseEscapesVal;
end;

procedure TApdCustomPager.TerminatePage;
  { This procedure is called when not using TAPI to hangup modem }
var
  TheCommand, Data : String;
  FPacket : TApdDataPacket;
  I : Integer;
begin
  if   FTerminating or
       FTapHotLine  or
       not FPort.Open then
    exit;
  FTerminating := True;

  if FPort.TapiMode = tmOn then begin
    FTapiDevice.CancelCall;
    FTerminating := False;
    Exit;
  end;

  FPacket := nil;

  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 := FModemHangup;

    for I := 1 to Length(TheCommand) do
      if TheCommand[3] = '~' then
        DelayTicks(1, True)
      else
        FPort.PutChar(TheCommand[I]);  

    { append a CR if needed }
    if Pos(cCR, FModemHangup) <> Length(FModemHangup) - 2 then
      FPort.Output := cCR; 
    { we should be hung up by now, lower DTR just in case }
    if not FPacket.WaitForString(Data) then
      FPort.DTR := False;
  finally
    FPacket.Free;
    FTerminating := False;
  end;    

end;

procedure TApdCustomPager.WaitTimerOnTimer(Sender: TObject);
  { TAP: Event used for when the Event Timer fires }
begin
  if Assigned(WaitTimer) then begin
    WaitTimer.Enabled := False;
  end;
  if TempWait > 0 then begin
    if Assigned(FOnPageStatus) then
      FOnPageStatus(Self, psWaitingToRedial, TempWait, 0);
    WaitTimer.Enabled := True;
    dec(TempWait);
  end else begin
    { Attempt another dial }
    DoPageStatus(psRedialing);
  end;
end;

procedure TApdCustomPager.WndProc(var Message: TMessage);
  { Process Status events outside trigger state machine }
var
  Status : TPageStatus;
  Done : Boolean;
begin
  with Message do begin
    Status := TPageStatus(wParam);
    if Msg = Apw_PgrStatusEvent then begin
      if Assigned(FOnPageStatus) then
        FOnPageStatus(self, Status, 0, 0);
      case Status of

        psNone: begin
          { Nothing happening }
        end;

        psInitFail: begin
          FEventLog.AddLogString(True, sInitFail);
          DoPageError(ecInitFail);
        end;

        psConnected: begin
          FConnected := True;
          InitLoginTriggers;
          if not Assigned(tpPingTimer) then                              {!!.06}
            tpPingTimer := TTimer.Create(nil);                           {!!.06}
          tpPingTimer.Enabled := False;                                  {!!.06}
          tpPingTimer.Interval := 2000;                                  {!!.06}
          tpPingTimer.OnTimer := PingTimerOnTimer;                       {!!.06}
          tpPingTimer.Enabled := True;
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True, sConnected);
        end;

        psLineBusy: begin
          FConnected := False;
          FRedialFlag := False;
          FEventLog.AddLogString(True, sLineBusy);
          FAborted := ExitOnError;
          if FAborted then begin
            FEventLog.AddLogString(True, sModemDetectedBusy);
            DoPageError(ecModemDetectedBusy);
          end else begin
            { If the page was canceled or aborted then abort the call. }
            if FCancelled or FAborted or (SafeYield = wm_Quit) then begin
              if self.EventLog.FVerboseLog then
                FEventLog.AddLogString(True, sMsgNotSent);
              DoPageStatus(psMsgNotSent);
            end else begin
              { If the number of redial attempts has not been reached }
              inc(FDialAttempt);                                         {!!.06}
              if (FDialAttempt < FDialAttempts) then begin
                FRedialFlag := True;
                //inc(FDialAttempt);                                     {!!.06}
                //DonePingTimer;                                         {!!.06}
                if self.EventLog.FVerboseLog then
                  FEventLog.AddLogString(True, sWaitingToRedial);
                DoPageStatus(psWaitingToRedial);
              end else begin
                FCancelled := True;
                DoPageError(ecModemDetectedBusy);                        {!!.06}
              end;
            end;
          end;
        end;

        psDisconnect: begin
          FConnected := False;
          FCancelled := True;
          FRedialFlag := False;
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True, sModemNoCarrier);
          DoPageError(ecModemNoCarrier);
        end;

        psNoDialtone: begin
          FConnected := False;
          FRedialFlag := False;
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True, sModemNoDialtone);
          DoPageError(ecModemNoDialtone);
        end;

        psMsgNotSent: begin
          { Only do status event }
        end;

        psWaitingToReDial: begin
          { Wait the redial time and try again! }
          if not Assigned(WaitTimer) then
            WaitTimer := TTimer.Create(nil);
          WaitTimer.Enabled := False;
          WaitTimer.Interval := 1000;
          WaitTimer.OnTimer := WaitTimerOnTimer;
          WaitTimer.Enabled := True;
        end;

        psLoginPrompt: begin
          { TAP login prompt }
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True, sLoginPrompt);
          DonePingTimer;
          if FPassword <> '' then
            FPort.Output := TAP_AUTO_LOGIN + FPassword + cCr
          else
            FPort.Output := TAP_AUTO_LOGIN + cCr;
        end;

        psLoggedIn: begin
          { SNPP Logged in }
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True,sLoggedIn);
          FreeLoginTriggers;
          InitMsgTriggers;
          FLoginRetry := True;
        end;

        psLoggingOut: begin
          if self.EventLog.FVerboseLog then
            FEventLog.AddLogString(True, sLoggingOut);
        end;

        psDialing: begin
          { Only do status event }
        end;

        psRedialing: begin
          WaitTimer.Free;
          WaitTimer := nil;                                              {!!.06}
          if FRedialFlag then
            DoDial;
        end;

        psLoginRetry: begin
          if FLoginRetry then begin
            if FPassword <> '' then
              FPort.Output := TAP_AUTO_LOGIN + FPassword + cCr
            else
              FPort.Output := TAP_AUTO_LOGIN + cCr;
            FLoginRetry := False;
          end else begin
            if self.EventLog.FVerboseLog then
              FEventLog.AddLogString(True, sLoginFail);
            DoPageError(ecLoginFail);
            FreeLoginTriggers;
            FAborted := True;
            FLoginRetry := True;
          end;
        end;

        psMsgOkToSend: begin
          DoFirstMessageBlock;
        end;

        psSendingMsg: begin
          { Only do status event }
        end;

        psMsgAck: begin
        { receipt okay, send next block or end if no more }
          if FMsgIdx < Pred(FMsgBlockList.Count) then begin
            DoNextMessageBlock;
            Done := False;
          end else begin
            Done := True;
            if Assigned(FOnGetNextMessage) then begin
              OnGetNextMessage(self, Done);
                if not Done then begin
                  // Doing first message block
                  DoPageStatus(psMsgOkToSend);
                  Exit;
                end;
            end;
            FSent := True;
            FreeMsgTriggers;
            InitLogoutTriggers;
            LogOutTAP;
          end;
        end;

        psMsgNak: begin
          if FDialAttempt < FDialAttempts then
            DoCurMessageBlock
          else
            LogOutTAP;
        end;

        psMsgRs: begin { Unable to send page }
          if FMsgIdx < Pred(FMsgBlockList.Count) then begin
            DoNextMessageBlock;
          end else begin
            Done := True;
            if Assigned(FOnGetNextMessage) then begin
              OnGetNextMessage(self, Done);
              if not Done then begin
                DoFirstMessageBlock;
                Exit;
              end;
            end else
              LogOutTAP;
          end;
        end;

        psMsgCompleted: begin
          { Only do status event }
        end;

        psSendTimedOut: begin
          if FMsgIdx < Pred(FMsgBlockList.Count) then begin
            DoNextMessageBlock;
          end;
        end;

        psDone: begin
          FreeLogoutTriggers;
          FreeResponseTriggers;
          if Assigned(FTapiDevice) then begin
            FPort.Dispatcher.DeregisterEventTriggerHandler
                                (DataTriggerHandler);
            FTapiDevice.CancelCall
          end else begin
            FPort.Dispatcher.DeregisterEventTriggerHandler
                                (DataTriggerHandler);
            if FPort.Open and not FTapHotLine
                          and not FPortOpenedByUser then                 {!!.06}
              FPort.Open := False;
          end;

          if not FSent then
            DoFailedToSend
          else
            FEventLog.AddLogString(True, sDone);

          if Assigned(FOnPageFinish) then
            FOnPageFinish(self, 0, '');
        end;
      end;
      Result := 1;
    end else
      Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  end;
end;

{ TApdTapProperties }

constructor TApdTapProperties.Create(Owner : TApdCustomPager);
begin
  FOwner := Owner;
end;

function TApdTapProperties.GetBlindDial: Boolean;
begin
  Result := FOwner.BlindDial;
end;

function TApdTapProperties.GetDialAttempts: Word;
begin
  Result := FOwner.DialAttempts;
end;

function TApdTapProperties.GetDialPrefix: string;
begin
  Result := FOwner.DialPrefix;
end;

function TApdTapProperties.GetMaxMessageLength: Integer;
begin
  Result := FOwner.MaxMessageLength;
end;

function TApdTapProperties.GetModemHangup: string;
begin
  Result := FOwner.ModemHangup;
end;

function TApdTapProperties.GetModemInit: string;
begin
  Result := FOwner.ModemInit;
end;

function TApdTapProperties.GetPortOpts: TPortOpts;
begin
  Result := FOwner.PortOpts;
end;

function TApdTapProperties.GetTapHotLine: Boolean;
begin
  Result := FOwner.TapHotLine;
end;

function TApdTapProperties.GetTapiDevice: TApdTapiDevice;
begin
  Result := FOwner.TapiDevice;
end;

function TApdTapProperties.GetTapWait: Integer;
begin
  Result := FOwner.TapWait;
end;

function TApdTapProperties.GetToneDial: Boolean;
begin
  Result := FOwner.ToneDial;
end;

procedure TApdTapProperties.SetBlindDial(const Value: Boolean);
begin
  FOwner.BlindDial := Value;
end;

procedure TApdTapProperties.SetDialAttempts(const Value: Word);
begin
  FOwner.DialAttempts := Value;
end;

procedure TApdTapProperties.SetDialPrefix(const Value: string);
begin
  FOwner.DialPrefix := Value;
end;

procedure TApdTapProperties.SetMaxMessageLength(const Value: Integer);
begin
  FOwner.MaxMessageLength := Value;
end;

procedure TApdTapProperties.SetModemHangup(const Value: string);
begin
  FOwner.ModemHangup := Value;
end;

procedure TApdTapProperties.SetModemInit(const Value: string);
begin
  FOwner.ModemInit := Value;
end;

procedure TApdTapProperties.SetPortOpts(const Value: TPortOpts);
begin
  FOwner.PortOpts := Value;
end;

procedure TApdTapProperties.SetTapHotLine(const Value: Boolean);
begin
  FOwner.TapHotLine := Value;
end;

procedure TApdTapProperties.SetTapiDevice(const Value: TApdTapiDevice);
begin
  FOwner.TapiDevice := Value;
end;

procedure TApdTapProperties.SetTapWait(const Value: Integer);
begin
  FOwner.TapWait := Value;
end;

procedure TApdTapProperties.SetToneDial(const Value: Boolean);
begin
  FOwner.ToneDial := Value;
end;

{ TApdPager }

constructor TApdPager.Create(AOwner: TComponent);
begin
  inherited;
  FTapProperties := TApdTapProperties.Create(Self);
end;

destructor TApdPager.Destroy;
begin
  FTapProperties.Free;
  inherited;
end;

{ TApdPgrLog }

procedure TApdPgrLog.AddLogString(Verbose: Boolean;
                            const StatusString: string);
  { Add a string to the TApdPager's Log if EventLog is Enabled }
var
  DestAddr : string;
  LogStream : TFileStream;
  TimeStamp : string;

begin
  if FEnabled then
    if Verbose and FVerboseLog then begin
      if FOwner.FPagerMode = pmSNPP then
        with TApdCustomWinsockPort(FOwner.FPort) do
          DestAddr := wsAddress
      else if FOwner.FPagerMode = pmTAP then
        DestAddr := FOwner.FPhoneNumber;
      DestAddr := DestAddr + ' ';
      if FileExists(FLogName) then
        LogStream := TFileStream.Create(FLogName, fmOpenReadWrite or fmShareDenyNone)
      else
        LogStream := TFileStream.Create(FLogName, fmCreate or fmShareDenyNone);
      LogStream.Seek(0, soFromEnd);
      TimeStamp := FormatDateTime('dd/mm/yy : hh:mm:ss - ', Now) + ' ' +
                   FOwner.FPageMode + ' page to ' + FOwner.FPagerID + ' at ' +
                   DestAddr + StatusString + #13#10;
      LogStream.WriteBuffer(TimeStamp[1], Length(TimeStamp));
      LogStream.Free;
    end;
end;

procedure TApdPgrLog.ClearLog;
  { Delete the log file }
begin
  SysUtils.DeleteFile(FLogName);
end;

constructor TApdPgrLog.Create(Owner: TApdCustomPager);
begin
  FOwner := Owner;
end;

end.