awabsfax.pas

测试用例

        {preserve and delete tag from the main string}
        T := Copy(S, I, N);
        Delete(S, I, N);

        {which tag?}
        case Upcase(T[2]) of
          'D':  {insert Date}
            T := TodayString;

          'T':  {insert Time}
            T := NowString;

          'I':  {insert station Id}
            T := aStationID;

          'S':  {insert Sender (Title)}
            T := aTitle;

          'P':  {insert current Page number}
            if aCoverCount > 0 then
              if aSendingCover then
                T := '1'
              else
                Str(aCurrPage+1, T)
            else
              Str(aCurrPage, T);

          'N':  {insert Number of pages}
            Str(aPageCount+aCoverCount, T);

          'F' : {insert from name}
            T := aSender;

          'R' : {insert recipient's name}
            T := aRecipient;

          '$' : {insert a dollar sign}                                   {!!.01}
            T := #1;                                                     {!!.01}

          else  {invalid tag, do nothing}
            T := '';
        end;
        Insert(T, S, I);

        {find next tag}
        I := Pos('$', S);
      end;
      while Pos(#1, S) > 0 do                                            {!!.01}
        S[Pos(#1, S)] := '$';                                            {!!.01}
      afConvertHeaderString := S;
    end;
  end;

  function afAddFaxEntry(FP : PFaxRec;
                         const Number : ShortString;
                         const FName : ShortString;
                         const Cover : ShortString) : Integer;
    {-Add another number to the built-in list}
  var
    Node : PFaxEntry;
  begin
    with FP^, aPData^ do begin
      Node := AllocMem(SizeOf(TFaxEntry));
      afAddFaxEntry := ecOk;

      {Create new node}
      with Node^ do begin
        fNumber := Number;
        fFName := FName;
        fCover := Cover;
        fNext := nil;
      end;

      if aFaxListHead = nil then begin
        {Set head/tail if this is the first...}
        aFaxListHead := Node;
        aFaxListTail := Node;
        aFaxListNode := Node;
        aFaxListCount := 1;
      end else begin
        {Attach to previous tail}
        aFaxListTail^.fNext := Node;
        aFaxListTail := Node;
        Inc(aFaxListCount);
      end;
    end;
  end;

  procedure afClearFaxEntries(FP : PFaxRec);
    {-Remove all fax entries from builtin list}
  var
    Node : PFaxEntry;
    Next : PFaxEntry;
  begin
    with FP^, aPData^ do begin
      Node := aFaxListHead;
      while Node <> nil do begin
        Next := Node^.fNext;
        FreeMem(Node, SizeOf(TFaxEntry));
        Node := Next;
      end;
      aFaxListCount := 0;
      aFaxListHead := nil;
      aFaxListTail := nil;
      aFaxListNode := nil;
    end;
  end;

  function afGetFaxName(FP : PFaxRec) : ShortString;
    {-Return name of current fax, with path if supplied}
  begin
    with FP^, aPData^ do
      afGetFaxName := aFaxFileName;
  end;

  procedure afSetFaxName(FP : PFaxRec; FaxName : ShortString);
    {-Set the name of the incoming fax}
  begin
    with FP^, aPData^ do
      aFaxFileName := FaxName;
  end;

  function afGetFaxProgress(FP : PFaxRec) : Word;
    {-Return fax progress code}
  begin
    with FP^, aPData^ do
      afGetFaxProgress := aFaxProgress;
  end;

  procedure afReportError(FP : PFaxRec; ErrorCode : Integer);
    {-Report the error}
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with FP^, aPData^ do begin
      aFaxError := ErrorCode;
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, APW_FAXERROR, ErrorCode, 0,
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, APW_FAXERROR, ErrorCode, 0);
      {$ENDIF}
    end;
  end;

  procedure afSignalFinish(FP : PFaxRec);
    {-Send finish message to parent window}
  var
    ErrMsg : String;
  begin
    with FP^, aPData^ do begin
      {aPort.pSetFaxFlag(False);}
      afStopFax(FP);
      ErrMsg := 'ErrorCode:' + IntToStr(aFaxError);
      aPort.AddDispatchEntry(dtFax, dstStatus, 0,
        @ErrMsg[1], Length(ErrMsg));                               

      PostMessage(aHWindow, apw_FaxFinish, Word(aFaxError), Longint(FP));
    end;
  end;

  procedure afStartFax(FP : PFaxRec;
                       StartProc : TFaxPrepProc;
                       FaxFunc : TFaxFunc);
    {-Setup standard fax triggers}
  {var}
    {lParam : LongInt;}                                                  {!!.04}
  begin
    with FP^, aPData^ do begin

      HaveTriggerHandler := False;
      {Note the fax}
      aCurFaxFunc := FaxFunc;
      aPort.RemoveAllTriggers;                                           {!!.02}
      {Set up standard triggers}
      aPort.ChangeLengthTrigger(1);
      aTimeoutTrigger := aPort.AddTimerTrigger;
      aStatusTrigger := aPort.AddTimerTrigger;
      aOutBuffFreeTrigger := aPort.AddStatusTrigger(stOutBuffFree);
      aOutBuffUsedTrigger := aPort.AddStatusTrigger(stOutBuffUsed);
      {aNoCarrierTrigger := aPort.AddStatusTrigger(stModem);}            {!!.02}

      {All set?}
      if (aTimeoutTrigger < 0) or
         (aStatusTrigger < 0) or (aOutBuffFreeTrigger < 0) or
         (aOutBuffUsedTrigger < 0) {or (aNoCarrierTrigger < 0)}then begin{!!.02}
        {Send error message and give up}
        afReportError(FP, ecNoMoreTriggers);
        afSignalFinish(FP);
        Exit;
      end;

      {Store fax pointer}
      aPort.SetDataPointer(Pointer(FP), 2);

      {Prepare fax}
      if assigned(StartProc) then
        StartProc(FP);
      if aFaxError = ecOK then begin
        {add our state machine as a trigger handler procedure}
        aPort.RegisterProcTriggerHandler(FaxFunc);
        HaveTriggerHandler := True;
        {Call fax notification directly the first time...}
        {LH(lParam).H := aPort.Handle;}                                  {!!.04}
        {LH(lParam).L := 0;}                                             {!!.04}
        {FaxFunc(0, 0, lParam);}                                         {!!.04}
        {Activate status timer now, we'll enter the state machine in 2 ticks}
        aPort.SetTimerTrigger(aStatusTrigger, 2, True);                  {!!.04}
      end else begin
        {Couldn't get started, finish now}
        afFaxStatus(FP, False, True);
        afSignalFinish(FP);
      end;
    end;
  end;

  procedure afStopFax(FP : PFaxRec);
    {-Stop the fax}

    procedure RemoveIt(Trig : Integer);
    begin
      with FP^, aPData^ do
        if Trig > 0 then
          aPort.RemoveTrigger(Trig);
    end;

  begin
    with FP^, aPData^ do begin
      {Remove the fax triggers}
      {RemoveIt(aDataTrigger);}
      RemoveIt(aTimeoutTrigger);
      RemoveIt(aStatusTrigger);
      RemoveIt(aOutBuffFreeTrigger);
      RemoveIt(aOutBuffUsedTrigger);
      {RemoveIt(aNoCarrierTrigger);}                                     {!!.02}

      {Remove our trigger handler}
      if HaveTriggerHandler then begin
        aPort.DeregisterProcTriggerHandler(aCurFaxFunc);
        HaveTriggerHandler := False;
      end;                                                          

      {Say we're not in progress anymore}
      aInProgress := False;
    end;
  end;

  function afStatusMsg(P : PChar; Status : Word) : PChar;
    {-Return an appropriate error message from the stringtable}
  begin
    case Status of
      fpInitModem..fpFinished :
        AproLoadZ(P, Status);
      else
        P[0] := #0;
    end;
    Result := P;
  end;

{Builtin functions}

  function afNextFaxList(FP : PFaxRec;
                         var Number : ShortString;
                         var FName : ShortString;
                         var Cover : ShortString) : Boolean;
  begin
    with FP^, aPData^ do begin
      if aFaxListNode <> nil then begin
        afNextFaxList := True;
        with aFaxListNode^ do begin
          Number := fNumber;
          FName := fFName;
          Cover := fCover;
          aFaxListNode := fNext;
        end;
      end else
        afNextFaxList := False;
    end;
  end;

  function afFaxNameMD(FP : PFaxRec) : ShortString;
    {-Returns name for incoming fax like MMDD0001.APF}
  var
    I      : Word;
    Y,M,D  : Word;
    MS, DS : String[2];
    FName1 : String[4];
    FName  : ShortString;

    procedure MakeFileName(I : Word);
    var
      CountS : String[4];
      J : Word;
    begin
      with FP^, aPData^ do begin
        Str(I:4, CountS);
        for J := 1 to 4 do
          if CountS[J] = ' ' then
            CountS[J] := '0';
        FName := FName1 + CountS + '.' + aFaxFileExt;
        if aDestDir <> '' then
          FName := AddBackSlashS(aDestDir)+FName;
      end;
    end;

  begin
    with FP^, aPData^ do begin
      {Get the date}
      DecodeDate(SysUtils.Date, Y, M, D);
      Str(M:2, MS);
      Str(D:2, DS);
      FName1 := MS + DS;
      for I := 1 to 4 do
        if FName1[I] = ' ' then
          FName1[I] := '0';

      {Find last file with this date}
      I := 0;
      repeat
        Inc(I);
        MakeFileName(I);
      until not FileExists(FName) or (I = 10000);

      if I < 10000 then begin
        MakeFileName(I);
        afFaxNameMD := FName;
      end else
        afFaxNameMD := 'NONAME.APF';
    end;
  end;

  function afFaxNameCount(FP : PFaxRec) : ShortString;
    {-Returns name for incoming fax like FAX00001.APF}
  var
    I : Word;
    FName : ShortString;

    procedure MakeFileName(I : Word);
    var
      CountS : String[4];
      J : Word;
    begin
      with FP^, aPData^ do begin
        Str(I:4, CountS);
        for J := 1 to 4 do
          if CountS[J] = ' ' then
            CountS[J] := '0';
        FName := 'FAX' + CountS + '.' + aFaxFileExt;
        if aDestDir <> '' then
          FName := AddBackSlashS(aDestDir)+FName;
      end;
    end;

  begin
    with FP^, aPData^ do begin
      {Find last file}
      I := 0;
      repeat
        Inc(I);
        MakeFileName(I);
      until not FileExists(FName) or (I = 10000);

      if I < 10000 then begin
        MakeFileName(I);
        afFaxNameCount := FName;
      end else
        afFaxNameCount := 'NONAME.APF';
    end;
  end;

initialization

end.