whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

24 Visitors Online


 
...deactivate the (Windows) keys with a systemwide Hook?
Autor: Thomas Stutz
[ Print tip ]  


Tip Rating (26):  
     




{
  ** 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; stdcallexport;
function FreeHook: Boolean; stdcallexport;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcallexport;

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 = niland (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 <> niland (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; stdcallexternal 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 **************}

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners