awfax.pas

测试用例

  var
    C : Char;
    BitChar : Char;
    Finished : Boolean;
  begin
    fGetModemFeatures := ecOK;

    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      BPS := 0;
      Correction := '0';

      {Assure we're a class 2 modem first}
      case aClassInUse of
        ctClass2    : fPrepCommands(FP, False);
        ctClass2_0  : fPrepCommands(FP, True);
        else
          Exit;
      end;

      {Test bit rates}
      C := '5';
      BitChar := '3';
      Finished := False;
      repeat
        if caProcessModemCmd(FP, cDISCmd+'=0,'+C+',0,0,0,0,0,3') and
           caOkResponse(FP) then begin
          BitChar := C;
          Finished := True;
        end;
        Dec(Byte(C));
        if (C = '1') and not Finished then begin
          BitChar := C;
          Finished := True;
        end;
      until Finished;
      case BitChar of
        '1' : BPS := 4800;
        '2' : BPS := 7200;
        '3' : BPS := 9600;
        '4' : BPS := 12000;
        '5' : BPS := 14400;
        else  BPS := 2400;
      end;

      {Test error correction}
      if caProcessModemCmd(FP, cDISCmd+'=0,0,0,0,0,1,0,3') and
         caOkResponse(FP) then
        Correction := '1'
      else
        Correction := '0';
    end;
  end;

  procedure fSetModemFeatures(FP : PFaxRec; BPS : LongInt;
                               Correction : Char);
    {-Set modem features for this session}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      cMaxFaxBPS := BPS;
      cCheckChar := Correction;
    end;
  end;

  function caSpeedCode(FP : PFaxRec) : Char;
    {-returns char code for speed}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      case cMaxFaxBPS of
        2400 : caSpeedCode := '0';
        4800 : caSpeedCode := '1';
        7200 : caSpeedCode := '2';
        12000: caSpeedCode := '4';
        14400: caSpeedCode := '5';
        else   caSpeedCode := '3';
      end;
    end;
  end;

  procedure fGetPageInfoC12(FP : PFaxRec;
                            var Pages : Word;
                            var Page : Word;
                            var BytesTransferred : LongInt;
                            var PageLength : LongInt);
  var
    OutBuf : Word;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      if aSending then begin
        {Transmit data}
        Pages := cFaxHeader.PageCount;
        if aSendingCover then
          Page := 0
        else
          Page := aCurrPage;
        if Assigned(aPort) then                                        
          OutBuf := aPort.OutBuffUsed
        else                                                           
          OutBuf := 0;                                                 
        if OutBuf = 1 then
          OutBuf := 0;
        BytesTransferred := aDataCount - OutBuf;
        if BytesTransferred < 0 then
          BytesTransferred := 0;
        PageLength := aPageSize;
      end else begin
        Pages := 0;
        Page := aCurrPage;
        BytesTransferred := aDataCount;
        PageLength := 0;
      end;
    end;
  end;

  function fGetLastPageStatus(FP : PFaxRec) : Boolean;
    {-Return True if last page received OK, false otherwise}
  begin
    with PC12FaxData(FP)^, fCData^ do
      fGetLastPageStatus := cLastPageOk;
  end;

  function fGetRemoteID(FP : PFaxRec) : ShortString;
    {-Return remote station ID}
  begin
    with PC12FaxData(FP)^, fCData^ do
      fGetRemoteID := fPData^.aRemoteID;
  end;

  procedure fGetSessionParams(FP : PFaxRec;
                              var BPS : LongInt;
                              var Resolution : Boolean;
                              var Correction : Boolean);
    {-Return remote or session parameters}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      BPS := cSessionBPS;
      Resolution := cSessionRes;
      Correction := cSessionECM;
    end;
  end;

  function fGetHangupResult(FP : PFaxRec) : Word;
    {-Return last hangup result, class 2 only}
  begin
    with PC12FaxData(FP)^, fCData^ do
      fGetHangupResult := cHangupCode;
  end;

  procedure caCalcMinBytesPerLine(FP : PFaxRec);
    {-Calculate minimum byte per line}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do
      cMinBytes :=
        ((cSessionBPS * ScanTimes[cSessionScan, cSessionRes]) div 8000);
  end;

  procedure caExtractClass1Params(FP : PFaxRec;
                                  DIS : Boolean; B2, B3 : Byte);
    {-Extract bps, res, ecm from 2nd byte of DCS/DIS}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      FillChar(cRmtMods, SizeOf(cRmtMods), False);
      cRmtMods[1] := True;
      cRmtMods[2] := True;

      if DIS then begin
        cRmtMods[6] := B2 and $20 = $20;
        cRmtMods[5] := B2 and $10 = $10;
        case B2 and $0C of
          $04 : cRmtMods[4] := True;
          $0C : begin
                  cRmtMods[3] := True;
                  cRmtMods[4] := True;
                end;
        end;

        {Set SessionBPS from lowest common between local and remote capabilities}
        {and less than or equal to MaxFaxBPS}
        cBPSIndex := MaxModIndex+1;
        repeat
          Dec(cBPSIndex);
        until (cLocalMods[cBPsIndex] and cRmtMods[cBPSIndex]) and
              (Class1BPSArray[cBPSIndex] <= cMaxFaxBPS);
        cSessionBPS := Class1BPSArray[cBPSIndex];

      end else begin
        if B2 and $20 = $20 then
          cBPSIndex := 6
        else if B2 and $10 = $10 then
          cBPSIndex := 5
        else begin
          case B2 and $0C of
            $00 : cBPSIndex := 1;
            $08 : cBPSIndex := 2;
            $04 : cBPSIndex := 4;
            else  cBPSIndex := 3;
          end;
        end;
        cSessionBPS := Class1BPSArray[cBPSIndex];
      end;

      {Set resolution and error correction}
      if DIS then
        cSessionRes := cResC = '1'
      else
        cSessionRes := B2 and $40 = $40;

      if DIS then
        cSessionWid := cPageHeader.ImgFlags and ffHighWidth <> 0
      else
        cSessionWid := B3 and $03 = $01;

      cSessionECM := False;

      if DIS then begin
        cCanDoHighRes := B2 and $40 = $40;
        cCanDoHighWid := B3 and $03 = $01;
      end;

      {Set scan times}
      case B3 and $70 of
        $70 : cSessionScan := 0;   {0,0}
        $10 : cSessionScan := 1;   {5,5}
        $60 : cSessionScan := 2;   {10,5}
        $20 : cSessionScan := 3;   {10,10}
        $30 : cSessionScan := 4;   {20,10}
        $00 : cSessionScan := 5;   {20,20}
        $50 : cSessionScan := 6;   {40,20}
        $40 : cSessionScan := 7;   {40,40}
      end;
      caCalcMinBytesPerLine(FP);
    end;
  end;

  procedure caExtractClass2Params(FP : PFaxRec; S : ShortString);
    {-Extract bps, res, ecm from S, as data from FDCS/FDIS}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      case S[3] of
        '0': cSessionBPS := 2400;
        '1': cSessionBPS := 4800;
        '2': cSessionBPS := 7200;
        '4': cSessionBPS := 12000;
        '5': cSessionBPS := 14400;
        else cSessionBPS := 9600;
      end;

      cSessionRes   := S[1] = '1';
      cCanDoHighRes := cSessionRes;
      cSessionWid   := S[5] = '1';
      cCanDoHighWid := cSessionWid;

      case cResponse[11] of
        '1', '2' : cSessionECM := True;
        else       cSessionECM := False;
      end;

      cSessionScan := Ord(cResponse[15])-$30;

      caCalcMinBytesPerLine(FP);
    end;
  end;

(* not currently used

  function caModulationCode(FP : PFaxRec; B : Byte) : ShortString;
    {-Returns highest modulation string from 2nd byte of DCS/DIS}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      if B and $20 = $20 then
        caModulationCode := '145'
      else if B and $10 = $10 then
        caModulationCode := '121'
      else begin
        case B and $0C of
          $00 : caModulationCode := '24';
          $08 : caModulationCode := '48';
          $04 : caModulationCode := '96';
          $0C : caModulationCode := '72';
        end;
      end;
    end;
  end; *)

  function caNextBPS(FP : PFaxRec) : Boolean;
    {-Return next lower BPS, False if at 2400}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      repeat
        Dec(cBPSIndex);
      until (cBPSIndex = 0) or (cLocalMods[cBPSIndex] and cRmtMods[cBPSIndex]);
      caNextBPS := cBPSIndex <> 0;
      if cBPSIndex <> 0 then
        cSessionBPS := Class1BPSArray[cBPSIndex];
      caCalcMinBytesPerLine(FP);
    end;
  end;

  function caSendClass1Command(FP : PFaxRec) : Boolean;                  {!!.01}
    { send the Class 1/1.0 command }
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      if cClassCmd = '' then begin
        cClassCmd := 'AT+FCLASS=1';
        Result := caProcessModemCmd(FP, cClassCmd);
        if not Result then begin
          cClassCmd := 'AT+FCLASS=1.0';
          Result := caProcessModemCmd(FP, cClassCmd)
        end;
      end else
        Result := caProcessModemCmd(FP, cClassCmd);
    end;
  end;

  procedure caGetClass1Modulations(FP : PFaxRec; Transmit : Boolean);
    {-Get this faxmodem's transmit/receive modulation capabilities}
  var
    Finished : Boolean;
    Dummy    : Boolean;
    WasBusy  : Boolean;
    I        : Word;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {At least one modem requires AT+FCLASS before FTM, so do it}
      if not caSendClass1Command(FP) then                                {!!.01}
        Exit;

      {Set defaults}
      FillChar(cLocalMods, SizeOf(cLocalMods), False);
      cLocalMods[1] := True;
      cLocalMods[2] := True;
      cBPSIndex := 1;

      {Send the appropriate command}
      if Transmit then
        caPutModem(FP, 'AT+FTM=?')
      else
        caPutModem(FP, 'AT+FRM=?');
      NewTimer(cReplyTimer, cReplyWait);

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

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

        {If this is a modulation response string, parse it}
        if Pos(',', cResponse) <> 0 then begin
          for I := 3 to 6 do
            cLocalMods[I] := Pos(ModArray[I], cResponse) <> 0;

          {Note highest mod}
          cBPSIndex := MaxModIndex;
          while not cLocalMods[cBPSIndex] do
            Dec(cBPSIndex);
        end;

        {Wait briefly for OK}
        if TimerExpired(cReplyTimer) then
          Finished := True
        else begin
          NewTimer(cReplyTimer, 36);
          Finished := caOkResponse(FP) or caErrorResponse(FP);
        end;

        SafeYield;
        aPort.ProcessCommunications;
      until Finished or TimerExpired(cReplyTimer);

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

  procedure caHDLCStart(FP : PFaxRec; Last : Boolean);
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      DelayMS(FrameWait);
      aPort.PutChar(AddrField);
      if Last then
        aPort.PutChar(ControlFieldLast)
      else
        aPort.PutChar(ControlField);
    end;
  end;

  procedure caHDCLEnd(FP : PFaxRec);
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      aPort.PutChar(cDLE);
      aPort.PutChar(cETX);
    end;
  end;

  procedure caPutStandardFrame(FP : PFaxRec; Frame : Byte;
                               Last : Boolean);                     
    {-Transmit an standard frame of type Frame}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {Send HDLC address and control fields}
      caHDLCStart(FP, Last);

      {Send fax control field, EOP format}
      aPort.PutChar(Char(Frame));