unit WHookInt;
interface
uses
Windows, Messages;
function SetHook(WinHandle: HWND; MsgToSend: integer): boolean;
stdcall;
export;
function FreeHook: boolean;
stdcall;
export;
function MsgFilterFunc(Code: integer; wParam, lParam: longint): longint
stdcall;
export;
implementation
// ************************ Memory map file stuff ******************************
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;
function OpenMMF(
Name:
string) : THandle;
begin
Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(
Name));
end;
function MapMMF(MMFHandle: THandle) : pointer;
begin
Result := MapViewOfFile(MMFHandle,FILE_MAP_ALL_ACCESS,0,0,0);
end;
function UnMapMMF(P: pointer) : boolean;
begin
Result := UnmapViewOfFile(P);
end;
function CloseMMF(MMFHandle: THandle) : boolean;
begin
Result := CloseHandle(MMFHandle);
end;
//*************************** Actual hook stuff *******************************
type
TPMsg = ^TMsg;
const
vk_D = $44;
vk_E = $45;
vk_F = $46;
vk_M = $4D;
vk_R = $52;
MMFName = '
winkeykiller';
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;
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;
function SetHook(WinHandle: HWND; MsgToSend: integer): boolean;
stdcall;
begin
Result := False;
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_GETMESSAGE, MsgFilterFunc, HInstance, 0);
if MMFData.NextHook = 0
then
UnMapAndCloseMMF
else
Result := True;
end
else
begin
CloseMMF(MMFHandle);
MMFHandle := 0;
end;
end;
end;
end;
function FreeHook: boolean;
stdcall;
begin
Result := False;
if (MMFData <>
nil)
and (MMFHandle <> 0)
then
if UnHookWindowsHookEx(MMFData^.NextHook)
then
Result := UnMapAndCloseMMF;
end;
{ See help on ==> GetMsgProc}
function MsgFilterFunc(Code: integer; wParam, lParam: longint): longint;
var
MMFHandle : THandle;
MMFData : PMMFData;
Kill : boolean;
begin
Result := 0;
MMFHandle := OpenMMF(MMFName);
if MMFHandle <> 0
then
begin
MMFData := MapMMF(MMFHandle);
if MMFData <>
nil then
begin
if (Code < 0)
or (wParam = PM_NOREMOVE)
then
Result := CallNextHookEx(MMFData.NextHook, Code, WParam, LParam)
else
begin
Kill := False;
case TPMsg(lParam)^.
message of
WM_SYSCOMMAND:
// The Win Start Key (or Ctrl+ESC)
if TPMsg(lParam)^.wParam = SC_TASKLIST
then Kill := True;
WM_HOTKEY:
case ((TPMsg(lParam)^.lParam
and $00FF0000)
shr 16)
of
vk_D,
// Win+D ==> Desktop
vk_E,
// Win+E ==> Explorer
vk_F,
// Win+F+(Ctrl) ==> Find:All (and Find: Computer)
vk_M,
// Win+M ==> Minimize
vk_R,
// Win+R ==> Run program.
vk_F1,
// Win+F1 ==> Windows Help
vk_PAUSE:
// Win+Pause ==> Windows system properties
Kill := True;
end;
end;
if Kill
then TPMsg(lParam)^.
message := WM_NULL;
Result := CallNextHookEx(MMFData.NextHook, Code, WParam, LParam)
end;
UnMapMMF(MMFData);
end;
CloseMMF(MMFHandle);
end;
end;
initialization
begin
MMFHandle := 0;
MMFData :=
nil;
end;
finalization
FreeHook;
end.