adfaxcvt.pas

测试用例

        StrPCopy(pDestFile, FOutFileName)));
    finally
      DestroyData;
      InputDocumentType := SaveType;
    end;
  end;

  procedure TApdCustomFaxConverter.OpenFile;
    {-Open the input file}
  var
    pFileName : array[0..255] of Char;

  begin
    if (InputDocumentType = idNone) then
      CheckException(Self, ecBadArgument);
    if FileOpen then
      CloseFile;

    FileOpen := True;
    CreateData;
    CheckException(Self, acOpenFile(Data, StrPCopy(pFileName, FDocumentFile)));
  end;

  procedure TApdCustomFaxConverter.CloseFile;
    {-Close the input file}
  begin
    if not FileOpen then
      Exit;

    acCloseFile(Data);
    FileOpen := False;
  end;

  procedure TApdCustomFaxConverter.GetRasterLine(var Buffer; var BufLen : Integer; var EndOfPage, MorePages : Boolean);
    {-Read a raster line from the input file}
  var
    TempEOP, TempMP : Bool;

  begin
    if not FileOpen then
      OpenFile;

    try
      CheckException(Self, acGetRasterLine(Data, Buffer, BufLen, TempEOP, TempMP));
    except
      FileOpen := False;
      raise;
    end;
    EndOfPage := TempEOP;
    MorePages := TempMP;
  end;

  procedure TApdCustomFaxConverter.CompressRasterLine(var Buffer, OutputData; var OutLen : Integer);
    {-Compress a line of raster data into a fax line}
  begin
    if not Assigned(Data) then
      CreateData;
    acCompressRasterLine(Data, Buffer);
    Move(Data^.DataLine^, OutputData, Data^.ByteOfs);
    OutLen := Data^.ByteOfs;
  end;

  procedure TApdCustomFaxConverter.MakeEndOfPage(var Buffer; var BufLen : Integer);
    {-Put an end of page code into buffer}
  begin
    if not Assigned(Data) then
      CreateData;
    acMakeEndOfPage(Data, Buffer, BufLen);
  end;

  procedure TApdCustomFaxConverter.Convert;
    {-Convert the input file, calling user event for output}
  var
    pFileName : array[0..255] of Char;

  begin
    if (InputDocumentType = idNone) or (InputDocumentType = idBitmap) then
      CheckException(Self, ecBadArgument);
    CreateData;
    CheckException(Self, acConvert(Data,
      StrPCopy(pFileName, FDocumentFile),
      OutputCallback));
  end;

  procedure TApdCustomFaxConverter.Status( const Starting, Ending : Boolean;
                                           const PagesConverted, LinesConverted : Integer;
                                           const BytesToRead, BytesRead : LongInt;
                                           var Abort : Boolean);
    {-Display conversion status}
  begin
    if Assigned(FStatus) then
      FStatus(Self, Starting, Ending, PagesConverted, LinesConverted, BytesToRead, BytesRead, Abort)
    else
      Abort := False;
  end;

  procedure TApdCustomFaxConverter.OutputLine(var Data; Len : Integer; EndOfPage, MorePages : Boolean);
    {-Output a compressed data line}
  begin
    if Assigned(FOutputLine) then
      FOutputLine(Self, PByteArray(@Data), Len, EndOfPage, MorePages);
  end;

  procedure TApdCustomFaxConverter.OpenUserFile(const FName : String);
    {-For opening documents of type idUser}
  begin
    if Assigned(FOpenUserFile) then
      FOpenUserFile(Self, FName);
  end;

  procedure TApdCustomFaxConverter.CloseUserFile;
    {-For closing documents of type idUser}
  begin
    if Assigned(FCloseUserFile) then
      FCloseUserFile(Self);
  end;

  procedure TApdCustomFaxConverter.ReadUserLine(var Data; var Len : Integer; var EndOfPage, MorePages : Boolean);
    {-For reading raster lines from documents of type idUser}
  begin
    if Assigned(FReadUserLine) then
      FReadUserLine(Self, PByteArray(@Data), Len, EndOfPage, MorePages)
    else begin
      EndOfPage := True;
      MorePages := False;
    end;
  end;

procedure TApdCustomFaxConverter.ConvertToHighRes(const FileName: string);
begin
  ConvertToResolution(FileName, frHigh);
end;

procedure TApdCustomFaxConverter.ConvertToLowRes(const FileName: string);
begin
  ConvertToResolution(FileName, frNormal);
end;

procedure TApdCustomFaxConverter.ConvertToResolution(const FileName: string;
  NewRes: TFaxResolution);
var
  Unpacker : TApdCustomFaxUnpacker;
  OldRes : TFaxResolution;
  BMP : TBitmap;
  PageNum : Integer;
  I : Integer;
  DestFile, SourceFile : TFileStream;
  DestHeader, SourceHeader : TFaxHeaderRec;
  FaxList : TStringList;
  Temp       : TPathCharArray;
  TempDir    : TPathCharArray;
begin
  { we'll take the APF, convert the pages to TBitmaps with the ApdFaxUnpacker,
    convert the bitmaps to standard-res APFs withe the ApdFaxConverter, then
    concatenate the individual APF pages with the ApdSendFax }
  OldRes := Resolution;
  Unpacker := nil;
  FaxList := nil;
  try
    Unpacker := TApdCustomFaxUnpacker.Create(nil);
    Unpacker.InFileName := FileName;
    Unpacker.Scaling:=True;
    Unpacker.HorizDiv := 1;
    Unpacker.HorizMult := 1;
    Unpacker.VertDiv := 2;
    Unpacker.VertMult := 1;

    Resolution := NewRes;

    { determine where we will put the temp files }
    GetTempPath(SizeOf(TempDir), TempDir);

    { extract the pages to individual APFs to preserve the page breaks }
    FaxList := TStringList.Create;
    FaxList.Clear;
    for PageNum := 1 to Unpacker.NumPages do begin
      BMP := Unpacker.UnpackPageToBitmap(PageNum);
      GetTempFileName(TempDir, '~APF', PageNum, Temp);
      OutFileName := StrPas(Temp);
      ConvertBitmapToFile(BMP);
      BMP.Free;
      FaxList.Add(OutFileName);
    end;

    { concatenate the temp files into the new one }
    { Create temp file }
    DestFile := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
    try
      { Open first source file }
      SourceFile := TFileStream.Create(FaxList[0], fmOpenRead or fmShareDenyWrite);
      try
        { Read header of the first APF }
        SourceFile.ReadBuffer(DestHeader, SizeOf(DestHeader));
        if (DestHeader.Signature <> DefAPFSig) then
          raise EFaxBadFormat.Create(ecFaxBadFormat, False);
        { Copy first source file to dest }
        DestFile.CopyFrom(SourceFile, 0);
        SourceFile.Free;
        SourceFile := nil;
        { Append remaining files in the list }
        for I := 1 to Pred(FaxList.Count) do begin
          SourceFile := TFileStream.Create(FaxList[I], fmOpenRead or fmShareDenyWrite);
          SourceFile.ReadBuffer(SourceHeader, SizeOf(SourceHeader));
          if (SourceHeader.Signature <> DefAPFSig) then
            raise EFaxBadFormat.Create(ecFaxBadFormat, False);
          DestFile.CopyFrom(SourceFile, SourceFile.Size - SizeOf(SourceHeader));
          DestHeader.PageCount := DestHeader.PageCount + SourceHeader.PageCount;
          SourceFile.Free;
          SourceFile := nil;
        end;
        DestFile.Position := 0;
        DestFile.WriteBuffer(DestHeader, SizeOf(DestHeader));
      finally
        SourceFile.Free;
      end;
    finally
      DestFile.Free;
    end;

    { we're done with the temp files, delete them }
    for PageNum := 0 to FaxList.Count - 1 do
      DeleteFile(FaxList[PageNum]);
  finally
    Unpacker.Free;
    FaxList.Free;
  end;
  Resolution := OldRes;
end;


{ Change the default printer if printto don't work, but}
{      print does work to convert to APF }
procedure TApdCustomFaxConverter.ChangeDefPrinter(UseFax: Boolean);      
const
  DefPrn : string = '';                                                  
var
  Device, Name, Port : array[0..255] of char;                            
  DevMode : THandle;                                                     
  N, Last : integer;                                                     
begin
  { Check to make sure default printer is not already changed }          
  with Printer do begin
    if UseFax then begin
    { find one of our printers }
     DefPrn := Printer.Printers[Printer.PrinterIndex];                   
     Last := Printer.Printers.Count - 1;
     for N := 0 to Last do begin
       Printer.PrinterIndex := N;
       Printer.GetPrinter(Device, Name, Port, Devmode);
       Printer.SetPrinter(Device, Name, Port, Devmode);
       if Device = 'APF Fax Printer' then begin
         { get the required info }                                       
         Printer.GetPrinter(Device, Name, Port, DevMode);                
         { concatenate the strings }                                     
         StrCat(Device, ',');                                            
         StrCat(Device, Name);                                           
         StrCat(Device, ',');                                            
         StrCat(Device, Port);                                           
         { write the string to the ini/registry }
         WriteProfileString( 'Windows', 'Device', Device );              
         StrCopy(Device, 'Windows' );                                    
         { tell everyone that we've changed the default }
         SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LongInt(@Device));
         { make the TPrinter use the device capabilities of the new default}
         SetPrinter(Device, Name, Port, 0);                              
       end;                                                              
     end;                                                                
    end else begin
      { revert back to the original }                                    
      N := Printer.Printers.IndexOf(DefPrn);
      Printer.PrinterIndex := N;
      Printer.GetPrinter(Device, Name, Port, DevMode);
      { concatenate the strings }                                        
      StrCat(Device, ',');                                               
      StrCat(Device, Name);
      StrCat(Device, ',');                                               
      StrCat(Device, Port);                                              
      { write the string to the ini/registry }                           
      WriteProfileString( 'Windows', 'Device', Device );
      StrCopy(Device, 'Windows' );
      { tell everyone that we've changed the default }
      SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LongInt(@Device));
    end;
  end;
end;

procedure TApdCustomFaxConverter.ConvertShell(const FileName: string);
  { print the selected document to the fax printer driver using ShellExecute }
var
  pFileName : array[0..255] of char;
  pPrinterName : array[0..255] of char;
  Res : Integer;
  Reg : TRegistry;
  Ini : TIniFile;
  ET : EventTimer;
  DefPrnChanged : Boolean;
  DummyBool : Boolean;
begin
  if IsWinNT then begin                                                  {!!.01}
    if Printer.Printers.IndexOf(ApdDef32PrinterName) = -1 then           {!!.01}
      raise Exception.Create('printer not installed');                   {!!.01}
  end else begin                                                         {!!.01}
    { Win9x TPrinter uses "printer name" + on + "printer port" }         {!!.01}
    if Printer.Printers.IndexOf(ApdDef16PrinterName + ' on ' +           {!!.01}
      ApdDefPrinterPort + ':') = -1 then                                 {!!.01}
      raise Exception.Create('printer not installed');                   {!!.01}
  end;                                                                   {!!.01}
  DefPrnChanged := False;
  try
    StrPCopy(pFileName, FileName);
    { write out shell info to the registry/ini file so the printer driver can }
    { get to it. Info is deleted from registry/ini by the printer driver }
    if IsWinNT then begin
      { NT/2K has a 32-bit printer driver, we'll use the registry }
      pPrinterName := '"' + ApdDef32PrinterName + '" " " "' +            {!!.02}
        ApdDefPrinterPort + '"';
      { add our shell keys to the registry }
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        Reg.OpenKey(ApdRegKey, True);
        Reg.WriteInteger('ShellHandle', PrnCallbackHandle);
        Reg.WriteString('ShellName', FOutFileName);
      finally
        Reg.CloseKey;
        Reg.Free;
      end;
    end else begin
      { Win9x/ME has a 16-bit printer driver, we'll use a ini file }
      pPrinterName := '"' + ApdDef16PrinterName + '" " " "' +            {!!.02}
        ApdDefPrinterPort + '"';
      { add our shell keys to our ini file }
      Ini := TIniFile.Create(ApdIniFileName);
      try
        Ini.WriteInteger(ApdIniSection, 'ShellHandle', PrnCallbackHandle);
        Ini.WriteString(ApdIniSection, 'ShellName', FOutFileName);
        {$IFDEF Delphi4}
        Ini.UpdateFile;
        {$ENDIF}
      finally
        Ini.Free;
      end;
    end;

    {Try 'printto', if error, change default printer}
    FWaitingForShell := True;
    FResetShellTimer := False;                                           {!!.01}
    FShellPageCount := 0;                                                {!!.01}
    Status(True, False, FShellPageCount, 0, 0, 0, DummyBool);            {!!.01}
    Res := ShellExecute(0, 'printto', pFileName, pPrinterName, '', SW_HIDE);
    if Res <= 32 then begin                                              {!!.01}
      ChangeDefPrinter(True);                                            {!!.01}
      DefPrnChanged := True;                                             {!!.01}
      Res := ShellExecute(0, 'print', pFileName, '', '',                 {!!.01}
        SW_SHOWMINNOACTIVE);                                             {!!.01}
    end;                                                                 {!!.01}
    { wait for the print job to complete }                               {!!.01}
    if Res > 32 then begin
      NewTimer(ET, afcDefPrintTimeout);
      repeat
        Res := SafeYield;                                                {!!.01}
        if FResetShellTimer then begin                                   {!!.01}
          NewTimer(ET, afcDefPrintTimeout);                              {!!.01}
          FResetShellTimer := False;                                     {!!.01}
        end;                                                             {!!.01}
      until not(FWaitingForShell) or (Res = wm_Quit) or TimerExpired(ET);
      if TimerExpired(ET) then
        raise ETimeout.Create(ecTimeout, False);                         {!!.01}
    end;                                                                 {!!.01}
  finally
    if DefPrnChanged then                                                {!!.01}