Title: How to deactivate the (Windows) keys with a systemwide Hook
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 **************}