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

📄 adsmodem.pas

📁 测试用例
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    FAutoRetryDial := AutoRetry;

    {If already dialing, then we have an implied Cancel; if already
     connected, then we have an implied Hangup}
    FModemStateFlags := FModemStateFlags or smsBatchInProgress;
    Hangup;
    Initialize;

    {If Initialize failed, exit}
    FModemStateFlags := FModemStateFlags and not smsBatchInProgress;
    if (FModemState <> smsReady) then
      Exit;

    msPrepareForDialResponse;
    SetModemState(smsDialWait);
    PutStringModem(FDialCmd + ' ' + FPhoneNumber + FDialTerminatorCmd);
    {flow continues in the state machine}
  end;
end;

procedure TApdCustomSModem.ExtendConnectTime(ExtraSeconds : Integer);
  {Extend the timer for the current connect attempt}
begin
  with FComPort do
    Dispatcher.ExtendTimer(msTimeoutTrigger, ExtraSeconds);
end;

procedure TApdCustomSModem.Hangup;
  {Break modem connection if connected.  If not connected, then Hangup
   implies a Cancel of the current operation (unless.}
var
  ExpectedResponses : String;

begin
  if (FModemStateFlags and smsWaitForInProgress) <> 0 then
    {modem is already waiting for data; prevent reentrancy}
    raise EModemBusy.Create(ecModemBusy, False);

  {make sure modem is ready}
  VerifyStarted;

  with FComPort do begin
    if (FModemState = smsConnected) or
       (FForceHangup) then begin
      FModemStateFlags := FModemStateFlags or smsWaitForInProgress;
      SetModemState(smsHangup);
      if (FHangupCmd = 'DTR') then begin
        {Do a hardware hangup}
        DTR := False;
        DelayTicks(FDTRDropHoldDelay, AllowYielding);
        DTR := True;
      end else begin
        {Do a software hangup}
        ExpectedResponses := OkMsg + #13#10 + MultiResponseSeparator +
                             ErrorMsg + #13#10 + MultiResponseSeparator +
                             NoCarrierMsg + #13#10;
        {$IFDEF Win32}
        PrepareWait;
        {$ENDIF}
        PutStringModem(FHangupCmd);
        {wait for a response from the modem or a timeout}
        WaitForMultiString(ExpectedResponses, CmdTimeout, FAllowYielding,
                           IgnoreCase, MultiResponseSeparator);
      end;

      if (msModemStatusTrigger <> 0) then
        RemoveTrigger(msModemStatusTrigger);
      msModemStatusTrigger := 0;

      FModemStateFlags := FModemStateFlags and not smsWaitForInProgress;
      SetModemState(smsReady);
    end else
      {Cancel implied}
      Cancel;
  end;
end;

procedure TApdCustomSModem.Initialize;
  {return modem to known state}
const
  {init results from WaitForMultiString}
  irTimeout = 0;
  irOk      = 1;
  irError   = 2;

var
  InitResult        : Integer;
  InitCmdRemainder  : String;
  InitCmdPart       : String;
  ExpectedResponses : String;

begin
  if (FModemStateFlags and smsWaitForInProgress) <> 0 then
    {modem is already waiting for data; prevent reentrancy}
    raise EModemBusy.Create(ecModemBusy, False);

  {make sure modem is ready}
  VerifyStarted;

  {update the modem state}
  SetModemState(smsInitialize);
  FModemStateFlags := FModemStateFlags or smsWaitForInProgress;

  InitResult := irOk;
  ExpectedResponses := OkMsg + #13#10+ MultiResponseSeparator + ErrorMsg + #13#10;
  InitCmdRemainder := InitializeCmd;
  InitCmdPart := ParseMultiLineCommand(InitCmdRemainder);
  with FComPort do begin
    while (InitCmdPart <> '') and (InitResult = irOk) do begin
      {$IFDEF Win32}
      PrepareWait;
      {$ENDIF}
      {send the initialize command}
      PutStringModem(InitCmdPart);

      {Wait for a response from the modem or a timeout}
      InitResult := WaitForMultiString(ExpectedResponses, CmdTimeout,
                                       FAllowYielding, IgnoreCase,
                                       MultiResponseSeparator);
      {Display the returned value}
      DisplayWaitForResult(ExpectedResponses, InitResult);

      {Parse next part of command}
      InitCmdPart := ParseMultiLineCommand(InitCmdRemainder);

      {Wait for intercommand delay}
      if (FInterCmdDelay > 0) then
        DelayTicks(FInterCmdDelay, AllowYielding);
    end;
  end;

  FModemStateFlags := FModemStateFlags and not smsWaitForInProgress;
  if InitResult = irTimeout then begin
    SetModemState(smsInitializeTimeout);
    raise EModemNotResponding.Create(ecModemNotResponding, False);
  end else if InitResult = irError then begin
    SetModemState(smsAbort);
    raise EModemRejectedCommand.Create(ecModemRejectedCommand, False);
  end else
    SetModemState(smsReady);

  {flush any remaining characters from the input buffer (e.g., <cr><lf>)}
  FComPort.FlushInBuffer;
end;

procedure TApdCustomSModem.PutStringModem(ModemString : String);
  {send string to modem, translating special codes and adding interchar delay}
var
  i   : Integer;
  len : Integer;
  Str : String;

begin
  with FComPort do begin
    Str := '';
    i := 0;
    len := length(ModemString);
    while i < len do begin
      inc(i);
      case ModemString[i] of
        '^' :
          begin
            {embedded control character in string? ('a'..'z' or 'A'..'Z'?)}
            if (i <> len) and
               (chr(ord(ModemString[i+1]) and $5F) in ['A'..'Z']) then begin
              inc(i);   {skip over '^' and send control character}
              Dispatcher.PutChar(chr((ord(ModemString[i]) and $5F) - ord('A') + 1));
            end else begin
              {just write the character '^'}
              Dispatcher.PutChar(ModemString[i]);
              Str := Str + ModemString[i];
            end;
          end;
        '~' :
          begin
            {delay for TildeDelay ticks}
            DelayTicks(TildeDelay, AllowYielding);
          end;
      else
        {normal character}
        Dispatcher.PutChar(ModemString[i]);
        Str := Str + ModemString[i];
      end;

      {allow for interchar delay}
      if (InterCharDelay <> 0) and
         (i <> len) then
        DelayTicks(InterCharDelay, AllowYielding);
    end;

    FStatusInfo.AddSendRecvData('[send] '+ Str);
  end;
end;

procedure TApdCustomSModem.Redial;
  {Cause an immediate redial}
begin
  with FComPort do
    if (FModemState = smsDialCycle) then
      {Set the timer to expire in 1 tick}
      Dispatcher.SetTimerTrigger(msTimeoutTrigger, 1, True)
    else
      Dial(FAutoRetryDial);
end;

{- TApdSModem ---------------------------------------------}

constructor TApdSModem.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  ModemIniName := adsmDefModemIniName;
  ModemName := adsmDefaultModemTag;
end;

procedure TApdSModem.ModifyInitCommand;
var
  WStartPos : Integer;
  WEndPos   : Integer;
  NewCmd    : String;

begin
  {We are actually using the 'config' command from the modem database, so
   throw away the &W at the end, and make it the 'initialize' command}
  NewCmd := FInitializeCmd;
  WStartPos := pos('&W', AnsiUpperCase(NewCmd));
  while (WStartPos <> 0) do begin
    {There's at least one more &W in the string to remove}
    WEndPos := succ(WStartPos);
    {Look for a numeric value following &W and remove it also}
    if (NewCmd[succ(WEndPos)] >= '0') or
       (NewCmd[succ(WEndPos)] <= '9') then
      inc(WEndPos);
    Delete(NewCmd, WStartPos, WEndPos-WStartPos);
    WStartPos := pos('&W', AnsiUpperCase(NewCmd));
  end;

  {Change the definition of InitializeCmd}
  FInitializeCmd := NewCmd;
end;

function TApdSModem.SelectModem: Boolean;
  {Populate a list with modem names from database and display a select dialog}
var
  ModemList : TStringList;
  PortList  : TStringList;
  i         : Cardinal;
  SelDialog : TAdSModemSelection;
  ValResult : Integer;
  NewComNum : Integer;
begin
  ModemList := TStringList.Create;
  PortList := TStringList.Create;

  GetModemDatabaseEntries(ModemIniName, ModemList, False);
  {build the port list}
  for i := 1 to MaxComHandles do
    if IsPortAvailable(i) then
      PortList.Add(ComName(i));
  SelDialog := TAdSModemSelection.Create(nil);
  SelDialog.ModemList.Items.Assign(ModemList);
  SelDialog.ModemList.Text := FModemName;
  SelDialog.PortList.Items.Assign(PortList);
  if FComPort.ComNumber <> 0 then
    SelDialog.PortList.Text := ComName(FComPort.ComNumber)
  else
    SelDialog.PortList.Text := '<unknown>';

  Result := False;
  if (SelDialog.ShowModal = mrOk) then begin
    {unpack values}
    try
      Result := True;
      ModemName := SelDialog.ModemList.Text;
      Val(copy(SelDialog.PortList.Text,4,4), NewComNum, ValResult);
      if ValResult = 0 then begin
        FComPort.ComNumber := NewComNum;
        Started := True;
      end;
    except
      raise;
    end;
  end;

  SelDialog.Free;
  ModemList.Free;
  PortList.Free;
end;

procedure TApdSModem.SetAllDefaults;
begin
  inherited SetAllDefaults;
  ModifyInitCommand;
end;

procedure TApdSModem.SetModemIniName(NewIniFileName : String);
begin
  FModemIniName := NewIniFileName;
end;

procedure TApdSModem.SetModemName(ModemName : String);
  {Read and set the parameters for ModemName from modem INI database}
var
  IniFile : TIniFile;

begin
  if FModemName <> ModemName then begin
    FModemName := ModemName;

    if ModemName = adsmDefaultModemTag then
      SetAllDefaults
    else begin
      {next read the parameters for this modem from the ini database}
      IniFile := TIniFile.Create(ModemIniName);

      with IniFile do begin
        FAnswerCmd := ReadString(ModemName,'AnswerCmd',adsmDefAnswerCmd);
        FDialCmd := ReadString(ModemName,'DialCmd',adsmDefDialCmd);
        FDialCancelCmd := ReadString(ModemName,'DialCancel',adsmDefDialCancelCmd);
        FDialTerminatorCmd := ReadString(ModemName,'DialTerm',adsmDefDialTerminatorCmd);
        FHangupCmd := ReadString(ModemName,'HangupCmd',adsmDefHangupCmd);
        FInitializeCmd := ReadString(ModemName,'ConfigCmd',adsmDefInitializeCmd);
        ModifyInitCommand;

        FBusyMsg := ReadString(ModemName,'BusyMsg',adsmDefBusyMsg);
        FConnectMsg := ReadString(ModemName,'ConnectMsg',adsmDefConnectMsg);
        FDataCompressionMsg := ReadString(ModemName,'CompressTags',adsmDefDataCompressionMsg);
        FErrorCorrectionMsg := ReadString(ModemName,'ErrorCheckTags',adsmDefErrorCorrectionMsg);
        FErrorMsg := ReadString(ModemName,'ErrorMsg',adsmDefErrorMsg);
        FNoCarrierMsg := ReadString(ModemName,'NoCarrierMsg',adsmDefNoCarrierMsg);
        FNoDialToneMsg := ReadString(ModemName,'NoDialToneMsg',adsmDefNoDialToneMsg);
        FOkMsg := ReadString(ModemName,'OkMsg',adsmDefOkMsg);
        FRingMsg := ReadString(ModemName,'RingMsg',adsmDefRingMsg);

        FPreferredPortSpeed := ReadInteger(ModemName, 'DefaultBaud', 9600);
        FLockDTE := ReadBool(ModemName, 'LockDTE', (PreferredPortSpeed >= 9600));
      end;
    end;
  end;
end;

{- Modem status display -----------------------------------}

procedure TApdSModemStatusDisplay.msEraseAllValues;
var
  i : Integer;

begin
  msAction.Caption := '';
  msActionInfo.Caption := '';
  msInfo1.Caption := '';
  msInfo2.Caption := '';
  msInfo3.Caption := '';
  msInfo4.Caption := '';
  msValue1.Caption := '';
  msValue2.Caption := '';
  msValue3.Caption := '';
  msValue4.Caption := '';
  for i := 0 to pred(msMessages.Lines.Count) do
    msMessages.Lines[i] := '';
  msdCurrentRow := 0;
end;

procedure TApdSModemStatusDisplay.msButtonExtendClick(Sender: TObject);
begin
  if Assigned(SModem) then
    SModem.ExtendConnectTime(Secs2Ticks(SModem.FExtendTime));
end;

procedure TApdSModemStatusDisplay.msButtonCycleClick(Sender: TObject);
begin
   if Assigned(SModem) then
     SModem.Redial;
end;

procedure TApdSModemStatusDisplay.msButtonCancelClick(Sende

⌨️ 快捷键说明

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