Author: William Gerbert
How can I create a system wide keyboard hook under Win32?
Answer:
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).
1 library TheHook;
2
3 uses
4 Windows, Messages, SysUtils;
5
6 {Define a record for recording and passing information process wide}
7 type
8 PHookRec = ^THookRec;
9 THookRec = packed record
10 TheHookHandle: HHOOK;
11 TheAppWinHandle: HWnd;
12 TheCtrlWinHandle: HWnd;
13 TheKeyCount: DWord;
14 end;
15
16 var
17 hObjHandle: THandle; {Variable for the file mapping object}
18 lpHookRec: PHookRec;
19 {Pointer to our hook record}
20
21 procedure MapFileMemory(dwAllocSize: DWord);
22 begin { MapFileMemory }
23 {Create a process wide memory mapped variable}
24 hObjHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
25 dwAllocSize, 'HookRecMemBlock');
26 if (hObjHandle = 0) then
27 begin
28 MessageBox(0, 'Hook DLL', 'Could not create file map object', mb_Ok);
29 exit
30 end { (hObjHandle = 0) };
31 {Get a pointer to our process wide memory mapped variable}
32 lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
33 if (lpHookRec = nil) then
34 begin
35 CloseHandle(hObjHandle);
36 MessageBox(0, 'Hook DLL', 'Could not map file', mb_Ok);
37 exit
38 end { (lpHookRec = Nil) }
39 end; { MapFileMemory }
40
41 procedure UnMapFileMemory;
42 begin { UnMapFileMemory }
43 {Delete our process wide memory mapped variable}
44 if (lpHookRec <> nil) then
45 begin
46 UnMapViewOfFile(lpHookRec);
47 lpHookRec := nil
48 end { (lpHookRec <> Nil) };
49 if (hObjHandle > 0) then
50 begin
51 CloseHandle(hObjHandle);
52 hObjHandle := 0
53 end { (hObjHandle > 0) }
54 end; { UnMapFileMemory }
55
56 function GetHookRecPointer: pointer
57 stdcall;
58 begin { GetHookRecPointer }
59 {Return a pointer to our process wide memory mapped variable}
60 Result := lpHookRec
61 end; { GetHookRecPointer }
62
63 {The function that actually processes the keystrokes for our hook}
64
65 function KeyBoardProc(code: Integer; wParam: Integer; lParam: Integer):
66 Integer;
67 stdcall;
68 var
69 KeyUp: bool;
70 {Remove comments for additional functionability
71 IsAltPressed : bool;
72 IsCtrlPressed : bool;
73 IsShiftPressed : bool;
74 }
75 begin { KeyBoardProc }
76 Result := 0;
77
78 case code of
79 HC_ACTION:
80 begin
81 {We trap the keystrokes here}
82 {Is this a key up message?}
83 KeyUp := ((lParam and (1 shl 31)) <> 0);
84
85 (*Remove comments for additional functionability
86 {Is the Alt key pressed}
87 if ((lParam and (1 shl 29)) <> 0) then begin
88 IsAltPressed := TRUE;
89 end else begin
90 IsAltPressed := FALSE;
91 end;
92
93 {Is the Control key pressed}
94 if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
95 IsCtrlPressed := TRUE;
96 end else begin
97 IsCtrlPressed := FALSE;
98 end;
99
100 {if the Shift key pressed}
101 if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
102 IsShiftPressed := TRUE;
103 end else begin
104 IsShiftPressed := FALSE;
105 end;
106 *)
107 {if KeyUp then increment the key count}
108 if (KeyUp <> false) then
109 begin
110 inc(lpHookRec^.TheKeyCount)
111 end { (KeyUp <> false) };
112
113 case wParam of
114 {Was the enter key pressed?}
115 VK_RETURN:
116 begin
117 {if KeyUp}
118 if (KeyUp <> false) then
119 begin
120 {Post a bogus message to the window control in our app}
121 PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
122 PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
123 end { (KeyUp <> false) };
124 {if you wanted to swallow the keystroke then return -1}
125 {else if you want to allow the keystroke then return 0}
126 Result := 0;
127 exit
128 end; {VK_RETURN}
129 {if the left arrow key is pressed then lets play a joke!}
130 VK_LEFT:
131 begin
132 {if KeyUp}
133 if (KeyUp <> false) then
134 begin
135 {Create a UpArrow keyboard event}
136 keybd_event(VK_RIGHT, 0, 0, 0);
137 keybd_event(VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
138 end { (KeyUp <> false) };
139 {Swallow the keystroke}
140 Result := -1;
141 exit
142 end; {VK_LEFT}
143 end { case wParam }; {case wParam}
144 {Allow the keystroke}
145 Result := 0
146 end; {HC_ACTION}
147 HC_NOREMOVE:
148 begin
149 {This is a keystroke message, but the keystroke message}
150 {has not been removed from the message queue, since an}
151 {application has called PeekMessage() specifying PM_NOREMOVE}
152 Result := 0;
153 exit
154 end;
155 end { case code }; {case code}
156 if (code < 0) then
157 {Call the next hook in the hook chain}
158 Result := CallNextHookEx(lpHookRec^.TheHookHandle, code, wParam, lParam)
159 end; { KeyBoardProc }
160
161 procedure StartKeyBoardHook
162 stdcall;
163 begin { StartKeyBoardHook }
164 {if we have a process wide memory variable}
165 {and the hook has not already been set...}
166 if ((lpHookRec <> nil) and (lpHookRec^.TheHookHandle = 0)) then
167 begin
168 {Set the hook and remember our hook handle}
169 lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyBoardProc,
170 HInstance, 0)
171 end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
172 end; { StartKeyBoardHook }
173
174 procedure StopKeyBoardHook
175 stdcall;
176 begin { StopKeyBoardHook }
177 {if we have a process wide memory variable}
178 {and the hook has already been set...}
179 if ((lpHookRec <> nil) and (lpHookRec^.TheHookHandle <> 0)) then
180 begin
181 {Remove our hook and clear our hook handle}
182 if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> false) then
183 begin
184 lpHookRec^.TheHookHandle := 0
185 end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
186 end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
187 end; { StopKeyBoardHook }
188
189 procedure DllEntryPoint(dwReason: DWord);
190 begin { DllEntryPoint }
191 case dwReason of
192 Dll_Process_Attach:
193 begin
194 {if we are getting mapped into a process, then get}
195 {a pointer to our process wide memory mapped variable}
196 hObjHandle := 0;
197 lpHookRec := nil;
198 MapFileMemory(sizeof(lpHookRec^))
199 end;
200 Dll_Process_Detach:
201 begin
202 {if we are getting unmapped from a process then, remove}
203 {the pointer to our process wide memory mapped variable}
204 UnMapFileMemory
205 end;
206 end { case dwReason }
207 end; { DllEntryPoint }
208
209 exports
210 KeyBoardProc name 'KEYBOARDPROC',
211 GetHookRecPointer name 'GETHOOKRECPOINTER',
212 StartKeyBoardHook name 'STARTKEYBOARDHOOK',
213 StopKeyBoardHook name 'STOPKEYBOARDHOOK';
214
215 begin
216 {Set our Dll's main entry point}
217 DLLProc := @DllEntryPoint;
218 {Call our Dll's main entry point}
219 DllEntryPoint(Dll_Process_Attach)
220 end.
|
