DelphiFAQ Home Search:
General :: Windows :: Programming :: Windows with Delphi :: Windows API
Windows programming with Delphi

Articles:

This list is sorted by recent document popularity (not total page views).
New documents will first appear at the bottom.

Only the 40 most recently viewed articles are shown.
You can see the full list here.

Featured Article

How can I create a system wide keyboard hook under Win32?

I found the following code posted in a newsgroup. Since it is asked frequently, I add it here.
Comments:

The following example demonstrates creating a system wide windows hook under Win32. The example provides both the code for the system hook dll and an example application. The hook function that we will create will also demonstrate advanced coding techniques such as sharing global memory across process boundaries using memory mapped files, sending messages from the key hook function back to the originating application, and dynamic loading of a dll at runtime.

The example keyboard hook that we create will keep a count of the number of keystrokes a user enters on the keyboard. Further, we will demonstrate trapping the enter key, and passing a message back to the application that initiated the keyboard hook each time the enter key is pressed. Finally, we will demonstrate trapping the left arrow key and instead of letting it through to the current application, we will instead replace it with a right arrow keystroke. (Note: that this can
cause much confusion to a unsuspecting user).

Library TheHook;
 
 uses
   Windows, Messages, SysUtils;
 
 {Define a record for recording and passing information process wide}
 type
   PHookRec = ^ THookRec;
   THookRec = Packed Record
     TheHookHandle: HHOOK;
     TheAppWinHandle: HWnd;
     TheCtrlWinHandle: HWnd;
     TheKeyCount: DWord;
   end;
 
 var
   hObjHandle : THandle; {Variable for the file mapping object}
   lpHookRec  : PHookRec;
 {Pointer to our hook record}
 procedure MapFileMemory (dwAllocSize: DWord);
 begin { MapFileMemory }
   {Create a process wide memory mapped variable}
   hObjHandle := CreateFileMapping ($FFFFFFFF, Nil, PAGE_READWRITE, 0,
     dwAllocSize, 'HookRecMemBlock');
   if (hObjHandle = 0) then
     begin
       MessageBox (0, 'Hook DLL', 'Could not create file map object', mb_Ok);
       exit
     end { (hObjHandle = 0) };
   {Get a pointer to our process wide memory mapped variable}
   lpHookRec := MapViewOfFile (hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
   if (lpHookRec = Nil) then
     begin
       CloseHandle (hObjHandle);
       MessageBox (0, 'Hook DLL', 'Could not map file', mb_Ok);
       exit
     end { (lpHookRec = Nil) }
 end; { MapFileMemory }
 
 
 procedure UnMapFileMemory;
 begin { UnMapFileMemory }
   {Delete our process wide memory mapped variable}
   if (lpHookRec <> Nil) then
     begin
       UnMapViewOfFile (lpHookRec);
       lpHookRec := Nil
     end { (lpHookRec <> Nil) };
   if (hObjHandle > 0) then
     begin
       CloseHandle (hObjHandle);
       hObjHandle := 0
     end { (hObjHandle > 0) }
 end; { UnMapFileMemory }
 
 
 function GetHookRecPointer : pointer
   stdcall;
 begin { GetHookRecPointer }
   {Return a pointer to our process wide memory mapped variable}
   Result := lpHookRec
 end; { GetHookRecPointer }
 
 
 {The function that actually processes the keystrokes for our hook}
 function KeyBoardProc (code: Integer; wParam: Integer; lParam: Integer) :
   Integer;
   stdcall;
 var
   KeyUp : bool;
 {Remove comments for additional functionability
   IsAltPressed : bool;
   IsCtrlPressed : bool;
   IsShiftPressed : bool;
  } 
 begin { KeyBoardProc } 
   Result := 0; 
   
   Case code Of 
   HC_ACTION: 
     begin 
       {We trap the keystrokes here} 
       {Is this a key up message?} 
       KeyUp := ((lParam and (1 shl 31)) <> 0); 
       
       (*Remove comments for additional functionability
      {Is the Alt key pressed}
       if ((lParam and (1 shl 29)) <> 0) then begin
         IsAltPressed := TRUE;
       end else begin
         IsAltPressed := FALSE;
       end;
 
      {Is the Control key pressed}
       if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
         IsCtrlPressed := TRUE;
       end else begin
         IsCtrlPressed := FALSE;
       end;
 
      {if the Shift key pressed}
       if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
         IsShiftPressed := TRUE;
       end else begin
         IsShiftPressed := FALSE;
       end;
      *) 
       {if KeyUp then increment the key count} 
       if (KeyUp <> false) then 
         begin 
           inc (lpHookRec^.TheKeyCount)
         end { (KeyUp <> false) }; 
       
       Case wParam Of 
       {Was the enter key pressed?} 
       VK_RETURN: 
         begin 
           {if KeyUp} 
           if (KeyUp <> false) then 
             begin 
               {Post a bogus message to the window control in our app} 
               PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0); 
               PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
             end { (KeyUp <> false) }; 
           {if you wanted to swallow the keystroke then return -1} 
           {else if you want to allow the keystroke then return 0} 
           Result := 0; 
           exit
         end; {VK_RETURN} 
       {if the left arrow key is pressed then lets play a joke!} 
       VK_LEFT: 
         begin 
           {if KeyUp} 
           if (KeyUp <> false) then 
             begin 
               {Create a UpArrow keyboard event} 
               keybd_event (VK_RIGHT, 0, 0, 0); 
               keybd_event (VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
             end { (KeyUp <> false) }; 
           {Swallow the keystroke} 
           Result := -1; 
           exit
         end; {VK_LEFT} 
       end { case wParam }; {case wParam} 
       {Allow the keystroke} 
       Result := 0
     end; {HC_ACTION} 
   HC_NOREMOVE: 
     begin 
       {This is a keystroke message, but the keystroke message} 
       {has not been removed from the message queue, since an} 
       {application has called PeekMessage() specifying PM_NOREMOVE} 
       Result := 0; 
       exit
     end; 
   end { case code }; {case code} 
   if (code < 0) then 
     {Call the next hook in the hook chain} 
     Result := CallNextHookEx (lpHookRec^.TheHookHandle, code, wParam, lParam)
 end; { KeyBoardProc } 
 
 
 procedure StartKeyBoardHook 
   stdcall; 
 begin { StartKeyBoardHook } 
   {if we have a process wide memory variable} 
   {and the hook has not already been set...} 
   if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) then 
     begin 
       {Set the hook and remember our hook handle} 
       lpHookRec^.TheHookHandle := SetWindowsHookEx (WH_KEYBOARD, @KeyBoardProc, 
         HInstance, 0)
     end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
 end; { StartKeyBoardHook } 
 
 
 procedure StopKeyBoardHook 
   stdcall; 
 begin { StopKeyBoardHook } 
   {if we have a process wide memory variable} 
   {and the hook has already been set...} 
   if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) then 
     begin 
       {Remove our hook and clear our hook handle} 
       if (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) then 
         begin 
           lpHookRec^.TheHookHandle := 0
         end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
     end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
 end; { StopKeyBoardHook } 
 
 
 procedure DllEntryPoint (dwReason: DWord); 
 begin { DllEntryPoint } 
   Case dwReason Of 
   Dll_Process_Attach: 
     begin 
       {if we are getting mapped into a process, then get} 
       {a pointer to our process wide memory mapped variable} 
       hObjHandle := 0; 
       lpHookRec := Nil; 
       MapFileMemory (sizeof (lpHookRec^))
     end; 
   Dll_Process_Detach: 
     begin 
       {if we are getting unmapped from a process then, remove} 
       {the pointer to our process wide memory mapped variable} 
       UnMapFileMemory
     end; 
   end { case dwReason }
 end; { DllEntryPoint } 
 
 
 Exports 
   KeyBoardProc name 'KEYBOARDPROC', 
   GetHookRecPointer name 'GETHOOKRECPOINTER', 
   StartKeyBoardHook name 'STARTKEYBOARDHOOK', 
   StopKeyBoardHook name 'STOPKEYBOARDHOOK'; 
 
 begin 
   {Set our Dll's main entry point} 
   DLLProc := @DllEntryPoint; 
   {Call our Dll's main entry point} 
   DllEntryPoint (Dll_Process_Attach)
 end.
 

Generated 12:02:41 on Sep 23, 2019