⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 admdm.pas

📁 测试用例
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    property DialTimeout;
    property ModemCapFolder;
    property RingWaitTimeout;
    property SelectedDevice;
    property StatusDisplay;

    property OnModemCallerID;
    property OnModemConnect;
    property OnModemDisconnect;
    property OnModemFail;
    property OnModemLog;
    property OnModemStatus;
  end;

  TAdAbstractModemStatus = class(TApdBaseComponent)
  private
    FStatusDialog: TForm;
    FCaption: string;
    FStarted: Boolean;
    FModem: TAdCustomModem;
    procedure SetCaption(const Value: string);
    procedure SetStarted(Start : Boolean);
    procedure SetModem(const Value: TAdCustomModem);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    property StatusDialog : TForm
      read FStatusDialog write FStatusDialog;
    property Caption : string
      read FCaption write SetCaption;
    property Modem : TAdCustomModem
      read FModem write SetModem;
    property Started : Boolean
      read FStarted;
    procedure UpdateDisplay(Modem : TAdCustomModem;
      const StatusStr, TimeStr, DetailStr : string;
      Action : TApdModemStatusAction);
  end;

  TAdModemStatus = class(TAdAbstractModemStatus)
  published
    property Caption;
    property Modem;
  end;


implementation

uses
  AdMdmCfg,
  AdMdmDlg;

{ TApdModemNameProp }

procedure TApdModemNameProp.Assign(Source: TPersistent);                {!!.02}   
begin
  if Source is TApdModemNameProp then begin
    Clear;                                             
    {Property inits}
    FManufacturer := TApdModemNameProp(Source).FManufacturer;
    FName := TApdModemNameProp(Source).FName;
    FModemFile := TApdModemNameProp(Source).FModemFile;
  end;
end;

procedure TApdModemNameProp.Clear;                                       {!!.02}
  { clear the values }
begin
  FManufacturer := '';
  FModemFile := '';
  FName := '';
end;

procedure TApdModemNameProp.SetManufacturer(const Value: string);
  { write access method for Manufacturer property }
begin
  if FManufacturer <> Value then begin
    FManufacturer := Value;
  end;
end;

procedure TApdModemNameProp.SetModemFile(const Value: string);
begin
  FModemFile := Value;
end;

procedure TApdModemNameProp.SetName(const Value: string);
  { write access method for Name property }
begin
  FName := Value;
end;

{ TAdCustomModem }

procedure TAdCustomModem.ModemMessage(var Message: TMessage);
begin
  case Message.Msg of
    apw_AutoAnswer :
      begin
        { got the message to answer the call... }
        PrepForConnect(True);
        {$IFDEF AdModemDebug}
        FComPort.AddStringToLog('Answering');
        {$ENDIF}
        if not SendCommands(LmModem.Answer) then
          DoFail(ecModemRejectedCommand);
      end;
    apw_CancelCall :
      begin
        CancelCall;
      end;
    apw_StartDial :
      begin
        ResponsePacket.Enabled := True;
        if FModemConfig.ToneDial then                                    {!!.06}
          FComPort.Output := ConvertXML(LmModem.Settings.Prefix +
                                        LMModem.Settings.DialPrefix +
                                        LmModem.Settings.Tone +          {!!.06}
                                        FPhoneNumber +
                                        LmModem.Settings.Terminator)
        else
          FComPort.Output := ConvertXML(LmModem.Settings.Prefix +
                                        LMModem.Settings.DialPrefix +
                                        LmModem.Settings.Pulse +         {!!.06}
                                        FPhoneNumber +
                                        LmModem.Settings.Terminator);
        DoStatus(msConnectWait);
      end;
    else                                                                 {!!.02}
      try                                                                {!!.02}
        Dispatch(Message);                                               {!!.02}
        if Message.Msg = WM_QUERYENDSESSION then                         {!!.02}
          Message.Result := 1;                                           {!!.02}
      except                                                             {!!.02}
        Application.HandleException(Self);                               {!!.02}
      end;                                                               {!!.02}
  end;
end;

procedure TAdCustomModem.AutoAnswer;
  { initiate auto answer mode }
begin
  CheckReady;
  FCallerIDProvided := False;
  if not Initialized then
    Initialize;
  {$IFDEF AdModemDebug}
  FComPort.AddStringToLog('autoanswer for ' + IntToStr(FAnswerOnRing));
  {$ENDIF}
  { turn on the CallerID detection }
  SendCommands(LmModem.Voice.EnableCallerID);

  DoStatus(msAutoAnswerBackground);
  ResponsePacket.Timeout := 0;
  ResponsePacket.EnableTimeout := 0;                                     {!!.04}
  ResponsePacket.Enabled := True;
end;

procedure TAdCustomModem.CancelCall;
  { cancel whatever we're doing, we'll keep the port open }
{var
  ET : EventTimer;}                                                      {!!.05}
begin
  if not Assigned(FComPort) then                                         {!!.01}
    Exit;                                                                {!!.01}
  FCallerIDProvided := False;
  DoStatus(msCancel);
  {$IFDEF AdModemDebug}
  if Assigned(FComPort) then
    FComPort.AddStringToLog('cancel call');
  {$ENDIF}

  if Connected then begin
    DoStatus(msHangup);
    { try lowering DTR first }
    { section rewritten to use SendCommand }                             {!!.05}
    //if not SendCommand('<DTR>') then begin                             {!!.05}
      SendCommand(apxDefModemEscape);
      SendCommands(LmModem.Hangup);
    //end;                                                               {!!.05}
    { end rewrite }                                                      {!!.05}       
  end else if FModemState in [msAnswerWait, msConnectWait] then
    { we've started answering/dialing, send a #13 to terminate that }
    SendCommand('');
  PrepForConnect(False);
  DoDisconnect;

  { close the port if it was closed when we started }
  if FPortWasOpen = 1 then                                               {!!.05}
    FComPort.Open := False;                                              {!!.05}
  FPortWasOpen := 0;                                                     {!!.05}
  FConnected := False;
  LastCommand := '';                                                     {!!.05}
  if Initialized then
    DoStatus(msIdle)
  else
    DoStatus(msUnknown);
end;

procedure TAdCustomModem.CheckCallerID(const Response: string);
  { check for the CallerID tags }
var
  I,
  Psn : Integer;
  S : string;

  function CheckIt : Boolean;
  begin
    Psn := Pos(S, Response);
    if Psn > 0 then begin
      Result := True;
      S := Copy(Response, Psn + Length(S) + 1, Length(Response));
      S := Copy(S, 1, Length(S) - 2);
    end else
      Result := False;
  end;

begin
  if LmModem.Responses.Date.Count > 0 then
    for I := 0 to pred(LmModem.Responses.Date.Count) do begin
      S := ConvertXML(PLmResponseData(LmModem.Responses.Date[I]).Response);
      if CheckIt then begin
        FCallerIDInfo.HasData := True;
        FCallerIDInfo.Date := S;
      end;
    end;

  if LmModem.Responses.Time.Count > 0 then
    for I := 0 to pred(LmModem.Responses.Time.Count) do begin
      S := ConvertXML(PLmResponseData(LmModem.Responses.Time[I]).Response);
      if CheckIt then begin
        FCallerIDInfo.HasData := True;
        FCallerIDInfo.Time := S;
      end;
    end;

  if LmModem.Responses.Number.Count > 0 then
    for I := 0 to pred(LmModem.Responses.Number.Count) do begin
      S := ConvertXML(PLmResponseData(LmModem.Responses.Number[I]).Response);
      if CheckIt then begin
        FCallerIDInfo.HasData := True;
        FCallerIDInfo.Number := S;
      end;
    end;

  if LmModem.Responses.Name.Count > 0 then
    for I := 0 to pred(LmModem.Responses.Name.Count) do begin
      S := ConvertXML(PLmResponseData(LmModem.Responses.Name[I]).Response);
      if CheckIt then begin
        FCallerIDInfo.HasData := True;
        FCallerIDInfo.Name := S;
      end;
    end;

  if LmModem.Responses.Msg.Count > 0 then
    for I := 0 to pred(LmModem.Responses.Msg.Count) do begin
      S := ConvertXML(PLmResponseData(LmModem.Responses.Msg[I]).Response);
      if CheckIt then begin
        FCallerIDInfo.HasData := True;
        FCallerIDInfo.Msg := S;
      end;
    end;

end;

function TAdCustomModem.CheckErrors(const Response: string): Integer;
begin
  if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.Error) then
    Result := ecModemRejectedCommand
  else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoCarrier) then
    Result := ecModemNoCarrier
  else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoDialTone) then
    Result := ecModemNoDialTone
  else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.Busy) then
    Result := ecModemDetectedBusy
  else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoAnswer) then
    Result := ecModemNoAnswer
  else
    Result := ecOK;
end;

procedure TAdCustomModem.CheckReady;
begin
  if not Assigned(FComPort) then
    raise EPortNotAssigned.Create(ecPortNotAssigned, False);

  { save the state of the port, we'll close it from CancelCall if it }
  { is closed here.  0=not set, 1=closed, 2=open }
  if FPortWasOpen = 0 then                                               {!!.05}
    if FComPort.Open then                                                {!!.05}
      FPortWasOpen := 2                                                  {!!.05}
    else                                                                 {!!.05}
      FPortWasOpen := 1;                                                 {!!.05}

  {FComPort.OnTriggerStatus := TriggerEvent;}                            {!!.06}
  {FComPort.OnTriggerTimer := TriggerEvent;}                             {!!.06}
  FSavedOnTrigger := FComPort.OnTrigger;                                 {!!.06}
  FComPort.OnTrigger := TriggerEvent;                                    {!!.06}

  if not Assigned(ResponsePacket) then begin
    ResponsePacket := TApdDataPacket.Create(Self);
    ResponsePacket.Name := Name + '_ResponsePacket';
    ResponsePacket.Enabled := False;
    ResponsePacket.AutoEnable := False;
    ResponsePacket.Timeout := ApxDefCommandTimeout;
    ResponsePacket.EnableTimeout := ApxDefCommandTimeout;                {!!.04}
    ResponsePacket.OnStringPacket := ResponseStringPacket;
    ResponsePacket.OnTimeout := ResponseTimeout;
    ResponsePacket.ComPort := FComPort;
    ResponsePacket.StartCond := scAnyData;
    ResponsePacket.EndCond := [ecString];
    ResponsePacket.EndString := '?'#13#10;
    ResponsePacket.Enabled := True;
  end;
  if not FComPort.Open then
    FComPort.Open := True;
end;

function TAdCustomModem.CheckResponses(const Response, DefResponse: string;
  Responses: TList): Boolean;
  function StripCtrl(const S : string) : string;
    { strip out the CR/LF prefix and suffix }
  begin
    Result := S;
    while Pos(#13, Result) > 0 do
      Delete(Result, Pos(#13, Result), 1);
    while Pos(#10, Result) > 0 do
      Delete(Result, Pos(#10, Result), 1);
  end;
var
  I : Integer;
  S : string;
begin
  { assume it's not a response that we're looking for }
  Result := False;
  if Responses.Count > 0 then begin
    for I := 0 to pred(Responses.Count) do begin
      S := ConvertXML(PLmResponseData(Responses[I]).Response);
      if StripCtrl(S) = StripCtrl(Response) then begin
        Result := True;
        {Break;}                                                         {!!.05}
      end;
      if S = '<StandardConnect>' then                                    {!!.05}
        Result := ParseStandardConnect(Response);                        {!!.05}
      if Result then Break;                                              {!!.05}                                                     
    end;
    if not Result then
      Result := Pos(DefResponse, Response) > 0;
  end else
    { see if the default response is at the beginning of the response }
    Result := Pos(DefResponse, Response) > 0;                            {!!.04}
end;

procedure TAdCustomModem.ConfigAndOpen;
  { open the port and configure the modem }
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -