{
 ** 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 CallHookEx() 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
  Hook: 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.Hook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);
  if MMFData.Hook = 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^.Hook) 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 CallHookEx function passes the hook information to the
  next hook procedure in the current hook chain.
  }
  Result := CallHookEx(MMFData.Hook, 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 := CallHookEx(MMFData.Hook, 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 **************}