{
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('gdi32.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. |