1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
|
library Winhook;
uses
Windows, Messages, SysUtils, dialogs, tlhelp32;
// Memory map file stuff
{
The CreateFileMapping function creates unnamed file-mapping
object for the specified file.
}
// Actual hook stuff
type
TPMsg = ^TMsg;
const
MMFName = 'MsgFilterHookDemo';
type
PMMFData = ^TMMFData;
TMMFData = record
NextHook: HHOOK;
WinHandle: HWND;
MsgToSend: Integer;
end;
// global variables, only valid in the process which installs
//the hook.
var
MMFHandle: THandle;
MMFData: PMMFData;
IDProc: Tprocessentry32;
//processid,processhandle: cardinal;
function CreateMMF(Name: string; Size: Integer): THandle;
begin
Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
Size, PChar(Name));
if Result <> 0 then
begin
if GetLastError = ERROR_ALREADY_EXISTS then
begin
CloseHandle(Result);
Result := 0;
end;
end;
end;
{ The OpenFileMapping function opens a named file-mapping object. }
function OpenMMF(Name: string): THandle;
begin
Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False,
PChar(Name));
// The return value is an open handle to the specified
//file-mapping object.
end;
{
The MapViewOfFile function maps a view of a file into
the address space of the calling process.
}
function MapMMF(MMFHandle: THandle): Pointer;
begin
Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;
{
The UnmapViewOfFile function unmaps a mapped view of a file
from the calling process's address space.
}
function UnMapMMF(P: Pointer): Boolean;
begin
Result := UnmapViewOfFile(P);
end;
function CloseMMF(MMFHandle: THandle): Boolean;
begin
Result := CloseHandle(MMFHandle);
end;
function UnMapAndCloseMMF: Boolean;
begin
Result := False;
if UnMapMMF(MMFData) then
begin
MMFData := nil;
if CloseMMF(MMFHandle) then
begin
MMFHandle := 0;
Result := True;
end;
end;
end;
//---------------------------------------------------------
//fonction de remplacement pour le traitement du message
function MsgFilterFunc(Code: Integer; MwParam: integer;
MlParam: integer): integer; stdcall;
var
MMFHandle: THandle;
MMFData: PMMFData;
begin
Result := 0;
MMFHandle := OpenMMF(MMFName);
if MMFHandle <> 0 then
begin
MMFData := MapMMF(MMFHandle);
if MMFData <> nil then
begin
if (Code < 0) or (MwParam = PM_NOREMOVE) then
Result := CallNextHookEx(MMFData.NextHook, Code, MwParam,
MlParam)
else
begin
if TPMsg(mlParam)^.message = WM_COMMAND then
showmessage(':WM_COMMAND:');
Result := CallNextHookEx(MMFData.NextHook, Code, MwParam,MlParam);
end;
UnMapMMF(MMFData);
end;
CloseMMF(MMFHandle);
end;
end;
//---------------------------------------------------------
//Trouve l'ID du processus du programme a surveiller
function IDHandle: cardinal;
var shothdl: Thandle;
begin
Result := 0;
IDProc.dwSize := sizeof(IDProc);
shothdl := createtoolhelp32snapshot(TH32CS_SNAPPROCESS, 0);
try
if shothdl=-1 then exit;
if process32first(shothdl,IDProc) then
begin
while process32next(shothdl,IDProc) do
begin
if ansisametext(IDProc.szExeFile,'progatester.exe') then
begin
result := IDProc.th32ProcessID;
showmessage('ok processus '+inttostr(result));
break;
end;
end;
end;
finally
begin
closehandle(shothdl);
showmessage('ok processus '+inttostr(result));
end;
end;
end;
//---------------------------------------------------------
//Mise en place du hook avec WH_CALLWNDPROC pour interception
//des messages WM_COMMAND
function SetHook(WinHandle: HWND; MsgToSend: Integer):
Boolean; stdcall;
begin
Result := False;
MMFHandle := 0;
MMFData := nil;
if (MMFData = nil) and (MMFHandle = 0) then
begin
MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));
if MMFHandle <> 0 then
begin
MMFData := MapMMF(MMFHandle);
if MMFData <> nil then
begin
MMFData.WinHandle := WinHandle;
MMFData.MsgToSend := MsgToSend;
MMFData.NextHook := SetWindowsHookEx(WH_CALLWNDPROC,
MsgFilterFunc, HInstance,IDHandle);
showmessage(inttostr(MMFData.NextHook));
if MMFData.NextHook = 0 then
UnMapAndCloseMMF
else
Result := True;
end
else
begin
CloseMMF(MMFHandle);
MMFHandle := 0;
end;
end;
end;
end;
//---------------------------------------------------------
//Suppression du hook
function FreeHook: Boolean; stdcall;
begin
Result := False;
if (MMFData <> nil) and (MMFHandle <> 0) then
if UnHookWindowsHookEx(MMFData^.NextHook) then
Result := UnMapAndCloseMMF;
end;
exports
SetHook ,
FreeHook ;
end. |
Partager