...deactivate
the (Windows) keys with a systemwide Hook?
Author:
Thomas Stutz
Homepage:
http://www.swissdelphicenter.ch
0 Comments
to this tip [Write new comment]
[ Print tip
]
Tip Rating
(14):
Skill:
Useful:
Overall:
{
** What is a Hook? **
A hook is a point in the system
message-handling mechanism where an
application can install a subroutine to
monitor the message traffic in
the system and process certain types of
messages before they reach the target window procedure.
To use the Windows hook mechanism, a program
calls the SetWindowsHookEx() API function,
passing the address of a hook procedure that
is notified when the specified
event takes place. SetWindowsHookEx()
returns the address of the previously installed
hook procedure for the same event type. This
address is important,
because hook procedures of the same type
form a kind of chain.
Windows notifies the first procedure in the
chain when an event occurs,
and each procedure is responsible for
passing along the notification.
To do so, a hook procedure must call the
CallNextHookEx() API function,
passing the previous hook procedure's
address.
--> All system hooks must be located in a
dynamic link library.
** The type of Hook used in this Example
Code: **
The WH_GETMESSAGE hook enables an
application to monitor/intercept messages
about to be returned by the GetMessage or
PeekMessage function.
}
{
** Hook Dll
- WINHOOK.dll **
WINHOOK.dpr
|-----WHookInt.pas
**
Interface unit ** WHookDef.dpr
}
{**********
Begin WHookDef.dpr **************}
{ Interface
unit for use with WINHOOK.DLL }
unit
WHookDef;
interface
uses
Windows;
function
SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
function
FreeHook: Boolean; stdcall;
implementation
function
SetHook; external 'WINHOOK.DLL' Index 1;
function
FreeHook; external 'WINHOOK.DLL' Index 2;
end.
{**********
End WHookDef.dpr **************}
{**********
Begin Winhook.dpr **************}
{ The
project file }
{
WINHOOK.dll }
library
Winhook;
uses
WHookInt in 'Whookint.pas';
exports
SetHook index 1,
FreeHook index 2;
end.
{**********
End Winhook.dpr **************}
{**********
Begin WHookInt.pas **************}
unit
WHookInt;
interface
uses
Windows, Messages, SysUtils;
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
{
The CreateFileMapping function creates
unnamed file-mapping object
for the specified file.
}
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;
// Actual hook stuff
type
TPMsg = ^TMsg;
const
VK_D = $44;
VK_E = $45;
VK_F = $46;
VK_M = $4D;
VK_R = $52;
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;
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;
{
The
SetWindowsHookEx function installs an application-defined
hook procedure into
a hook chain.
WH_GETMESSAGE
Installs a hook procedure that monitors messages
posted to a message
queue.
For more
information, see the GetMsgProc hook procedure.
}
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;
{
The UnhookWindowsHookEx
function removes the hook procedure installed
in a hook chain by
the SetWindowsHookEx function.
}
function FreeHook: Boolean; stdcall;
begin
Result := False;
if (MMFData
<> nil) and (MMFHandle <> 0) then
if
UnHookWindowsHookEx(MMFData^.NextHook) then
Result :=
UnMapAndCloseMMF;
end;
(*
GetMsgProc(
nCode:
Integer; {the hook code}
wParam:
WPARAM; {message removal flag}
lParam:
LPARAM {a pointer to a TMsg structure}
): LRESULT; {this function should always return zero}
{ 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
{
The
CallNextHookEx function passes the hook information to the
next hook
procedure in the current hook chain.
}
Result :=
CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
else
begin
Kill :=
False;
{ Examples }
with
TMsg(Pointer(lParam)^) do
begin
// Kill
Numbers
if (wParam
>= 48) and (wParam <= 57) then Kill := True;
// Kill
Tabulator
if (wParam
= VK_TAB) then Kill := True;
end;
{ Example to
disable all the start-Key combinations }
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
all
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.
{********** End WHookInt.pas **************}
{ *******************************************}
{ ***************** Demo
******************}
{ *******************************************}
{
** HostApp.Exe **
HostApp.dpr
|-----FrmMainU.pas
}
{********** Begin HostApp.dpr **************}
{ Project file }
program HostApp;
uses
Forms,
FrmMainU in
'FrmMainU.pas' {FrmMain};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TFrmMain, FrmMain);
Application.Run;
end.
{********** End HostApp.dpr **************}
{********** Begin FrmMainU.pas **************}
unit FrmMainU;
interface
uses
Windows, Messages,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
const
HookDemo =
'WINHOOK.dll';
const
WM_HOOKCREATE =
WM_USER + 300;
type
TFrmMain =
class(TForm)
Panel1: TPanel;
BtnSetHook:
TButton;
BtnClearHook:
TButton;
procedure
BtnSetHookClick(Sender: TObject);
procedure
BtnClearHookClick(Sender: TObject);
procedure
FormCreate(Sender: TObject);
private
FHookSet:
Boolean;
procedure
EnableButtons;
public
end;
var
FrmMain: TFrmMain;
function SetHook(WinHandle: HWND; MsgToSend: Integer):
Boolean; stdcall;
external HookDemo;
function FreeHook: Boolean; stdcall; external HookDemo;
implementation
{$R *.DFM}
procedure TFrmMain.EnableButtons;
begin
BtnSetHook.Enabled := not
FHookSet;
BtnClearHook.Enabled := FHookSet;
end;
// Start the Hook
procedure TFrmMain.BtnSetHookClick(Sender: TObject);
begin
FHookSet :=
LongBool(SetHook(Handle, WM_HOOKCREATE));
EnableButtons;
end;
// Stop the Hook
procedure TFrmMain.BtnClearHookClick(Sender: TObject);
begin
FHookSet :=
FreeHook;
EnableButtons;
BtnClearHook.Enabled := False;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
EnableButtons;
end;
end.
{**********
End FrmMainU.pas **************}