awmodem.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWMODEM.PAS 4.06                    *}
{*********************************************************}
{* Deprecated low-level modem support                    *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$X+,V-,B-,I-}

unit AwModem;
  {-Modem access}

interface

{.$DEFINE DispatchDebug}

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  OoMisc,
  AwModDB,
  AwUser;

{modem state machine states}
const
  msNone         = 0;
  msCmdWaitRsp   = 1;
  msDialing      = 2;
  msWaitNumber   = 3;
  msWaitTerm     = 4;
  msAnswering    = 5;
  msWaitRing     = 6;
  msWaitFeatures = 7;

const
  NumResponses  = 8;
  RspOK         = 1;
  RspConnect    = 2;
  RspBusy       = 3;
  RspVoice      = 4;
  RspNoCarrier  = 5;
  RspNoDialTone = 6;
  RspError      = 7;
  RspRing       = 8;

const
  TentBaudLen   = 13;  {Length of tentative baud rate}
  CmdSepChar    = '|'; {Character to separate multiple commands}

  cpOK      = 1;
  cpError   = 2;
  cpTimeout = 3;

const
  awmDefDialTimeout     = 60;     {Default seconds for dial timeout}
  awmDefAnswerTimeout   = 60;     {Default seconds for answer timeout}
  awmDefDelayFactor     = 2;      {Default ticks for inter-cmd delay}
  awmDefCmdTimeout      = 182;    {Default ticks for command timeout (10 secs)}
  awmDefDTRDropHold     = 8;      {Default ticks for DTR low during hangup}
  awmDefModemCharDelay  = 0;      {Default ticks between each outgoing cmd char}
  awmDefTildeDelay      = 9;      {Default ticks to delay for ~s in cmd strings}
  awmDefRingWaitTimeout = 182;    {Default ticks before auto answer resets}
  awmDefFeatureWait     = 9;      {Default number of ticks to wait for features}
  awmDefBaudWait        = 36;     {Default number of ticks to wait for a BPS rate}
  TickSeconds        = 18;     {Default number of ticks in a second}

type
  PModemRegisterList = ^TModemRegisterList;
  TModemRegisterList = record
    mrHWindow : TApdHwnd;
    mrNotify  : TApdNotifyProc;
    mrDeleted : Bool;
    mrNext    : PModemRegisterList;
  end;

  PModemResponse = ^TModemResponse;
  TModemResponse = record
    Response   : PChar;
    TriggerIdx : Cardinal;                                           
    Enabled    : Bool;
  end;

  PModemResponseArray = ^TModemResponseArray;
  TModemResponseArray = array[1..NumResponses] of TModemResponse;

  TModemSendCmd = array[0..ApdCmdLen] of Char;                         {!!.03}
  TTentBaudSt   = array[0..TentBaudLen] of Char;

  PModemRec = ^TModemRec;
  TModemRec = record
    {modem comands}
    InitCmd            : PChar;
    DialCmd            : PChar;
    DialTerm           : PChar;
    DialCancel         : PChar;
    HangupCmd          : PChar;
    ConfigCmd          : PChar;
    AnswerCmd          : PChar;

    Responses          : TModemResponseArray;

    NumErrors          : Cardinal;
    ErrorTags          : array[1..ApdMaxTags] of TModemResponse;       {!!.03}
    NumComps           : Cardinal;
    CompressTags       : array[1..ApdMaxTags] of TModemResponse;       {!!.03}

    {last message dispatched to clients}
    LastMessage        : Cardinal;

    {timeout/delay values}
    DialTimeout        : Cardinal;
    AnswerTimeout      : Cardinal;
    DelayFactor        : Cardinal;
    CmdTimeout         : Cardinal;
    DTRDropHold        : Cardinal;
    ModemCharDelay     : Cardinal;
    TildeDelay         : Cardinal;
    RingWaitTimeout    : Cardinal;
    FeatureWait        : Cardinal;
    BaudWait           : Cardinal;

    {communications}
    Port               : TApdBaseDispatcher; 
    LockDTE            : Bool;
    RegisterHead       : PModemRegisterList;

    {state machine}
    ModemStarted       : Bool;
    ModemState         : Integer;
    TimeoutIdx         : Cardinal;                                  

    {dialing/answering}
    TentativeLineIdx   : Cardinal;
    ErrorCorrection    : Bool;
    DataCompression    : Bool;
    TentativeLineSpeed : TTentBaudSt;
    ConnectSpeed       : LongInt;
    Countdown          : Cardinal;

    {auto answering}
    RingCnt            : Cardinal;
    RingWait           : Cardinal;

    {data for DELPHI}
    UserData           : LongInt;
    DelphiComponent    : Bool;

    {last string info}
    LastString         : array[0..255] of Char;
    LastStringLen      : Cardinal;
    BlankPending       : Boolean;                  
  end;

function mInitModem(var Modem : PModemRec; H : TApdBaseDispatcher; var Data : TModemData) : Integer;
  {-Initialize a modem }

function mInitModemDelphi(var Modem : PModemRec; H : TApdBaseDispatcher; var Data : TModemData) : Integer;
  {-Initialize a modem }

procedure mDoneModem(var Modem : PModemRec);
  {-Destroy a modem }

function mGetComHandle(var Modem : PModemRec) : TApdBaseDispatcher;
  {-Return the handle of a modem's port }

procedure mSetModemDialTimeout(Modem : PModemRec; Secs : Cardinal);
  {-Set the number of seconds before a dial attempt times out }

function mGetModemDialTimeout(Modem : PModemRec) : Cardinal;
  {-Get the number of seconds the modem will wait before aborting a dial }

procedure mSetModemAnswerTimeout(Modem : PModemRec; Secs : Cardinal);
  {-Set the number of seconds before an answer attempt times out }

procedure mSetModemDelayFactor(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to wait between commands sent to the modem }

procedure mSetModemCmdTimeout(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to wait for a modem response }

procedure mSetModemDTRDropHold(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to hold DTR low during hangup }

procedure mSetModemCharDelay(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to wait between each command character sent }

procedure mSetTildeDelay(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to wait when a '~' is encountered in a command }

procedure mSetRingWaitTimeout(Modem : PModemRec; Ticks : Cardinal);
  {-Set the number of ticks to wait before mAutoAnswerModem resets }

function mStartModem(Modem : PModemRec) : Integer;
  {-Have the modem start processing messages }

procedure mStopModem(Modem : PModemRec);
  {-Have the modem stop processing messages }

function mPutModemCommand(Modem : PModemRec; Cmd : PChar) : Integer;
  {-Send a command to the modem, dispatching an error code }

function mRegisterModemHandler(Modem : PModemRec; HWindow : TApdHwnd; Notify : TApdNotifyProc) : Integer;
  {-Add a window/notification procedure to the modem's notify list }

function mDeregisterModemHandler(Modem : PModemRec; HWindow : TApdHwnd; Notify : TApdNotifyProc) : Integer;
  {-Remove a window/notification procedure from the modem's notify list }

function mInitializeModem(Modem : PModemRec) : Integer;
  {-Send the initialization string to the modem }

function mConfigureModem(Modem : PModemRec) : Integer;
  {-Send the configuration strings to the modem }

function mDialModem(Modem : PModemRec; Number : PChar) : Integer;
  {-Dial the modem }

function mIsAttemptingConnect(Modem : PModemRec) : Bool;
  {-Return TRUE if the modem is attempting to establish a connection }

function mExtendConnectAttempt(Modem : PModemRec; DeltaSecs : Integer) : Integer;
  {-Extend the amount of time the modem waits for a CONNECT result }

function mModemStarted(Modem : PModemRec) : Bool;
  {-Return TRUE if StartModem has been called }

function mCancelDialAnswer(Modem : PModemRec) : Integer;
  {-Cancel the dial or answer in progress }

function mGetConnectSpeed(Modem : PModemRec) : LongInt;
  {-Get the actual speed of the connection }

function mHangupModem(Modem : PModemRec) : Integer;
  {-Hangup the modem }

function mAnswerModem(Modem : PModemRec) : Integer;
  {-Answer the modem }

function mAutoAnswerModem(Modem : PModemRec; Rings : Cardinal) : Integer;
  {-Answer the modem after Rings rings }

function mWaitOnFeatures(Modem : PModemRec) : Integer;
  {-Wait until all modem features have been received }

function mAllFeatureWaitOver(Modem : PModemRec) : Bool;
  {-Return TRUE if all modem features have been received and processed }

function mWaitOnResponse(Modem : PModemRec) : Integer;
  {-Wait until the modem finishes processing the last command }

function mGetLastMessage(Modem : PModemRec) : Cardinal;
  {-Return the last message dispatched to modem clients }

implementation

  { non-public modem routines }

  function StrNewCheck(var NewSt : PChar; SrcStr : PChar) : Bool;
    {-Allocate a new string on the heap, checking for available memory }
  var
    Len : Cardinal;

  begin
    Len := StrLen(SrcStr);
    NewSt := AllocMem(Len + 1);

    StrCopy(NewSt, SrcStr);
    StrNewCheck := True;
  end;

  procedure StrDisposeCheck(var St : PChar);
  begin
    if (St <> nil) then
      FreeMem(St, StrLen(St) + 1);
  end;

  procedure DoneModemDynamic(Modem : PModemRec);
    {-Dispose of all dynamic modem data }
  var
    I : Cardinal;
    T : PModemRegisterList;
    N : PModemRegisterList;

  begin
    with Modem^ do begin
      StrDisposeCheck(InitCmd);
      StrDisposeCheck(DialCmd);
      StrDisposeCheck(DialTerm);
      StrDisposeCheck(DialCancel);
      StrDisposeCheck(HangupCmd);
      StrDisposeCheck(ConfigCmd);
      StrDisposeCheck(AnswerCmd);

      for I := 1 to NumResponses do
        StrDisposeCheck(Responses[I].Response);
      for I := 1 to NumErrors do
        StrDisposeCheck(ErrorTags[I].Response);
      for I := 1 to NumComps do
        StrDisposeCheck(CompressTags[I].Response);

      T := RegisterHead;
      while (T <> nil) do begin
        N := T^.mrNext;
        FreeMem(T, SizeOf(TModemRegisterList));
        T := N;
      end;
    end;
  end;

type
  ModemResponseSet = Set of Byte;

const
  RspWaitSet  = [RspOK, RspError];
  DialWaitSet = [RspConnect, RspBusy, RspVoice, RspNoCarrier, RspNoDialTone, RspError];

  function EnableResponses(Modem : PModemRec; Responses : ModemResponseSet) : Integer;
    {-Enable one or more modem responses }
  var
    Code : Integer;
    I    : Cardinal;
    J    : Cardinal;

  begin
    for I := 1 to NumResponses do
      if I in Responses then
        with Modem^ do
          if (not Responses[I].Enabled) and
             (Responses[I].Response <> nil) then begin
            Code := Port.AddDataTrigger(Responses[I].Response, True);
            if (Code < ecOK) then begin
              EnableResponses := Code;
              for J := Pred(I) downto 1 do begin
                Port.RemoveTrigger(Responses[I].TriggerIdx);
                Responses[I].TriggerIdx := 0;
                Responses[I].Enabled    := False;
              end;
              Exit;
            end;
            Responses[I].TriggerIdx := Code;
            Responses[I].Enabled    := True;
          end;
    EnableResponses := ecOK;
  end;

  function DisableResponses(Modem : PModemRec; Responses : ModemResponseSet) : Integer;
    {-Disable one or more modem responses }
  var
    RetCode : Integer;
    I       : Cardinal;

  begin
    RetCode := ecOK;
    for I := 1 to NumResponses do
      if I in Responses then
        with Modem^ do
          if Responses[I].Enabled then begin
            Port.RemoveTrigger(Responses[I].TriggerIdx);

            Responses[I].TriggerIdx := 0;
            Responses[I].Enabled    := False;
          end;
    DisableResponses := RetCode;
  end;

  function EnableFeatureTags(Modem : PModemRec) : Integer;
  var
    Code : Integer;
    I    : Cardinal;
    J    : Cardinal;

  begin
    EnableFeatureTags := ecOK;

    with Modem^ do begin
      for I := 1 to NumErrors do
        if not ErrorTags[I].Enabled then begin
          Code := Port.AddDataTrigger(ErrorTags[I].Response, False);
          if (Code < ecOK) then begin
            EnableFeatureTags := Code;
            for J := Pred(I) downto 1 do begin
              Port.RemoveTrigger(ErrorTags[I].TriggerIdx);
              ErrorTags[I].TriggerIdx := 0;
              ErrorTags[I].Enabled    := False;
            end;

            Exit;
          end;
          ErrorTags[I].TriggerIdx := Code;
          ErrorTags[I].Enabled    := True;
        end;