awabsfax.pas

测试用例

    rf1FinishPage,
    rf1WaitEOP,
    rf1WritePage,
    rf1SendMCF,
    rf1WaitDCN,
    rf1WaitHangup,

    {Phase D, class 2}
    rf2GetPageResult,
    rf2GetFHNG,

    {Phase E, both classes}
    rfComplete,
    rfAbort,
    rfDone);

const
  {Bit reversed fax control fields IDs from HDLC info field}
  NSFFrame = $20;
  EOPFrame = $2E;
  CSIFrame = $40;
  TSIFrame = $42;
  FTTFrame = $44;
  RTNFrame = $4C;
  MPSFrame = $4E;
  DISFrame = $80;
  DCSFrame = $82;
  CFRFrame = $84;
  MCFFrame = $8C;
  EOMFrame = $8E;
  DCNFrame = $FA;
  RTPFrame = $CC;

  {Size of buffer for fax file data}
  DataBufferSize = 4096;

  {DIS/DCS permanent bit masks, bit reversed}
  DISGroup1   = $00;        {No group 1/2 options}
  DISGroup3_1 = $02;        {RS 465 receiver/transmitter support}
  DISGroup3_2 = $88;        {A4 width, unlimited len, extended byte}
  DISGroup3_3 = $00;        {No extended options}

  {DIS/DCS option bits for DISGroup3_1}
  DISHighResolution = $40;
  DIS2400BPS        = $00;
  DIS4800BPS        = $08;
  DIS7200BPS        = $0C;
  DIS9600BPS        = $04;
  DIS12000BPS       = $10;
  DIS14400BPS       = $20;

  {DIS/DCS option bits for DISGroup3_2}
  DISWideWidth      = $01;

  {Class 1 constants}
  AddrField = #$FF;
  ControlField = #$03;
  ControlFieldLast = #$13;

  {Variable class 2/2.0 commands}
  C2ClassCmd    = 'CLASS=2';    C20ClassCmd    = 'CLASS=2.0';
  C2ModelCmd    = 'MDL?';       C20ModelCmd    = 'MI?';
  C2MfrCmd      = 'MFR?';       C20MfrCmd      = 'MM?';
  C2RevCmd      = 'REV?';       C20RevCmd      = 'MR?';
  C2DISCmd      = 'DIS';        C20DISCmd      = 'IS';
  C2StationCmd  = 'LID';        C20StationCmd  = 'LI';
  C2DCCCmd      = 'DCC';        C20DCCCmd      = 'CC';

  {Variable class 2/2.0 responses}
  C2FaxResp     = 'CON';        C20FaxResp     = 'CO';
  C2DISResp     = 'DIS';        C20DISResp     = 'IS';
  C2DCSResp     = 'DCS';        C20DCSResp     = 'CS';
  C2TSIResp     = 'TSI';        C20TSIResp     = 'TI';
  C2CSIResp     = 'CSI';        C20CSIResp     = 'CI';
  C2PageResp    = 'PTS';        C20PageResp    = 'PS';
  C2HangResp    = 'HNG';        C20HangResp    = 'HS';

const
  {Fax constants}
  DefFaxFileExt = 'APF';                        {Default extension}

  {Misc constants}
  DosDelimSet : set of Char = ['\', ':', #0];

implementation

{General routines}

  procedure AnsiUpCheck(B : PChar; Len : Word);
  begin
    if Len <> 0 then
      AnsiUpperBuff(B, Len);
  end;

  function AddBackSlashS(DirName : ShortString) : ShortString;
    {-Add a default backslash to a directory name}
  begin
    if DirName[Length(DirName)] in DosDelimSet then
      AddBackSlashS := DirName
    else
      AddBackSlashS := DirName+'\';
  end;

{Date routines}

  function TodayString : ShortString;
    {-return today's date}
  begin
    {Get the system date}
    Result := DateToStr(SysUtils.Date);
  end;

  function NowString : ShortString;
    {-return the current time as a "HH:MMpm" string}
  begin
    Result := TimeToStr(Now);
  end;

{FaxData routines}

  function afInitFaxData(var PData : PFaxData; ID : Str20;
                         ComPort : TApdBaseDispatcher; Window : TApdHwnd) : Integer;
    {-Allocate and initialize a FaxData structure}
  begin
    PData := AllocMem(SizeOf(TFaxData));

    afInitFaxData := ecOK;

    with PData^ do begin
      aPort := ComPort;
      aHWindow := Window;
      aStationID := ID;
      aMaxConnect := DefConnectAttempts;
      afFlags := DefFaxOptions;
      aStatusInterval := DefStatusTimeout;
      aFaxFileExt := DefFaxFileExt;
    end;
  end;

  function afDoneFaxData(var PData : PFaxData) : Integer;
    {-Dispose of a FaxData record}
  var
    Node : PFaxEntry;
    Next : PFaxEntry;
  begin
    afDoneFaxData := ecOK;
    if not Assigned(PData) then
      Exit;

    with PData^ do begin
      {Dispose of faxentry list}
      if aFaxListCount <> 0 then begin
        Node := aFaxListHead;
        while Node <> nil do begin
          Next := Node^.fNext;
          FreeMem(Node, SizeOf(TFaxEntry));
          Node := Next;
        end;
      end;
    end;
    FreeMem(PData, SizeOf(TFaxData));
  end;

  procedure afOptionsOn(FP : PFaxRec; OptionFlags : Word);
    {-Activate multiple options}
  begin
    with FP^, aPData^ do
      afFlags := afFlags or (OptionFlags and not BadFaxOptions);
  end;

  procedure afOptionsOff(FP : PFaxRec; OptionFlags : Word);
    {-Deactivate multiple options}
  begin
    with FP^, aPData^ do
      afFlags := afFlags and not (OptionFlags and not BadFaxOptions);
  end;

  function afOptionsAreOn(FP : PFaxRec; OptionFlags : Word) : Boolean;
    {-Return True if all specified options are on}
  begin
    with FP^, aPData^ do
      afOptionsAreOn := (afFlags and OptionFlags = OptionFlags);
  end;

  procedure afSetConnectAttempts(FP : PFaxRec; Attempts : Word;
                                DelayTicks : Word);
    {-Set number of connect attempts per fax, 0 = infinite}
  begin
    with FP^, aPData^ do begin
      aMaxConnect := Attempts;
      aRetryWait := DelayTicks;
    end;
  end;

  procedure afSetNextFax(FP : PFaxRec;
                         Number : ShortString;
                         FName : ShortString;
                         Cover : ShortString);
    {-Set the next fax to transmit}

  begin
    with FP^, aPData^ do begin
      {Get the next fax to send}
      aPhoneNum := Number;
      aFaxFileName := FName;
      aCoverFile := Cover;

      {Upcase the file names}
      AnsiUpCheck(@aFaxFileName[1], Length(aFaxFileName));
      AnsiUpCheck(@aCoverFile[1], Length(aCoverFile));
    end;
  end;

  procedure afSetComHandle(FP : PFaxRec; NewHandle : TApdBaseDispatcher);
    {-Set a new comhandle to use}
  begin
    with FP^, aPData^ do
      aPort := NewHandle
  end;

  procedure afSetWindow(FP : PFaxRec; NewWindow : TApdHwnd);
    {-Set a new window handle to use}
  begin
    with FP^, aPData^ do
      aHWindow := NewWindow;
  end;

  procedure afSetTitle(FP : PFaxRec; NewTitle : ShortString);
  begin
    with FP^, aPData^ do
      aTitle := NewTitle;
  end;

  procedure afSetRecipientName(FP : PFaxRec; NewName : ShortString);
    {-Set name of recipient}
  begin
    with FP^, aPData^ do
      aRecipient := NewName;
  end;

  procedure afSetSenderName(FP : PFaxRec; NewName : ShortString);
    {-Set name of sender}
  begin
    with FP^, aPData^ do
      aSender := NewName;
  end;

  procedure afSetDestinationDir(FP : PFaxRec; Dest : ShortString);
    {-Set a destination directory for received files}
  begin
    with FP^, aPData^ do begin
      aDestDir := Dest;
      AnsiUpCheck(@aDestDir[1], Length(aDestDir));
    end;
  end;

  procedure afSetStationID(FP : PFaxRec; NewID : Str20);
  begin
    with FP^, aPData^ do
      aStationID := NewID;
  end;

  procedure afFaxStatus(FP : PFaxRec; Starting, Ending : Boolean);
    {-Fax status message, wParam mask: $01 = starting, $02 = ending}
    {                     lParam = FP}
  const
    StartMask : array[Boolean] of Word = ($00, $01);
    EndMask   : array[Boolean] of Word = ($00, $02);
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with FP^, aPData^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXSTATUS,
                         StartMask[Starting] or EndMask[Ending],
                         LongInt(FP),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, APW_FAXSTATUS,
                  StartMask[Starting] or EndMask[Ending], LongInt(FP));
      {$ENDIF}
  end;

  function afNextFax(FP : PFaxRec) : Boolean;
    {-Return next number to dial, wParam not used}
    {                             lParam = FP   }
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with FP^, aPData^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXNEXTFILE, 0, LongInt(FP),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         2000, Res);                                  
      afNextFax := Boolean(Res);
      {$ELSE}
      afNextFax :=
        Boolean(SendMessage(aHWindow, APW_FAXNEXTFILE, 0, LongInt(FP)));
      {$ENDIF}
  end;

  procedure afLogFax(FP : PFaxRec; Log : TFaxLogCode);                   {!!.04}
    {-Logs the fax, wParam = logcode, lParam not used }
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with FP^, aPData^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXLOG, Integer(Log), LongInt(FP),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, APW_FAXLOG, Integer(Log), LongInt(FP));
      {$ENDIF}
  end;

  procedure afFaxName(FP : PFaxRec);
    {-Call FaxName hook, wParam not used, lParam = FP}
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with FP^, aPData^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXNAME, 0, LongInt(FP),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, APW_FAXNAME, 0, LongInt(FP));
      {$ENDIF}
  end;

  function afAcceptFax(FP : PFaxRec; RemoteName : Str20) : Boolean;
    {-Call AcceptFax hook, wParam not used, lParam = FP}
  var
    P : array[0..20] of Char;
    {$IFDEF Win32}
    Res : DWORD;
    {$ENDIF}
  begin
    with FP^, aPData^ do begin
      StrPCopy(P, RemoteName);
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXACCEPT, 0, LongInt(FP),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      afAcceptFax := Boolean(Res);
      {$ELSE}
      afAcceptFax := Boolean(
         SendMessage(aHWindow, APW_FAXACCEPT, 0, LongInt(FP)));
      {$ENDIF}
    end;
  end;

  function afConvertHeaderString(FP : PFaxRec; S : ShortString) : ShortString;
    {-Compress a fax header string, converting tags to appropriate values}
  var
    I, N : Integer;
    T : String;
  begin
    with FP^, aPData^ do begin
      {walk thru the string, converting tags to appropriate data}
      I := Pos('$', S);
      while I > 0 do begin
        {get length of tag}
        N := I;
        while (N <= Length(S)) and (S[n] <> ' ') do
          Inc(N);
        Dec(N, I);