PrintToFile, Version 1.3c (alt)

Hinweis: dies ist nicht die neueste Version!

Zurück zur Übersicht

Datei: PrintToFile.pas

{
  PrintToFile.pas

  Delphi unit giving the ability to directly specify the filename for printing
  when the "Print to file" option is checked, bypassing the query where to save
  the file. See the included README.txt for more information and how to use it.

  Version 1.3 - Always find the most current version at
  http://flocke.vssd.de/prog/code/pascal/prt2file/

  Copyright (C) 2005, 2006 Volker Siebert <flocke@vssd.de>
  All rights reserved.

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.
}

unit PrintToFile;

interface

{$IFDEF VER130}
const
{$ELSE}
var
{$ENDIF}
  // Set this variable to the output filename before you start printing.
  // It will be reset to empty each time it has been used.
  PrintToThisFile: string = '';

function Patch_TPrinter_BeginDoc: boolean;
function Patch_StartDoc_ImportTable: boolean;
function Patch_StartDoc_DLL_Entry: boolean;

function SendFileToPrinter(const Filename: string; const Docname: string = ''): boolean;

implementation

uses
  Windows, WinSpool, SysUtils, Printers, CodeLen, GenCodeHook;

type
  TfnStartDoc = function(DC: HDC; const p2: TDocInfo): Integer; stdcall;

var
  PrintToFilePossible: boolean = false;
  fnStartDoc: TfnStartDoc = nil;

{ Our replacement for the Windows StartDoc function.
  - If "PrintToThisFile" is not empty, redirect the output to this file by
    setting the "lpszOutput" member of the TDocInfo structure.
  - Otherwise, the call is just passed on to "Windows.StartDoc".
}
function MyStartDoc(DC: HDC; const p2: TDocInfo): Integer; stdcall;
var
  p2new: TDocInfo;
begin
  if PrintToThisFile <> '' then
  begin
    p2new := p2;
    p2new.lpszOutput := PChar(PrintToThisFile);
    Result := fnStartDoc(DC, p2new);
    PrintToThisFile := '';
  end
  else
    Result := fnStartDoc(DC, p2);
end;

{ Read the relative address at "Where"
}
function GetDisplacement(Where: pointer): pointer;
begin
  Result := pointer(integer(Where) + 4 + PInteger(Where)^);
end;

{ Calculate the relative displacement between "Source" and "Target"
}
function CalcDisplacement(Source, Target: pointer): integer;
begin
  Result := integer(Target) - (integer(Source) + 4);
end;

{ This function steps through the code of Printer.BeginDoc and tries to find
  the call to Windows.StartDoc. The found location is then patched to point
  to our replacement function above. An exception is raised when the hook
  can not be established.
}
function Patch_TPrinter_BeginDoc: boolean;
var
  Code: pointer;
  Size, Len: integer;
begin
  Result := PrintToFilePossible;
  if PrintToFilePossible then
    exit;

  fnStartDoc := GetProcAddress(GetModuleHandle('user32.dll'), 'StartDocA');
  if not Assigned(fnStartDoc) then
    exit;

  Code := @TPrinter.BeginDoc;
  Size := 1024;

  while true do
  begin
    if IsReturnInstruction(Code, Size) then
      break;

    Len := GetCpuInstructionLength(Code, Size);
    if Len < 1 then
      break;

    if Len = 5 then
      // $E8 is the opcode of a direct call instruction
      if PByte(Code)^ = $E8 then
      begin
        inc(integer(Code));
        dec(Size);
        dec(Len);

        if GetDisplacement(Code) = @Windows.StartDoc then
        begin
          Len := CalcDisplacement(Code, @MyStartDoc);
          if PatchMemory(Code, Len, 4) then
            PrintToFilePossible := true;

          break;
        end;
      end;

    inc(integer(Code), Len);
    dec(Size, Len);
  end;

  Result := PrintToFilePossible;
end;

{ This function patches the entry of Windows.StartDoc in the import table
  and thus goes a step farther than the function above. It can be used with
  *ANY* printing component you link to your project, not just those using
  TPrinter.
}
function Patch_StartDoc_ImportTable: boolean;
var
  Code: pointer;
  Target: integer;
begin
  Result := PrintToFilePossible;
  if PrintToFilePossible then
    exit;

  Code := @Windows.StartDoc;

  // FF 25 mm mm mm mm = JMP [mem32]
  if (PByte(Code)^ = $FF) and (PByte(integer(Code) + 1)^ = $25) then
  begin
    inc(integer(Code), 2);
    Code := Pointer(PInteger(Code)^);

    fnStartDoc := TfnStartDoc(PInteger(Code)^);
    Target := integer(@MyStartDoc);
    PrintToFilePossible := PatchMemory(Code, Target, 4);
  end
  // E9 dd dd dd dd = JMP disp32
  else if PByte(Code)^ = $E9 then
  begin
    inc(integer(Code));

    fnStartDoc := GetDisplacement(Code);
    Target := CalcDisplacement(Code, @MyStartDoc);
    PrintToFilePossible := PatchMemory(Code, Target, 4);
  end;

  Result := PrintToFilePossible;
end;

{ This function patches the API entry point of Windows.StartDoc directly
  in the DLL code, thus going one more step farther than the two functions
  above. This can be used with *ANY* print component or DLL you use, even
  if it uses GetProcAddress to obtain the entry point.
}
function Patch_StartDoc_DLL_Entry: boolean;
var
  Code: pointer;
begin
  Result := PrintToFilePossible;
  if PrintToFilePossible then
    exit;

  try
    Code := GetProcAddress(GetModuleHandle('gdi32.dll'), 'StartDocA');
    if Code = nil then
      exit;

    CreateGenericCodeHook(Code, @MyStartDoc, @fnStartDoc);
    PrintToFilePossible := true;
  except
  end;

  Result := PrintToFilePossible;
end;

{ This function returns the device name of the currently selected printer
  (Delphi's "Printer" object).
}
function GetPrinterDeviceName: string;
var
  szDevice, szDriver, szPort: array [0 .. 1023] of char;
  hDevMode: THandle;
begin
  Printer.GetPrinter(szDevice, szDriver, szPort, hDevMode);
  Result := StrPas(szDevice);
end;

{ This function sends the given file to the currently selected printer
  (Delphi's "Printer" object).
}
function SendFileToPrinter(const Filename: string; const Docname: string = ''): boolean;
var
  hPrinter, hFile: THandle;
  Info: TDocInfo1;
  Buffer: array [0 .. 4095] of char;
  NumBytes: cardinal;
begin
  Result := false;

  if not OpenPrinter(PChar(GetPrinterDeviceName), hPrinter, nil) then
    exit;

  try
    if Docname <> '' then
      Info.pDocName := PChar(Docname)
    else
      Info.pDocName := PChar(Filename);
    Info.pOutputFile := nil;
    Info.pDatatype := nil;
    if StartDocPrinter(hPrinter, 1, @Info) = 0 then
    begin
      RaiseLastOsError;
      exit;
    end;

    try
      if not StartPagePrinter(hPrinter) then
        exit;

      try
        hFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil,
                   OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
        if hFile = INVALID_HANDLE_VALUE then
          exit;

        try
          repeat
            if not ReadFile(hFile, Buffer, SizeOf(Buffer), NumBytes, nil) then
              exit;

            if NumBytes > 0 then
              if not WritePrinter(hPrinter, @Buffer[0], NumBytes, NumBytes) then
                exit;
          until NumBytes = 0;

          Result := true;
        finally
          CloseHandle(hFile);
        end;
      finally
        EndPagePrinter(hPrinter);
      end;
    finally
      EndDocPrinter(hPrinter);
    end;
  finally
    ClosePrinter(hPrinter);
  end;
end;

end.
Flocke's Garage
Valid HTML 4.01 Transitional Valid CSS!
(C) 2005-2018 Volker Siebert.
Creative Commons-LizenzvertragDer gesamte Inhalt dieser Webseite steht unter einer Creative Commons-Lizenz (sofern nicht anders angegeben).