Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Отключить клавиши при системном Hook'e

01.01.2007
{ 
 
** 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 **************}

Взято с сайта: https://www.swissdelphicenter.ch