awfax.pas

来自「Async Professional 4.04」· PAS 代码 · 共 2,052 行 · 第 1/5 页

     dstrfInit, dstrf1Init1, dstrf2Init1, dstrf2Init1A, dstrf2Init1B,
     dstrf2Init2, dstrf2Init3, dstrfWaiting, dstrfAnswer,
     dstrf1SendCSI, dstrf1SendDIS, dstrf1CollectFrames,
     dstrf1CollectRetry1, dstrf1CollectRetry2, dstrf1StartTrain,
     dstrf1CollectTrain, dstrf1Timeout, dstrf1Retrain,
     dstrf1FinishTrain, dstrf1SendCFR, dstrf1WaitPageConnect,
     dstrf2ValidConnect, dstrf2GetSenderID, dstrf2GetConnect,
     dstrfStartPage, dstrfGetPageData, dstrf1FinishPage,
     dstrf1WaitEOP, dstrf1WritePage, dstrf1SendMCF, dstrf1WaitDCN,
     dstrf1WaitHangup, dstrf2GetPageResult, dstrf2GetFHNG,
     dstrfComplete, dstrfAbort, dstrfDone);

{General purpose}

  function TrimStationID(S : ShortString) : ShortString;
  begin
    S := Trim(S);
    if S[1] = '"' then
      S[1] := ' ';
    while (Length(S) > 0) and
          (not(Upcase(S[Length(S)]) in ['0'..'9','A'..'Z'])) do
      Dec(S[0]);
    TrimStationID := Trim(S);
  end;

  function PadCh(S : ShortString; Ch : Char; Len : Byte) : ShortString;
    {-Return a string right-padded to length len with ch}
  var
    o : ShortString;
    SLen : Byte absolute S;
  begin
    if Length(S) >= Len then
      PadCh := S
    else begin
      o[0] := Chr(Len);
      Move(S[1], o[1], SLen);
      if SLen < 255 then
        FillChar(o[Succ(SLen)], Len-SLen, Ch);
      PadCh := o;
    end;
  end;

  function GetPackedDateTime : LongInt;
    {-Return today's date/time in file packed date format}
  begin
    Result := DateTimeToFileDate(Now);
  end;

  {$IFDEF Win32}
  function RotateByte(Code : Char) : Byte; assembler; register;
    {-Flip code MSB for LSB}
  asm
    mov dl,al
    xor eax,eax
    mov ecx,8
@1: shr dl,1
    rcl al,1
    loop @1
  end;
  {$ELSE}
  function RotateByte(Code : Char) : Byte; assembler;
    {-Flip code MSB for LSB}
  asm
    mov dl,Code
    xor ax,ax
    mov cx,8
@1: shr dl,1
    rcl al,1
    loop @1
  end;
  {$ENDIF}

  procedure Merge(var S : TModemResponse; C : Char);
    {-appends C to S, shifting S if it gets too long}
  var
    B : Byte absolute S;
  begin
    if B > SizeOf(TModemResponse)-1 then
      Move(S[2], S[1], B-1)
    else
      Inc(B);
    S[B] := C;
  end;

  procedure StripPrefix(var S : TModemResponse);
    {-removes prefix from faxmodem response string}
  var
    SepPos : Integer;
  begin
    S := Trim(S);
    SepPos := Pos(':', S);
    if SepPos = 0 then
      SepPos := Pos('=', S);
   if SepPos > 0 then
      Delete(S, 1, SepPos);
    S := Trim(S);
  end;

  function HasExtensionS(const Name : ShortString;
                         var DotPos : Word) : Boolean;
    {-Return whether and position of extension separator dot in a pathname}
  var
    I : Word;
  begin
    DotPos := 0;
    for I := Length(Name) downto 1 do
      if (Name[I] = '.') and (DotPos = 0) then
        DotPos := I;
    HasExtensionS :=
      (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  end;

  function DefaultExtensionS(Name, Ext : ShortString) : ShortString;
    {-Return a pathname with the specified extension attached}
  var
    DotPos : Word;
  begin
    if HasExtensionS(Name, DotPos) then
      DefaultExtensionS := Name
    else if Name = '' then
      DefaultExtensionS := ''
    else
      DefaultExtensionS := Name+'.'+Ext;
  end;

  function CheckForString(var Index : Byte; C : Char; S : ShortString) : Boolean;
    {-Checks for string S on consecutive calls, returns True when found}
  begin
    CheckForString := False;
    Inc(Index);

    {Compare...}
    if C = S[Index] then
      {Got match, was it complete?}
      if Index = Length(S) then begin
        Index := 0;
        CheckForString := True;
      end else
    else
      {No match, reset Index}
      if C = Upcase(S[1]) then
        Index := 1
      else
        Index := 0;
  end;

  procedure FlushInQueue(FP : PFaxRec);
    {-Read (flush) trailing data from last incoming block}
  var
    C : Char;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do
      while aPort.CharReady do
        aPort.GetChar(C);
  end;

{C12AbsData}

  procedure caFreeC12EnhFonts(var DP : PC12AbsData);
  begin
    with DP^ do begin
      cEnhSmallFont.Free;
      cEnhSmallFont := nil;
      cEnhStandardFont.Free;
      cEnhStandardFont := nil;
    end;
  end;

  procedure caInitC12EnhFonts(var DP : PC12AbsData);
  begin
    with DP^ do begin
      if Assigned(cEnhSmallFont) or Assigned(cEnhStandardFont) then
        caFreeC12EnhFonts(DP);
      cEnhSmallFont := TFont.Create;
      cEnhStandardFont := TFont.Create;
    end;
  end;

  function cInitC12AbsData(var DP : PC12AbsData) : Integer;
    {-Allocate and initialize a C12AbsData record}
  begin
    DP := AllocMem(SizeOf(TC12AbsData));

    with DP^ do begin
      cDataBuffer := AllocMem(DataBufferSize);

      cEnhTextEnabled := False;
      cBlindDial      := False;
      cDetectBusy     := True;
      cToneDial       := True;
      cDialWait       := awfDefFaxDialTimeout;
      cMaxFaxBPS      := 9600;
      cCheckChar      := '0';
      cAnswerOnRing   := 1;
      cReplyWait      := awfDefCmdTimeout;
      cTransWait      := awfDefTransTimeout;
      cFaxAndData     := '0';
      cForcedInit     := DefNormalInit;                                  {!!.04}
    end;
    caInitC12EnhFonts(DP);                                          
    cInitC12AbsData   := ecOK;
  end;

  function cDoneC12AbsData(var DP : PC12AbsData) : Integer;
  begin
    cDoneC12AbsData := ecOK;
    if not Assigned(DP) then
      Exit;

    with DP^ do begin
      caFreeC12EnhFonts(DP);
      if cDataBuffer <> nil then                                   
        FreeMem(cDataBuffer, DataBufferSize);
      FreeMem(DP, SizeOf(TC12AbsData));
    end;
  end;

  procedure fSetFaxPort(FP : PFaxRec; ComPort : TApdBaseDispatcher);
    {-Set a new comport handle}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do
      aPort := ComPort;
  end;

  procedure fSetModemInit(FP : PFaxRec; MIS : ShortString);
    {-set modem init string}
  begin
    with PC12FaxData(FP)^, fCData^ do begin
      if Length(MIS) > 0 then begin
        cModemInit := MIS;
        AnsiUpperBuff(@cModemInit[1], Length(MIS));
        if Pos('AT', cModemInit) <> 1 then                          
          cModemInit := 'AT'+cModemInit;
      end else cModemInit := '';                                    
    end;
  end;

  function fSetClassType(FP : PFaxRec; CT : ClassType) : ClassType;
    {-Set type of modem, return detected or set type}
  var
    Class1 : Boolean;
    Class2 : Boolean;
    Class2_0 : Boolean;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      if CT = ctDetect then begin
        if fGetModemClassSupport(FP, Class1, Class2, Class2_0, True) then begin
          if Class2_0 then
            aClassInUse := ctClass2_0
          else if Class2 then
            aClassInUse := ctClass2
          else if Class1 then
            aClassInUse := ctClass1
          else
            aClassInUse := ctUnknown;
        end else
          aClassInUse := ctUnknown;
      end else
        aClassInUse := CT;

      fSetClassType := aClassInUse;
    end;
  end;

  procedure caSwitchBaud(FP : PFaxRec; High : Boolean);
    {-Switch baud rates}
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      {first force baud to max of 19.2 for faxing}
      aPort.ChangeBaud(19200);                                      
      if High then begin
        {Switch to the high normal baud rate}
        if (cInitBaud <> 0) and cSlowBaud then begin
          DelayTicks(BaudChangeDelay, False);
          aPort.ChangeBaud(cNormalBaud);
          cSlowBaud := False;
        end;
      end else begin
        {Switch to low initialization baud rate}
        if (cInitBaud <> 0) and not cSlowBaud then begin
          DelayTicks(BaudChangeDelay, False);
          aPort.ChangeBaud(cInitBaud);
          cSlowBaud := True;
        end;
      end;
    end;
  end;

  procedure fSetInitBaudRate(FP : PFaxRec;
                             InitRate, NormalRate : LongInt;
                             DoIt : Boolean);
    {-Set baud rate to use when initializing modem}
  var
    Parity   : Word;
    DataBits : TDataBits;
    StopBits : TStopBits;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      cInitBaud := InitRate;
      if (NormalRate = 0) and (aPort <> nil) then
        aPort.GetLine(cNormalBaud, Parity, DataBits, StopBits)
      else
        cNormalBaud := NormalRate;

      {Start in low baud}
      if DoIt and (aPort <> nil) then
        caSwitchBaud(FP, False);
    end;
  end;

  function caLocatePage(FP : PFaxRec; PgNo : Word) : Integer;
  var
    W : Word;
    L : LongInt;
    P : TPageHeaderRec;
  begin
    with PC12FaxData(FP)^, fCData^, fPData^ do begin
      caLocatePage := ecDiskRead;

      {validate number}
      if (PgNo = 0) or (PgNo > cFaxHeader.PageCount) then
        Exit;

      {start at head of file and walk the list of pages}
      Seek(cInFile, cFaxHeader.PageOfs);
      Result := -IOResult;
      if Result <> 0 then                                             
        Exit;

      if PgNo > 1 then begin
        for W := 1 to (PgNo-1) do begin
          BlockRead(cInFile, P, SizeOf(P));
          Result := -IOResult;
          if Result <> 0 then                                         
            Exit;
          L := FilePos(cInFile);
          Inc(L, P.ImgLength);

          Seek(cInFile, L);
          Result := -IoResult;
          if Result <> ecOk then
            Exit;
        end;
      end;

    end;
  end;

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

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

  function caStripRing(FP : PFaxRec) : Boolean;                          {!!.04}
    {-Remove RING response from cResponse, returns True if cResponse<>''}
  begin
    { occasionally, the RING response is received while we're initializing, }
    { this method removes the RING response so we can init successfully     }
    with PC12FaxData(FP)^, fCData^ do begin
      if caRingResponse(FP) then begin
        Delete(cResponse, Pos('RING', cResponse), 4);
        { increment the ring counter since we've seen a RING }
        Inc(cRingCounter);
      end;
      Result := cResponse <> '';
    end;
  end;

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

  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;