awfax.pas

测试用例

  function caNoCarrierResponse(FP : PFaxRec) : Boolean;
    {-Return True if Response contains NO CARRIER}
  begin
    with PC12FaxData(FP)^, fCData^ do
      caNoCarrierResponse := Pos({CA}'RRIER', cResponse) > 0;
  end;

  function caErrorResponse(FP : PFaxRec) : Boolean;
    {-Return True if Response contains ERROR}
  begin
    with PC12FaxData(FP)^, fCData^ do
      caErrorResponse := Pos('ERROR', cResponse) > 0;
  end;

  function caFHNGResponse(FP : PFaxRec) : Boolean;
    {-Return True if Response contains FHNG}
  begin
    with PC12FaxData(FP)^, fCData^ do
      caFHNGResponse := Pos(cHangResp, cResponse) > 0;
  end;

  function caExtractFHNGCode(FP : PFaxRec) : Word;
    {-Return numeric FHNG response}
  var
    {W    : Word;}                                                       {!!.04}
    {Code : Integer;}                                                    {!!.04}
    I    : Byte;
    S    : String[20];
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      I := Pos(':', cResponse);
      if I <> 0 then begin
        S := Copy(cResponse, I+1, 3);
        S := Trim(S);
        { class 2 returns the hangup code as decimal, 2.0 returns it as hex  }
        { fortunately, they use the same digits (eg, both will return '71'   }
        { for "RSPREC error").  We need to convert the Receive Phase D codes }
        { since they could be returned as '100' (Class2) or 'A0' (Class2.0). }
        if (Length(S) > 0) then                                          {!!.04}
          if (S[1] in ['A'..'F']) then                                   {!!.04}
            { it's a hex code, convert to the doc'd format }             {!!.04}
            Result := StrToIntDef(S[2], 0) + 100                         {!!.04}
          else                                                           {!!.04}
            Result := StrToIntDef(S, -0)                                 {!!.04}
        else                                                             {!!.04}
          Result := 0;                                                   {!!.04}
        {Val(S, W, Code);}                                               {!!.04}
        {caExtractFHNGCode := W;}                                        {!!.04}
      end else
        caExtractFHNGCode := 0;
    end;
  end;

  function caAddReceivedCmd(FP : PFaxRec; var S : TModemResponse) : Boolean;
    {-if char(s) pending, add to command string; return True if complete
      response has been assembled}
  var
    C : Char;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      caAddReceivedCmd := False;
      while aPort.CharReady do begin
        aPort.GetChar(C);
        if C = #13 then begin
          if S <> '' then begin
            caAddReceivedCmd := True;
            Exit;
          end;
        end else if C >= #32 then
          Merge(S, C);
      end;
    end;
  end;

  procedure caPrepResponse(FP : PFaxRec);
    {-Prepare to receive/parse a new modem response}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      cResponse := '';
      cCRLFIndex := 0;
      cETXIndex := 0;
      aPort.SetTimerTrigger(aTimeoutTrigger, cReplyWait, True);
      NewTimer(cReplyTimer, cReplyWait);
    end;
  end;

  function caPutModemSlow(FP : PFaxRec; S : ShortString) : Integer;
    {-Send a modem command and prepare to wait for a response}
  var
    I : Word;
  begin
    Result := ecOK;
    with PC12FaxData(FP)^, fCData^, fPData^ do
      for I := 1 to Length(S) do begin
        DelayMS(InterCharDelay);
        Result := aPort.PutChar(S[I]);
        if Result <> ecOK then
          Exit;
      end;
  end;

  function caPutModem(FP : PFaxRec; S : ShortString) : Integer;
    {-Send a modem command and prepare to wait for a response}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      DelayMS(PreCommandDelay);
      Result := caPutModemSlow(FP, S+^M);
      if Result <> ecOK then
        Exit;
      caPrepResponse(FP);
    end;
  end;

  function caPutFaxCommand(FP : PFaxRec; S : ShortString) : Integer;
    {-Send FTM/FRM modem command}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      DelayMS(PreFaxDelay);
      Result := caPutModemSlow(FP, S+^M);
      if Result <> ecOK then
        Exit;
      caPrepResponse(FP);
    end;
  end;

  function caPutFrameR(FP : PFaxRec) : Integer;
    {-Send FRH=3 modem command}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      DelayMS(PreFaxDelay);
      Result := caPutModemSlow(FP, 'AT+FRH=3'^M);
      if Result <> ecOK then
        Exit;
      caPrepResponse(FP);
    end;
  end;

  function caPutFrameT(FP : PFaxRec) : Integer;
    {-Send FTH=3 modem command}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      DelayMS(PreFaxDelay);
      Result := caPutModemSlow(FP, 'AT+FTH=3'^M);
      if Result <> ecOK then
        Exit;
      caPrepResponse(FP);
    end;
  end;

  function caProcessModemCmd(FP : PFaxRec; S : ShortString) : Boolean;
  var
    Finished : Boolean;
    OkString : TModemResponse;
    WasBusy  : Boolean;
    Dummy    : Boolean;

  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {Send the command}
      caProcessModemCmd := False;
      if caPutModem(FP, S) <> ecOK then
        Exit;

      {Prepare to collect the response}
      caPrepResponse(FP);

      {Prepare to wait for responses}
      aPort.SetEventBusy(WasBusy, True);

      {Wait and collect...}
      repeat
        {Collect the response}
        cResponse := '';
        repeat
          Finished := caAddReceivedCmd(FP, cResponse);
          SafeYield;
          aPort.ProcessCommunications;
        until Finished or TimerExpired(cReplyTimer);

        {If timer expires just exit}
        if TimerExpired(cReplyTimer) then begin
          FlushInQueue(FP);
          aPort.SetEventBusy(Dummy, WasBusy);
          Exit;
        end;

        {Check for more data}
        SafeYield;
        aPort.ProcessCommunications;
        {if echo is on, we'll get our own command back. Eat it.}
        if cResponse = S then
          cResponse := '';
      until (cResponse <> '');

      {Check for errors}
      if not caErrorResponse(FP) then begin
        {Collect and discard the OK if above response was data}
        if Pos('OK', cResponse) = 0 then begin
          OkString := '';
          repeat
            Finished := caAddReceivedCmd(FP, OkString);
            SafeYield;
            aPort.ProcessCommunications;
          until Finished or TimerExpired(cReplyTimer);

          if TimerExpired(cReplyTimer) then begin
            FlushInQueue(FP);
            aPort.SetEventBusy(Dummy, WasBusy);
            Exit;
          end;
        end;
        caProcessModemCmd := True
      end else
        caProcessModemCmd := False;

      {Need to make sure all incoming data was processed}
      FlushInQueue(FP);

      {Restore the busy flag}
      aPort.SetEventBusy(Dummy, WasBusy);
    end;
  end;

  procedure caFlushModem(FP : PFaxRec);
    {-"Flush" modem for init}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {"reset" modem}
      aPort.FlushInBuffer;
      aPort.FlushOutBuffer;
      aPort.SetModem(False, False);
      DelayMS(FlushWait);
      aPort.SetModem(True, True);
      DelayMS(FlushWait);
    end;
  end;

  procedure fPrepCommands(FP : PFaxRec; Class2_0 : Boolean);
    {-Prepare for either class 2 or class 2.0 commands and responses}

    function MakeCmd(const S : TClass2Str) : TClass2Str;
      {-Prefix S with 'AT+F'}
    begin
      MakeCmd := 'AT+F' + S;
    end;

    function MakeResp(const S : TClass2Str) : TClass2Str;
      {-Prefix S with 'AT+F'}
    begin
      MakeResp := '+F' + S;
    end;

  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      if Class2_0 then begin
        cClassCmd     := MakeCmd(C20ClassCmd);
        cModelCmd     := MakeCmd(C20ModelCmd);
        cMfrCmd       := MakeCmd(C20MfrCmd);
        cRevCmd       := MakeCmd(C20RevCmd);
        cDISCmd       := MakeCmd(C20DISCmd);
        cStationCmd   := MakeCmd(C20StationCmd);
        cDCCCmd       := MakeCmd(C20DCCCmd);
        cFaxResp      := MakeResp(C20FaxResp);
        cDISResp      := MakeResp(C20DISResp);
        cDCSResp      := MakeResp(C20DCSResp);
        cTSIResp      := MakeResp(C20TSIResp);
        cCSIResp      := MakeResp(C20CSIResp);
        cPageResp     := MakeResp(C20PageResp);
        cHangResp     := 'F'+ C20HangResp;
      end else begin
        cClassCmd     := MakeCmd(C2ClassCmd);
        cModelCmd     := MakeCmd(C2ModelCmd);
        cMfrCmd       := MakeCmd(C2MfrCmd);
        cRevCmd       := MakeCmd(C2RevCmd);
        cDISCmd       := MakeCmd(C2DISCmd);
        cStationCmd   := MakeCmd(C2StationCmd);
        cDCCCmd       := MakeCmd(C2DCCCmd);
        cFaxResp      := MakeResp(C2FaxResp);
        cDISResp      := MakeResp(C2DISResp);
        cDCSResp      := MakeResp(C2DCSResp);
        cTSIResp      := MakeResp(C2TSIResp);
        cCSIResp      := MakeResp(C2CSIResp);
        cPageResp     := MakeResp(C2PageResp);
        cHangResp     := 'F' + C2HangResp;
      end;
    end;
  end;

  function fGetModemClassSupport(FP : PFaxRec;
                                 var Class1, Class2, Class2_0 : Boolean;
                                 Reset : Boolean) : Boolean;
  var
    LC      : Integer;
    WasBusy : Boolean;
    Dummy   : Boolean;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {Assume failure}
      fGetModemClassSupport := False;
      Class1 := False;
      Class2 := False;
      Class2_0 := False;

      {Prepare to wait for responses}
      aPort.SetEventBusy(WasBusy, True);

      {Reset the modem}
      if Reset then begin
        LC := 0;
        repeat

          Inc(LC);
          if (LC > 2) or not caProcessModemCmd(FP, cForcedInit) then begin 
            aPort.SetEventBusy(Dummy, WasBusy);
            Exit;
          end;
        until caOkResponse(FP);
      end;

      {Ask the modem...}
      if not caProcessModemCmd(FP, 'AT+FCLASS=?') then begin
        aPort.SetEventBusy(Dummy, WasBusy);
        Exit;
      end;
      StripPrefix(cResponse);

      {...see what it said}
      Class1 := Pos('1', cResponse) > 0;
      if Class1 then
        if Pos('1.0', cResponse) > 0 then
          cClassCmd := 'AT+FCLASS=1.0'
        else
          cClassCmd := 'AT+FCLASS=1';

      if Pos('2.0', cResponse) > 0 then begin
        Class2_0 := True;
        Class2 := Pos('2,', cResponse) > 0;
      end else
        Class2 := Pos('2', cResponse) > 0;

      fGetModemClassSupport := True;

      {Restore the busy flag}
      aPort.SetEventBusy(Dummy, WasBusy);
    end;
  end;

  function fGetModemInfo(FP : PFaxRec; var FaxClass : Char;
                         var Model, Chip, Rev : TPassString;
                         Reset : Boolean) : Boolean;
  var
    C1, C2, C2_0 : Boolean;
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      {assume failure}
      fGetModemInfo := False;

      {Get class to init}
      FaxClass := '0';
      Model := '';
      Chip  := '';
      Rev   := '';

      if Reset then begin
        caFlushModem(FP);

        if (cModemInit <> '') and (not caProcessModemCmd(FP, cModemInit)) then
          Exit;

        if not caProcessModemCmd(FP, cForcedInit) then              
          Exit;
      end;
      cInitSent := True;

      if not fGetModemClassSupport(FP, C1, C2, C2_0, True) then
        Exit;

      if C2_0 then begin
        fPrepCommands(FP, True);
        FaxClass := 'B'
      end else if C2 then begin
        fPrepCommands(FP, False);
        FaxClass := '2'
      end else if C1 then
        FaxClass := '1'
      else
        Exit;

      if caProcessModemCmd(FP, cModelCmd) then begin
        StripPrefix(cResponse);
        Model := cResponse;
      end;

      if caProcessModemCmd(FP, cMfrCmd) then begin
        StripPrefix(cResponse);
        Chip := cResponse;
      end;

      if caProcessModemCmd(FP, cRevCmd) then begin
        StripPrefix(cResponse);
        Rev := cResponse;
      end;

      fGetModemInfo := True;
    end;
  end;

  function fGetModemFeatures(FP : PFaxRec; var BPS : LongInt;
                             var Correction : Char) : Integer;
    {-Return highest possible codes}