DELPHI使用键盘钩子

小读了一下《Delphi下深入Windows核心编程》感觉里面的东西写得还算可以，至少有学到东西

于是整理了一下书中的代码，并加上注注释发上来

首先是最重要的键盘钩子使用的DLL：

 

view plain copy to clipboard print ?

1. unit UnitDll;  
2.   
3. interface  
4.   
5. uses Windows;  
6.   
7. const BUFFER_SIZE = 16 * 1024; // 文件映射到内存的大小  
8. const HOOK_MEM_FILENAME = 'MEM_FILE'; // 映像文件名  
9. const HOOK_MUTEX_NAME = 'MUTEX_NAME'; // 互斥名  
10.   
11. type  
12.   // 共享结构  
13.   TShared = record  
14.     Keys: array[0..BUFFER_SIZE] of Char;  
15.     KeyCount: Integer;  
16.   end;  
17.   // 共享结构指针  
18.   PShared = ^TShared;  
19.   
20. var  
21.   MemFile, HookMutex: THandle;  // 文件句柄和互斥句柄  
22.   hOldKeyHook: HHook; // 钩子变量  
23.   Shared: PShared; // 共享变量  
24.   
25. implementation  
26.   
27. // 重要：键盘钩子回调  
28. function KeyHookProc(iCode: Integer; wParam: WPARAM;  
29.   lParam: LPARAM): LRESULT; stdcall; export;  
30. const  
31.   KeyPressMask = $80000000;  
32. begin  
33.   if iCode < 0 then  
34.     Result := CallNextHookEx(hOldKeyHook, iCode, wParam, lParam)  
35.   else  
36.   begin  
37.     if ((lParam and KeyPressMask) = 0) then  
38.     begin  
39.       // 键盘消息捕获  
40.       Shared^.Keys[Shared^.KeyCount] := Char(wParam and $00FF);  
41.       Inc(Shared^.KeyCount);  
42.       // 超出内存限定大小则重置  
43.       if Shared^.KeyCount >= BUFFER_SIZE - 1 then  
44.         Shared^.KeyCount := 0;  
45.     end;  
46.     result:=0;  
47.   end;  
48. end;  
49.   
50. // 安装钩子  
51. function EnableKeyHook: BOOL; export;       
52. begin  
53.   Shared^.KeyCount := 0;  
54.   if hOldKeyHook = 0 then  
55.   begin  
56.     // 设置钩子过滤  
57.     {WH_KEYBOARD: 安装的是键盘钩子 KeyHookProc: 消息回调, HInstance: 回调函数实例 线程ID}  
58.     hOldKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookProc, HInstance, 0);  
59.   end;  
60.   Result := (hOldKeyHook <> 0);  
61. end;  
62.   
63. {撤消钩子过滤函数}  
64. function DisableKeyHook: BOOL; export;  
65. begin  
66.   if hOldKeyHook <> 0 then  
67.   begin  
68.     UnHookWindowsHookEx(hOldKeyHook);  
69.     hOldKeyHook := 0;  
70.     Shared^.KeyCount := 0;  
71.   end;  
72.   Result := (hOldKeyHook = 0);  
73. end;  
74.   
75.   
76. // 得到获得多少按键  
77. function GetKeyCount: Integer; export;  
78. begin  
79.   Result := Shared^.KeyCount;  
80. end;  
81.   
82. // 得到第I个按键  
83. function GetKey(index: Integer): Char; export;  
84. begin  
85.   Result := Shared^.Keys[index];  
86. end;  
87.   
88. // 清空按键  
89. procedure ClearKeyString; export;  
90. begin  
91.   Shared^.KeyCount := 0;  
92. end;  
93.   
94. // 导出函数列表  
95. exports  
96.   EnableKeyHook,  
97.   DisableKeyHook,  
98.   GetKeyCount,  
99.   ClearKeyString,  
100.   GetKey;  
101.   
102. initialization  
103.   // 创建互斥变量，DLL只能有一个进程可以使用  
104.   HookMutex := CreateMutex(nil, True, HOOK_MUTEX_NAME);  
105.   // 打开文件映像  
106.   MemFile := OpenFileMapping(FILE_MAP_WRITE, False, HOOK_MEM_FILENAME);  
107.   // 如果不存在该文件映像则创建  
108.   if MemFile = 0 then  
109.     MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TShared), HOOK_MEM_FILENAME);  
110.   // 文件映射内存  
111.   Shared := MapViewOfFile(MemFile, File_MAP_WRITE, 0, 0, 0);  
112.   // 释放互斥变量  
113.   ReleaseMutex(HookMutex);  
114.   // 关闭互斥句柄  
115.   CloseHandle(HookMutex);  
116.   
117. finalization  
118.   // 撤消钩子过滤  
119.   if hOldKeyHook <> 0 then  
120.     DisableKeyHook;  
121.   // 释放映射  
122.   UnMapViewOfFile(Shared);  
123.   // 关闭映像文件  
124.   CloseHandle(MemFile);  
125. end.  

 

这个看懂了之后就可以直接写个CLIENT调用了

 

view plain copy to clipboard print ?

1. unit Unit2;  
2.   
3. interface  
4.   
5. uses  
6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
7.   StdCtrls, ExtCtrls;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Memo1: TMemo;  
12.     bSetHook: TButton;  
13.     bCancelHook: TButton;  
14.     bReadKeys: TButton;  
15.     bClearKeys: TButton;  
16.     Panel2: TPanel;  
17.     procedure bSetHookClick(Sender: TObject);  
18.     procedure bCancelHookClick(Sender: TObject);  
19.     procedure bReadKeysClick(Sender: TObject);  
20.     procedure bClearKeysClick(Sender: TObject);  
21.   end;  
22.   
23. var  
24.   Form1: TForm1;  
25.   
26.   
27. implementation  
28.   
29. {$R *.DFM}  
30. function EnableKeyHook: BOOL; external 'KEYHOOK.DLL';  
31. function DisableKeyHook: BOOL; external 'KEYHOOK.DLL';  
32. function GetKeyCount: Integer; external 'KEYHOOK.DLL';  
33. function GetKey(idx: Integer): Char; external 'KEYHOOK.DLL';  
34. procedure ClearKeyString; external 'KEYHOOK.DLL';  
35.   
36. procedure TForm1.bSetHookClick(Sender: TObject);  
37. begin  
38.   EnableKeyHook;  
39.   bSetHook.Enabled := False;  
40.   bCancelHook.Enabled := True;  
41.   bReadKeys.Enabled := True;  
42.   bClearKeys.Enabled := True;  
43.   Panel2.Caption := ' 键盘钩子已经设置';  
44. end;  
45.   
46. procedure TForm1.bCancelHookClick(Sender: TObject);  
47. begin  
48.   DisableKeyHook;  
49.   bSetHook.Enabled := True;  
50.   bCancelHook.Enabled := False;  
51.   bReadKeys.Enabled := False;  
52.   bClearKeys.Enabled := False;  
53.   Panel2.Caption := ' 键盘钩子没有设置';  
54. end;  
55.   
56. procedure TForm1.bReadKeysClick(Sender: TObject);  
57. var  
58.    i: Integer;  
59. begin  
60.   Memo1.Lines.Clear;{在Memo1中显示击键历史记录}  
61.   for i := 0 to GetKeyCount - 1 do  
62.     Memo1.Text := Memo1.Text + GetKey(i);  
63.   
64. end;  
65.   
66. procedure TForm1.bClearKeysClick(Sender: TObject);  
67. begin  
68.   Memo1.Clear;  
69.   ClearKeyString;  
70. end;  
71.   
72. end.