adfaxsrv.pas

测试用例

        if Assigned(FFaxServerFatalErrorEvent) then                    
          FFaxServerFatalErrorEvent(Self, TFaxServerMode(FaxMode),     
            egTapi, FTapiDevice.FailureCode)                           
        else                                                           
          raise ETapiCallUnavail.Create(ecCallUnavail, True);          
      end;                                                             

    end;
  end else                                                             
    FComPort.Open := True;                                             

  { set up defaults for faxing }
  with FComPort do begin
    DataBits := 8;
    StopBits := 1;
    Parity := pNone;
    Baud := 19200;
    InSize := 8192;
    OutSize := 8192;
    HWFlowOptions := [hwfUseRTS, hwfRequireCTS];
  end;
end;

constructor TApdCustomFaxServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  if not (csDesigning in ComponentState) then begin
    FSendFax := TApdSendFax.Create(Self);
    FRecvFax := TApdReceiveFax.Create(Self);
    FSendQueryTimer := TTimer.Create(Self);
    FSendQueryTimer.Enabled := False;

    { set up internal event handlers }
    FSendFax.OnFaxFinish := FInternalFaxFinish;
    FSendFax.OnFaxStatus := FInternalFaxStatus;
    FSendFax.OnFaxLog    := FInternalFaxLog;
    FRecvFax.OnFaxFinish := FInternalFaxFinish;
    FRecvFax.OnFaxLog    := FInternalFaxLog;
    FRecvFax.OnFaxStatus := FInternalFaxStatus;
    FRecvFax.OnFaxName   := FInternalFaxName;
    FRecvFax.OnFaxAccept := FInternalFaxAccept;
    FSendQueryTimer.OnTimer := FInternalSendQueryTimer;

    { property settings for internal components }
    FSendFax.AbortNoConnect := True;
    FSendFax.DialWait := adfDefDialWait;
    { we are handling retries now by rescheduling the job }
    FSendFax.DialAttempts := 1;
    FSendFax.DialRetryWait := adfDefDialRetryWait;
    FRecvFax.OneFax := True;
    FRecvFax.AbortNoConnect := True;
    FRecvFax.FaxAndData := False;
  end;
  { property inits }
  FaxFileExt := adfDefFaxFileExt;
  ExitOnError := adfDefExitOnError;
  SoftwareFlow := adfDefSoftwareFlow;
  BlindDial := adfDefBlindDial;
  DetectBusy := adfDefDetectBusy;
  ToneDial := adfDefToneDial;
  MaxSendCount := adfDefMaxSendCount;
  BufferMinimum := adfDefBufferMinimum;
  SafeMode := adfDefSafeMode;
  DelayBetweenSends := adfDefDelayBetweenSends;
  SendQueryInterval := adfDefSendQueryInterval;
  FaxFileExt := adfDefFaxFileExt;
  DestinationDir := adfDefDestinationDir;
  ExitOnError := adfDefExitOnError;
  SoftwareFlow := adfDefSoftwareFlow;
  InitBaud := adfDefInitBaud;
  NormalBaud := adfDefNormalBaud;
  FaxClass := adfDefFaxClass;
  AnswerOnRing := adfDefAnswerOnRing;
  ConstantStatus := adfDefConstantStatus;
  FaxNameMode := adfDefFaxNameMode;
  DestinationDir := adfDefDestinationDir;
  FaxFileExt := adfDefFaxFileExt;
  FPageLength := 0;
  FEnhFont := TFont.Create;
  FEnhHeaderFont := TFont.Create;
  FDialAttempts := adfDefDialAttempts;                                 
  FDialRetryWait := adfDefDialRetryWait;
  FDialWait := AdfDefDialWait;

  FFaxServerMode := fsmIdle;
  FMonitoring := False;
  FOldMonitoring := False;
  FServerLogCode := fslNone;
  FSwitchingModes := False;                                            
  FWaitForRing := False;                                               
end;

destructor TApdCustomFaxServer.Destroy;
begin
  if Assigned(FComPort) then
    FComPort.DeregisterUserCallback(FInternalPortToggle);
  FSendFax.Free;
  FRecvFax.Free;
  EnhFont.Free;
  EnhHeaderFont.Free;
  inherited Destroy;
end;

procedure TApdCustomFaxServer.FInternalFaxAccept(CP: TObject;
  var Accept: Boolean);
begin
  if Assigned(FFaxServerAcceptEvent) then
    FFaxServerAcceptEvent(Self, Accept)                                
  else
    Accept := True;
end;

procedure TApdCustomFaxServer.FInternalFaxFinish(CP: TObject;
  ErrorCode: Integer);
var
  HangupCode: Word;
  FaxMode: TFaxServerMode;
begin
  if CP = FSendFax then
    FaxMode := fsmSend
  else if CP = FRecvFax then begin
    FaxMode := fsmReceive;
    FWaitForRing := False;                                             
  end else
    FaxMode := fsmIdle;
  if FSwitchingModes then begin
    FSwitchingModes := False;
    exit;
  end;
  try
    if (FaxMode = fsmReceive) and FPrintOnReceive then
      if Assigned(FFaxPrinter) then begin
        FFaxPrinter.FileName := FFaxFile;
        FFaxPrinter.PrintFax;
      end;
    { update the APJ to show the status of this transmission }
    if FaxMode = fsmSend then begin
      inc(CurrentRecipient.AttemptNum);
      FServerManager.UpdateStatus(CurrentJobFileName, CurrentJobNumber,
        ErrorCode, CurrentRecipient.AttemptNum >= FDialAttempts);
      { delete temp files }
       DeleteFile(FaxFile);
       DeleteFile(CoverFile);
    end;
  finally
    FFaxInProgress := False;
  end;

  { recoverable ErrorCodes are ecOK and exCancelRequested, other error codes
    require some form of intervention (checking the port, re-initing the modem,
    etc }
  if (ErrorCode = ecOK) or (ErrorCode = ecCancelRequested) or
    (ErrorCode = ecFaxBusy) or (ErrorCode = ecNoAnswer) then begin       {!!.05}
    if Assigned (FFaxServerFinishEvent) then
      { don't fire the OnFaxFinish if we're just switching modes }
      if FSwitchingModes then
        FSwitchingModes := False
      else
        try
          FFaxServerFinishEvent(Self, FaxMode, ErrorCode);
        finally
          { this is here in case an exception was raised in the event }
        end;
    if FaxMode = fsmSend then
      { reschedule jobs that were busy or cancelled }
      if (ErrorCode = ecFaxBusy) or (ErrorCode = ecCancelRequested) or   {!!.05}
        (ErrorCode = ecNoAnswer) and                                     {!!.05}
        (CurrentRecipient.AttemptNum < FDialAttempts)then begin
        FServerManager.RescheduleJob(CurrentJobFileName, CurrentJobNumber,
          Now + (FDialRetryWait / SecsPerDay), False);
    end;

  end else begin
    Monitoring := False;
    FOldMonitoring := False;
    FSendQueryTimer.Enabled := False;
    if Assigned (FFaxServerFatalErrorEvent) then begin
      if FFaxServerMode = fsmSend then
        HangupCode := FSendFax.HangupCode
      else if FFaxServerMode = fsmReceive then
        HangupCode := FRecvFax.HangupCode
      else
        HangupCode := 0;
      try                                                              
        FFaxServerFatalErrorEvent(Self, FaxMode, ErrorCode, HangupCode);
      finally                                                          
        { just in case an exception is raised in the event }
      end;                                                             
    end;
  end;

  { if where being destroyed, just exit }
  if csDestroying in ComponentState then                               
    Exit;

  { check for new fax jobs to send }
  if FSendQueryInterval > 0 then begin
    { we'll set our timer for DelayBetweenSends, then check for a new job }
    { when our FInternalSendQueryTimer event fires }
    FSendQueryTimer.Interval := Ticks2Secs(FDelayBetweenSends) * 1000;
    FSendQueryTimer.Enabled := True;
  end else if FMonitoring or FOldMonitoring then begin
    CheckPort;
    FOldMonitoring := False;
    { backdoor Monitoring to force back into receive from SetMonitoring }
    FMonitoring := False;
    Monitoring := True;
  end else begin
    { done with the port, close it }
    if FComPort.TapiMode = tmOn then
      FTapiDevice.CancelCall
    else
      FComPort.Open := False;
  end;
end;

procedure TApdCustomFaxServer.FInternalFaxLog(CP: TObject;
  LogCode: TFaxLogCode);
var
  HisFile: TextFile;
  LogString: String;
begin
  if Assigned(FFaxServerLogEvent) then
    FFaxServerLogEvent(Self, LogCode, FServerLogCode);

  if FFaxServerMode = fsmReceive then
    FFaxFile := FRecvFax.FaxFile;

  { we need to add our custom log info to the ApdFaxLog file }
  if Assigned(FFaxLog) and (FFaxLog.FaxHistoryName <> '') then begin     {!!.04}
    { a log must be wanted, open or create the log file }
    AssignFile(HisFile, FFaxLog.FaxHistoryName);
    if FileExists(FFaxLog.FaxHistoryName) then
      Append(HisFile)
    else
      Rewrite(HisFile);

    if FServerLogCode = fslNone then begin
      { a regular fax log }
      case LogCode of
        lfaxTransmitStart : { override the default string to use the APJ name }
          LogString := Format('Transmit %s (%d) to %s started at %s'#13#10,
                  [CurrentJobFileName, CurrentJobNumber, PhoneNumber,
                   DateTimeToStr(Now)]);

        lfaxTransmitOk,
        lfaxTransmitFail : LogString := FFaxLog.GetLogString(LogCode, FSendFax);

        lfaxReceiveStart,
        lfaxReceiveOk,
        lfaxReceiveSkip,
        lfaxReceiveFail  : LogString := FFaxLog.GetLogString(LogCode, FRecvFax);

      end;

    end else begin
      { it's a fax server log }
      LogString := 'Fax server ' + Self.Name;
      case FServerLogCode of
        fslPollingEnabled      : LogString := LogString + ' started polling ';
        fslPollingDisabled     : LogString := LogString + ' stopped polling ';
        fslMonitoringEnabled   : LogString := LogString + ' started monitoring ';
        fslMonitoringDisabled  : LogString := LogString + ' stopped monitoring ';
      end;
      LogString := LogString + 'at ' + DateTimeToStr(Now);
      WriteLn(HisFile, LogString);
      if (FComPort.TapiMode = tmOn) then
        LogString := '    using ' + FTapiDevice.SelectedDevice
      else
        LogString := '    using ' + ComName(FComPort.ComNumber);
    end;

    WriteLn(HisFile, LogString);
    CloseFile(HisFile);
    if IOResult <> 0 then ;
  end;
  FServerLogCode := fslNone;
end;

procedure TApdCustomFaxServer.FInternalFaxName(CP: TObject;
  var Name: TPassString);
  function GetFaxNameMD : string;
  var
    I, Y, M, D : Word;
    MM, DD : string[2];
    S, Num, FName : string;
  begin
    DecodeDate(SysUtils.Date, Y, M, D);
    Str(M:2, MM);
    Str(D:2, DD);
    FName := MM + DD;
    I := 0;
    repeat
      inc(I);
      if I >= 10000 then break;
      Str(I:4, Num);
      S := FName + Num + '.' + FFaxFileExt;
      while Pos(' ', S) > 0 do
        S[Pos(' ', S)] := '0';
    until not FileExists(AddBackslash(FDestinationDir) + S);           
    if I < 10000 then
      Result := AddBackslash(FDestinationDir) + S
    else
      Result := AddBackslash(FDestinationDir) + 'NONAME.APF';          
  end;
  function GetFaxNameCount : string;
  var
    I : DWORD;
    S, Num, FName : string;
  begin
    FName := 'FAX';
    I := 0;
    repeat
      inc(I);
      if I >= 100000 then break;
      Str(I:5, Num);
      S := FName + Num + '.' + FFaxFileExt;
      while Pos(' ', S) > 0 do
        S[Pos(' ', S)] := '0';
    until not FileExists(AddBackslash(FDestinationDir) + S);           
    if I < 10000 then
      Result := AddBackslash(FDestinationDir) + S
    else
      Result := AddBackslash(FDestinationDir) + 'NONAME.APF';
  end;
  
begin
  if Assigned(FFaxServerNameEvent) and (FFaxNameMode = fnNone) then
    FFaxServerNameEvent(Self, Name) else begin                         
      {Nothing assigned, use one of the built in methods}              
      case FFaxNameMode of                                             
        fnMonthDay :                                                   
          Name := GetFaxNameMD;                                        
        fnCount :                                                      
          Name := GetFaxNameCount;                                     
        else                                                           
          Name := AddBackslash(FDestinationDir) + 'NONAME.APF';;       
      end;                                                             
    end;                                                               
end;

procedure TApdCustomFaxServer.FInternalFaxStatus(CP: TObject; First,
  Last: Boolean);
var
  Status: Word;
  FaxMode: TFaxServerMode;
begin
  if CP = FSendFax then
    FaxMode := fsmSend
  else if CP = FRecvFax then
    FaxMode := fsmReceive
  else FaxMode := fsmIdle;
  if First then
    FFaxInProgress := True
  else if Last then
    FFaxInProgress := False;
  if Assigned(FStatusDisplay) then begin
    { update the status display to show info pertinenet to the fax }
    { job instead of the regular send/receive fax info }