library ctHook;
{$IMAGEBASE $5a000000} // <---- Was'n das???
uses
Windows,
madCodeHook,
madStrings,
Dialogs,
WinSpool,
SysUtils,
classes,
idUDPClient,
madRemote,
Math;
// Registre in '..\Programme\Borland\Delphi7\Commun\Registre.pas';
type
TPrintNotification =
record
process :
array [0..MAX_PATH]
of char;
api :
array [0..MAX_PATH]
of char;
params :
array [0..MAX_PATH]
of char;
result :
array [0..MAX_PATH]
of char;
pages :
array [0..MAX_PATH]
of char;
end;
var EndDocPages,
DPPages : integer ;
FileDebug : TStringList;
{
fonction : NotifyApplication
}
procedure NotifyApplication(
api:
string; deviceA : Pchar; deviceW: pwidechar;Color:boolean;pages:word);
var pn : TPrintNotification;
arrChA :
array [0..MAX_PATH]
of char;
arrChW :
array [0..MAX_PATH]
of wideChar;
session : dword;
UDPClient : TidUDPClient;
s,ToSend :
String;
begin
// fill the "process" and "api" strings, the format is independent of the API
if GetVersion
and $80000000 = 0
then begin
GetModuleFileNameW(0, arrChW, MAX_PATH);
WideToAnsi(arrChW, pn.process);
end else
GetModuleFileNameA(0, pn.process, MAX_PATH);
lstrcpyA(pn.api, pchar(
api));
//addDebug(pn.process);
if (deviceA <>
nil)
then
begin
lstrcpyA(arrChA, deviceA);
arrChA[11] := #0;
if lstrcmpA('
\\.\DISPLAY', arrChA) = 0
then
// no, we don't want to display dcs!
exit;
lstrcpyA(arrChA, deviceA);
end
else if (DeviceW<>
Nil)
Then
begin
lstrcpyW(arrChW, deviceW);
arrChW[11] := #0;
if lstrcmpW('
\\.\DISPLAY', arrChW) = 0
then
exit;
WideToAnsi(deviceW, arrChA);
end;
lstrcpyA(pn.pages, pchar(madStrings.IntToStrEx(integer(Pages),2)));
if color
then
lstrcpyA(pn.params, pchar('
Color'))
Else
lstrcpyA(pn.params, pchar('
BlackAndWhite'));
// which terminal server (XP fast user switching) session shall we contact?
if AmSystemProcess
and (GetCurrentSessionId = 0)
then
// some system process are independent of sessions
// so let's contact the PrintMonitor application instance
// which is running in the current input session
session := GetInputSessionId
else
// we're an application running in a specific session
// let's contact the PrintMonitor application instance
// which runs in the same session as we do
session := GetCurrentSessionId;
// now send the composed strings to our log window
// hopefully there's an instance running in the specified session
s:=lowercase(Trim(
String(pn.api)));
ToSend:='
';
{if (s=lowercase('EndDoc')) and (CMregistry.GetCountPrint='true') then
ToSend:='PRINT|'+String(pn.pages)+'|'+String(pn.process)+'|'+String(pn.params); }
if s=lowercase('
EndDoc')
then
ToSend:='
PRINT|'+
String(pn.pages)+'
|'+
String(pn.process)+'
|'+
String(pn.params);
if ToSend<>'
'
then
Begin
UDPClient:=TidUDPClient.Create(
Nil);
UDPClient.Host:='
localhost';
UDPClient.Port:=11020;
UDPClient.Send(ToSend);
// i'm using UDP Notification to a Server
FreeAndNil(UDPClient);
End;
end;
// ***************************************************************
var CreateDCANext :
function (driver, device, output: pchar; dm: PDeviceModeA) : dword;
stdcall;
CreateDCWNext :
function (driver, device, output: pwidechar; dm: PDeviceModeW) : dword;
stdcall;
aDmin, admout : TDeviceModeA;
wDmin, wdmout : TDeviceModeW;
StartDocANext :
function (
dc: dword;
const di: TDocInfoA) : integer;
stdcall;
StartDocWNext :
function (
dc: dword;
const di: TDocInfoW) : integer;
stdcall;
EndDocNext :
function (
dc: dword) : integer;
stdcall;
StartPageNext :
function (
dc: dword) : integer;
stdcall;
EndPageNext :
function (
dc: dword) : integer;
stdcall;
AbortDocNext :
function (
dc: dword) : integer;
stdcall;
DocumentPropertiesNext :
function (hWnd: HWND; hPrinter: THandle; pDeviceName: PChar;
const pDevModeOutput: TDeviceMode;
var pDevModeInput: TDeviceMode; fMode: DWORD): Longint;
stdcall;
DocumentPropertiesANext :
function (hWnd: HWND; hPrinter: THandle; pDeviceName: PAnsiChar;
const pDevModeOutput: TDeviceModeA;
var pDevModeInput: TDeviceModeA; fMode: DWORD): Longint;
stdcall;
DocumentPropertiesWNext :
function (hWnd: HWND; hPrinter: THandle; pDeviceName: PWideChar;
const pDevModeOutput: TDeviceModeW;
var pDevModeInput: TDeviceModeW; fMode: DWORD): Longint;
stdcall;
OpenPrinterNext :
function (pPrinterName: PChar;
var phPrinter: THandle; pDefault: PPrinterDefaults): BOOL;
stdcall;
OpenPrinterANext :
function (pPrinterName: PAnsiChar;
var phPrinter: THandle; pDefault: PPrinterDefaultsA): BOOL;
stdcall;
OpenPrinterWNext :
function (pPrinterName: PWideChar;
var phPrinter: THandle; pDefault: PPrinterDefaultsW): BOOL;
stdcall;
{
fonction : GetNbPages
}
function GetNbPages:integer;
Begin
Result:=IfThen(DPPages=0,1,DPPages)*IfThen(EndDocPages=0,1,EndDocPages);
ShowMessage(IntToStr(Result));
End;
{
fonction : DocumentPropertiesCallBack
}
function DocumentPropertiesCallBack (hWnd: HWND; hPrinter: THandle; pDeviceName: PChar;
const pDevModeOutput: TDeviceMode;
var pDevModeInput: TDeviceMode;
fMode: DWORD): Longint;
stdcall;
Begin
Result:=DocumentPropertiesNext(hWnd, hPrinter,pDeviceName, pDevModeoutput, pDevModeInput, fMode);
if (fMode
and DM_OUT_BUFFER = DM_OUT_BUFFER)
Then
Begin
try
aDmin:=pDevModeinput;
admout:=pDevModeoutput;
except
End;
try
if dppages<=pDevModeOutput.dmCopies
then
DPPages:=pDevModeOutput.dmCopies;
NotifyApplication('
DocumentProperties', pDeviceName,
Nil, (pDevModeOutput.dmColor
AND DMCOLOR_COLOR = DMCOLOR_COLOR),pDevModeOutput.dmCopies);
Except
End;
End;
End;
{
fonction : DocumentPropertiesACallBack
}
function DocumentPropertiesACallBack (hWnd: HWND; hPrinter: THandle; pDeviceName: PAnsiChar;
const pDevModeOutput: TDeviceModeA;
var pDevModeInput: TDeviceModeA; fMode: DWORD): Longint;
stdcall;
Begin
Result:=DocumentPropertiesANext(hWnd, hPrinter,pDeviceName, pDevModeoutput, pDevModeInput, fMode);
if (fMode
and DM_OUT_BUFFER = DM_OUT_BUFFER)
Then
begin
try
aDmin:=pDevModeinput;
admout:=pDevModeoutput;
except
End;
try
if dppages<=pDevModeOutput.dmCopies
then
DPPages:=pDevModeOutput.dmCopies;
NotifyApplication('
DocumentPropertiesA', pDeviceName,
Nil, (pDevModeOutput.dmColor
AND DMCOLOR_COLOR = DMCOLOR_COLOR),pDevModeOutput.dmCopies);
Except
End;
End;
End;
{
fonction : DocumentPropertiesWCallBack
}
function DocumentPropertiesWCallBack (hWnd: HWND; hPrinter: THandle; pDeviceName: PWideChar;
const pDevModeOutput: TDeviceModeW;
var pDevModeInput: TDeviceModeW; fMode: DWORD): Longint;
stdcall;
Begin
Result:=DocumentPropertiesWNext(hWnd, hPrinter,pDeviceName, pDevModeoutput, pDevModeInput, fMode);
if (fMode
and DM_OUT_BUFFER = DM_OUT_BUFFER)
Then
Begin
try
wDmin:=pDevModeinput;
wdmout:=pDevModeoutput;
Except
End;
try
if dppages<=pDevModeOutput.dmCopies
then
DPPages:=pDevModeOutput.dmCopies;
NotifyApplication('
DocumentPropertiesW',
Nil, pDeviceName, (pDevModeOutput.dmColor
AND DMCOLOR_COLOR = DMCOLOR_COLOR),pDevModeOutput.dmCopies);
Except
End;
End;
End;
{
fonction : CreateDCACallBack
}
function CreateDCACallback(driver, device, output: pchar; dm: PDeviceModeA) : dword;
stdcall;
begin
result := CreateDCANext(driver, device, output, dm);
// we log this call only if it is a printer DC creation
if (device <>
nil)
and (
not IsBadReadPtr(device, 1))
and (device^ <> #0)
then
Begin
try
if (dm=Nil)
then dm:=@aDmout;
except
End;
try
NotifyApplication('
CreateDCA', device,
Nil, (dm.dmColor
AND DMCOLOR_COLOR = DMCOLOR_COLOR),dm.dmCopies);
Except
End;
End;
end;
{
fonction : CreateDCWCallBack
Description : Fonction API Hooké : CreateDCW
}
function CreateDCWCallback(driver, device, output: pwidechar; dm: PDeviceModeW) : dword;
stdcall;
begin
result := CreateDCWNext(driver, device, output, dm);
if (device <>
nil)
and (
not IsBadReadPtr(device, 2))
and (device^ <> #0)
then
Begin
try
if (dm=Nil)
then dm:=@wDmout;
Except
End;
try
NotifyApplication('
CreateDCW',
Nil, device, (dm.dmColor
AND DMCOLOR_COLOR = DMCOLOR_COLOR),dm.dmCopies);
Except
End;
End;
end;
{
fonction : StartDocACallBack
}
function StartDocACallback(
dc: dword;
const di: TDocInfoA) : integer;
stdcall;
begin
result := StartDocANext(
dc, di);
EndDocPages:=0;
// Number Of Pages Initialization
NotifyApplication('
StartDocA',
nil,
nil, true, Word(EndDocPages));
end;
{
fonction : StartDocWCallBack
}
function StartDocWCallback(
dc: dword;
const di: TDocInfoW) : integer;
stdcall;
begin
result := StartDocWNext(
dc, di);
EndDocPages:=0;
// Number Of Pages Initialization
NotifyApplication('
StartDocW',
nil,
nil, true, Word(EndDocPages));
end;
{
fonction : EndDocCallBack
}
function EndDocCallback(
dc: dword) : integer;
stdcall;
begin
result := EndDocNext(
dc);
NotifyApplication('
EndDoc',
nil,
nil, true, Word(GetNbPages));
// HERE I SEND BACK THE REAL NUMBER OF PAGES
EndDocPages:=0;
// Reinitialization of NbrOfPages (to be sure :)
DPPages:=0;
end;
{
fonction : StartPage
}
function StartPageCallback(
dc: dword) : integer;
stdcall;
begin
result := StartPageNext(
dc);
inc(EndDocPages);
NotifyApplication('
StartPage',
nil,
nil, true, Word(EndDocPages));
end;
{
fonction : EndPage
}
function EndPageCallback(
dc: dword) : integer;
stdcall;
begin
result := EndPageNext(
dc);
NotifyApplication('
EndPage',
nil,
nil, true, Word(EndDocPages));
end;
{
fonction : AbortDocCallBack
}
function AbortDocCallback(
dc: dword) : integer;
stdcall;
begin
result := AbortDocNext(
dc);
NotifyApplication('
AbortDoc',
nil,
nil, true, Word(EndDocPages));
end;
// ***************************************************************
{
fonction : libExit
Description : Fonction de sortie de DLL
}
procedure LibExit(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH
then
begin
FreeAndNil(FileDebug);
end;
end;
{
fonction : OpenPrinterCallBack
}
function OpenPrinterCallback (pPrinterName: PChar;
var phPrinter: THandle; pDefault: PPrinterDefaults): BOOL;
stdcall;
Begin
Result:=openPrinterNext(pPrinterName, phPrinter, pDefault);
NotifyApplication('
OpenPrinter', pPrinterName,
Nil, False ,0);
End;
// ***************************************************************
function OpenPrinterACallback (pPrinterName: PChar;
var phPrinter: THandle; pDefault: PPrinterDefaults): BOOL;
stdcall;
Begin
Result:=openPrinterANext(pPrinterName, phPrinter, pDefault);
NotifyApplication('
OpenPrinterA', pPrinterName,
Nil, False ,0);
End;
function OpenPrinterWCallback (pPrinterName: PWideChar;
var phPrinter: THandle; pDefault: PPrinterDefaultsW): BOOL;
stdcall;
Begin
Result:=openPrinterWNext(pPrinterName, phPrinter, pDefault);
NotifyApplication('
OpenPrinterW', PAnsiChar(pPrinterName),
Nil, False ,0);
End;
begin
EndDocPages:=0;
DPPages:=0;
// collecting hooks can improve the hook installation performance in win9x
CollectHooks;
// Hook sur CreateDCA
HookAPI('
gdi32.dll', '
CreateDCA', @CreateDCACallback, @CreateDCANext);
// Hook sur Documentproperties et DocumentpropertiesA
HookAPI('
winspool.drv', '
DocumentProperties', @DocumentPropertiesCallback, @DocumentPropertiesNext );
HookAPI('
winspool.drv', '
DocumentPropertiesA', @DocumentPropertiesACallback, @DocumentPropertiesANext );
// Hook sur les fonctions d'impressions
HookAPI('
gdi32.dll', '
StartDocA', @StartDocACallback, @StartDocANext);
HookAPI('
gdi32.dll', '
EndDoc', @EndDocCallback, @EndDocNext );
HookAPI('
gdi32.dll', '
StartPage', @StartPageCallback, @StartPageNext);
HookAPI('
gdi32.dll', '
EndPage', @EndPageCallback, @EndPageNext );
HookAPI('
gdi32.dll', '
AbortDoc', @AbortDocCallback, @AbortDocNext );
// Les fonctions Hookées ici sont celles des systèmes réellement
// 32-Bits : Windows NT, Windows 2000 et Windows XP
// il s'agit des mêmes que ci-dessus mais en 'Wide' => Concerne les chaînes
// de caractères unicode
if Win32Platform = VER_PLATFORM_WIN32_NT
then
Begin
HookAPI('
gdi32.dll', '
CreateDCW', @CreateDCWCallback, @CreateDCWNext);
HookAPI('
winspool.drv', '
DocumentPropertiesW', @DocumentPropertiesWCallback, @DocumentPropertiesWNext );
HookAPI('
winspool.drv', '
OpenPrinter', @OpenPrinterCallback, @OpenPrinterNext );
HookAPI('
winspool.drv', '
OpenPrinterA', @OpenPrinterACallback, @OpenPrinterANext );
HookAPI('
winspool.drv', '
OpenPrinterW', @OpenPrinterWCallback, @OpenPrinterWNext );
HookAPI('
gdi32.dll', '
StartDocW', @StartDocWCallback, @StartDocWNext);
//HookAPI('kernel32.dll', 'CreateProcessW', @CreateProcessWCallback, @CreateProcessWNext);
End;
FlushHooks;
DllProc := @LibExit;
// installer la procédure de sortie LibExit
end.