awmodem.pas

测试用例

      for I := 1 to NumComps do
        if not CompressTags[I].Enabled then begin
          Code := Port.AddDataTrigger(CompressTags[I].Response, False);
          if (Code < ecOK) then begin
            EnableFeatureTags := Code;
            for J := Pred(I) downto 1 do begin
              Port.RemoveTrigger(CompressTags[I].TriggerIdx);
              CompressTags[I].TriggerIdx := 0;
              CompressTags[I].Enabled    := False;
            end;
            Exit;
          end;
          CompressTags[I].TriggerIdx := Code;
          CompressTags[I].Enabled    := True;
        end;
    end;
  end;

  function DisableErrorCorrectionTags(Modem : PModemRec) : Integer;
  var
    RetCode : Integer;
    I       : Cardinal;

  begin
    RetCode := ecOK;

    with Modem^ do
      for I := 1 to NumErrors do
        if ErrorTags[I].Enabled then begin
          Port.RemoveTrigger(ErrorTags[I].TriggerIdx);

          ErrorTags[I].TriggerIdx := 0;
          ErrorTags[I].Enabled    := False;
        end;
    DisableErrorCorrectionTags := RetCode;
  end;

  procedure DisableDataCompressionTags(Modem : PModemRec);
  var
    I       : Cardinal;
  begin
    with Modem^ do
      for I := 1 to NumComps do
        if CompressTags[I].Enabled then begin
          Port.RemoveTrigger(CompressTags[I].TriggerIdx);

          CompressTags[I].TriggerIdx := 0;
          CompressTags[I].Enabled    := False;
        end;
  end;

  function DisableFeatureTags(Modem : PModemRec) : Integer;
  var
    RetCode : Integer;
  begin
    RetCode := DisableErrorCorrectionTags(Modem);
    DisableDataCompressionTags(Modem);
    DisableFeatureTags := RetCode;
  end;

  function ModemPutXlatStr(Modem : PModemRec; Str : PChar) : Integer;
    {-Send a string to the modem, XLATing control chars }
  var
    I     : Cardinal;
    Len   : Cardinal;
    Code  : Integer;
    Delay : Bool;

  begin
    ModemPutXlatStr := ecOK;
    Len := StrLen(Str);
    if (Len = 0) then
      Exit;

    with Modem^ do begin
      Dec(Len);
      I := 0;
      while (I <= Len) do begin
        Code  := ecOK;
        Delay := True;
        case Str[I] of
          '^':
            if (I <> Len) and (UpCase(Str[I+1]) in ['@'..'_']) then begin
              Inc(I);
              Code := Port.PutChar(Char(Ord(UpCase(Str[I])) - Ord('A') + 1));
            end else
              Code := Port.PutChar(Str[I]);
          '~':
            begin
              DelayTicks(TildeDelay, True);
              Delay := False;
            end;
          else
            Code := Port.PutChar(Str[I]);
        end;

        if (Code < ecOK) then begin
          ModemPutXlatStr := Code;
          Exit;
        end;

        Inc(I);
        if Delay and (I <> Len) then
          if (ModemCharDelay <> 0) then
            DelayTicks(ModemCharDelay, True);
      end;
    end;
  end;

  {$IFDEF DispatchDebug}
  function TriggerTypeStr(Msg : Cardinal) : String;
    {-Return a string based on the message number in Msg }
  begin
    case Msg of
      apw_TriggerAvail : TriggerTypeStr := 'data available';
      apw_TriggerData  : TriggerTypeStr := 'data string received';
      apw_TriggerTimer : TriggerTypeStr := 'timer trigger';
      apw_TriggerStatus: TriggerTypeStr := 'change in line status';
      else
        TriggerTypeStr := 'unknown message';
    end;
  end;

  function ModemStateStr(State : Integer) : String;
    {-Return a string based on a modem state }
  begin
    case State of
      msNone        : ModemStateStr := 'doing nothing';
      msCmdWaitRsp  : ModemStateStr := 'waiting for a command response';
      msDialing     : ModemStateStr := 'dialing';
      msWaitNumber  : ModemStateStr := 'waiting for a baud rate from the connect string';
      msWaitTerm    : ModemStateStr := 'waiting for a carriage return to finish the baud rate';
      msAnswering   : ModemStateStr := 'answering the phone';
      msWaitRing    : ModemStateStr := 'waiting for the phone to RING';
      msWaitFeatures: ModemStateStr := 'waiting for a data compression/error correction tag';
      else
        ModemStateStr := 'doing something, but I don''t know what';
    end;
  end;

  function ModemMessageStr(Msg : Cardinal) : String;
    {-Return a string based on a modem message }
  begin
    case Msg of
      apw_ModemOK            : ModemMessageStr := 'OK result';
      apw_ModemConnect       : ModemMessageStr := 'Connect result';
      apw_ModemBusy          : ModemMessageStr := 'Busy result';
      apw_ModemVoice         : ModemMessageStr := 'Voice result';
      apw_ModemNoCarrier     : ModemMessageStr := 'No carrier result';
      apw_ModemNoDialTone    : ModemMessageStr := 'No dialtone result';
      apw_ModemError         : ModemMessageStr := 'Error result';
      apw_GotLineSpeed       : ModemMessageStr := 'Line speed received';
      apw_GotErrCorrection   : ModemMessageStr := 'Error correction tag received';
      apw_GotDataCompression : ModemMessageStr := 'Data compression tag received';
      apw_CmdTimeout         : ModemMessageStr := 'Timed out waiting for command response';
      apw_DialTimeout        : ModemMessageStr := 'Timed out waiting for carrier on dial attempt';
      apw_AnswerTimeout      : ModemMessageStr := 'Timed out waiting for carrier on answer attempt';
      apw_DialCount          : ModemMessageStr := 'Countdown timer for dial';
      apw_AnswerCount        : ModemMessageStr := 'Countdown timer for answer';
      apw_ModemRing          : ModemMessageStr := 'RING result';
      apw_ModemIsConnected   : ModemMessageStr := 'Modem has established a connection (definitive)';
      apw_ConnectFailed      : ModemMessageStr := 'Connection attempt failed (definitive)';
      apw_CommandProcessed   : ModemMessageStr := 'Modem command has been processed (definitive)';
      else
        ModemMessageStr := 'Unknown message';
    end;
  end;
  {$ENDIF}

  procedure ModemDispatcher(Msg, wParam : Cardinal; lParam : LongInt); far;
    {-Receive data from the comm dispatcher and turn it into something
      meaningful. }
  var
    Modem     : PModemRec;
    OnChar    : Integer;      {pPeekChar level}
    NumChars  : Integer;
    TrigIdx   : Cardinal absolute wParam;

    function InitializeCall : Bool;
      {-Initialize the modem dispatcher variables }
    var
      ComData : TApdBaseDispatcher;

    begin
      { the comm port handle is in the high Cardinal of lParam }

      { check that the handle is valid and that a modem is using it }
      ComData := TApdBaseDispatcher(PortList[LH(lParam).H]);
      if (ComData = nil) or (ComData.DataPointers[dpModem] = nil) then
        InitializeCall := False
      else begin
        InitializeCall := True;
        Modem := PModemRec(ComData.DataPointers[dpModem]);
        if (Msg = apw_TriggerAvail) then begin
          OnChar   := 1;
          NumChars := wParam;

        end;

      end;
    end;

    function CheckModemState(State : Integer) : Bool;
      {-See if the modem is doing anything }
    begin
      if (State = msNone) then begin
        CheckModemState := False;
        {$IFDEF DispatchDebug}
        DebugOut('Dispatcher exiting: nothing to do!');
        DebugOutTagInt('TrigIdx = ', TrigIdx);
        {$ENDIF}
      end else begin
        CheckModemState := True;
        {$IFDEF DispatchDebug}
        DebugOut('Modem is ' + ModemStateStr(State));
        {$ENDIF}
      end;
    end;

    procedure DispatchToModemClients(DispatchMsg, wParam : Cardinal; lParam : LongInt);
      {-Dispatch a message to all modem clients }
    var
      CurRegRec  : PModemRegisterList;
      Next       : PModemRegisterList;
      Prev       : PModemRegisterList;
      AnyDeleted : Bool;

    begin
      with Modem^ do begin
        {$IFDEF DispatchDebug}
        DebugOutTag('Dispatching message to clients: ', ModemMessageStr(DispatchMsg));
        {$ENDIF}

        LastMessage := DispatchMsg;
        AnyDeleted  := False;
        CurRegRec   := RegisterHead;

        while (CurRegRec <> nil) do begin
          Next := CurRegRec^.mrNext;

          if not CurRegRec^.mrDeleted then begin
            with CurRegRec^ do
              if (@mrNotify <> nil) then
                if not DelphiComponent then
                  mrNotify(DispatchMsg, wParam, lParam)
                else
                  mrNotify(DispatchMsg, wParam, LongInt(Modem))
              else if (mrHWindow <> 0) then
                SendMessage(mrHWindow, DispatchMsg, wParam, lParam);
          end else
            AnyDeleted := True;

          CurRegRec := Next;
        end;

        if AnyDeleted then begin
          repeat
            if RegisterHead^.mrDeleted then begin
              CurRegRec    := RegisterHead;
              RegisterHead := RegisterHead^.mrNext;
              FreeMem(CurRegRec, SizeOf(TModemRegisterList));
            end;
          until (RegisterHead = nil) or not RegisterHead^.mrDeleted;

          if (RegisterHead <> nil) then begin
            Prev      := RegisterHead;
            CurRegRec := RegisterHead^.mrNext;
            while (CurRegRec <> nil) do begin
              if CurRegRec^.mrDeleted then begin
                Prev^.mrNext := CurRegRec^.mrNext;
                FreeMem(CurRegRec, SizeOf(TModemRegisterList));
                CurRegRec := Prev;
              end;

              Prev      := CurRegRec;
              CurRegRec := CurRegRec^.mrNext;
            end;
          end;
        end;
      end;
    end;

    procedure DispatchToModemClientsNoParm(DispatchMsg : Cardinal);
    begin
      DispatchToModemClients(DispatchMsg, 0, 0);
    end;

    function FindResponseCode : Integer;
      {-Find a response code by its trigger index }
    var
      I : Integer;

    begin
      for I := 1 to NumResponses do
        if (Modem^.Responses[I].TriggerIdx = TrigIdx) then begin
          FindResponseCode := I;
          Exit;
        end;
      FindResponseCode := 0;
    end;

    procedure ShutdownResponseWait;
      {-Remove all triggers associated with the msCmdWaitRsp state }
    begin
      with Modem^ do begin
        {$IFDEF DispatchDebug}
        DebugOut('Shutting down wait for command response');
        {$ENDIF}

        DisableResponses(Modem, RspWaitSet);
        Port.RemoveTrigger(TimeoutIdx);

        ModemState := msNone;
        TimeoutIdx := 0;
      end;
    end;

    procedure HandleCommandResponse;
      {-Wait for an OK or ERROR response from the modem }
    var
      ResponseCode : Integer;

    begin
      with Modem^ do
        case Msg of
          apw_TriggerTimer:
            if (TrigIdx = TimeoutIdx) then begin

              { we haven't received an OK or an ERROR yet, so }
              { give up trying to find one and send an error  }
              { message to our clients.                       }

              DispatchToModemClientsNoParm(apw_CmdTimeout);
              ShutdownResponseWait;
              DispatchToModemClients(apw_CommandProcessed, cpTimeout, 0);
            end; { if }

          apw_TriggerData:
            begin

              { we've receive an OK or an error response }
              { find out which and act accordingly       }

              ResponseCode := FindResponseCode;

              case ResponseCode of
                RspOK:
                  begin
                    { send an OK message to clients }
                    DispatchToModemClientsNoParm(apw_ModemOK);
                    ShutdownResponseWait;
                    DispatchToModemClients(apw_CommandProcessed, cpOK, 0);
                  end; { RspOK }
                RspError:
                  begin
                    { send an ERROR message to clients }
                    DispatchToModemClientsNoParm(apw_ModemError);
                    ShutdownResponseWait;
                    DispatchToModemClients(apw_CommandProcessed, cpError, 0);
                  end; { RspError }
              end; { case ResponseCode }
            end; { apw_TriggerData }
        end; { case Msg }
    end; { procedure HandleCommandResponse }

    procedure AbortConnectAttempt(SendCancel : Bool);
      {-Remove all triggers associated with the connection attempt and
        optionally send the cancel command to the modem }
    {var
      Code : Integer;}

    begin
      with Modem^ do begin
        {$IFDEF DispatchDebug}
        DebugOut('Aborting connect attempt');
        {$ENDIF}

        if SendCancel then begin
          DelayTicks(DelayFactor * 2, True);
          mCancelDialAnswer(Modem);
        end;

        DisableResponses(Modem, DialWaitSet);
        DisableErrorCorrectionTags(Modem);
        DisableDataCompressionTags(Modem);
        Port.RemoveTrigger(TimeoutIdx);

        ModemState   := msNone;
        ConnectSpeed := 0;
        TimeoutIdx   := 0;
        DispatchToModemClientsNoParm(apw_ConnectFailed);
      end;
    end;

    procedure EstablishConnection;
      {-Let our clients know that we've received a connection and
        start waiting for the baud rate and any remaining feature
        tags }
    var
      Code : Integer;

    begin
      with Modem^ do begin
        {$IFDEF DispatchDebug}
        DebugOut('Establishing a connection');
        {$ENDIF}

        Code := DisableResponses(Modem, DialWaitSet);
        if (Code < ecOK) then begin
          ConnectSpeed := 0;
          ModemState   := msNone;
          {Port.aGotError(Code);}
          DispatchToModemClientsNoParm(apw_ConnectFailed);
          Exit;
        end;

        Port.RemoveTrigger(TimeoutIdx);

        { start waiting for baud rate }
        ModemState := msWaitNumber;
        FillChar(TentativeLineSpeed, SizeOf(TentativeLineSpeed), 0);