如何通过Windows钩子捕获WM_KEYDOWN事件?
我想改变一个旧的代码键盘钩为更好的支持Unicode字符(旧代码是ascii),在这一刻我有困难,以捕获WM_KEYDOWN
事件。如何通过Windows钩子捕获WM_KEYDOWN事件?
我的实际代码如下:
var
Form1: TForm1;
HookHandle: hHook;
ft: text;
implementation
{$R *.dfm}
function KBHookProc(Code: Integer; WParam: WParam; LParam: LParam)
: LRESULT; stdcall;
var
_Msg: TMessage;
VK: Integer;
SC: Integer;
buf: Char;
KS: TKeyboardState;
MyHKB: HKL;
begin
if Code = HC_ACTION then
begin
if _Msg.Msg = WM_KEYDOWN then
begin
VK := _Msg.WPARAM;
MyHKB := GetKeyboardLayout(_Msg.LParam);
SC := MapVirtualKeyEx(VK, MAPVK_VK_TO_VSC, MyHKB);
GetKeyboardState(KS);
ToUnicodeEx(VK, SC, KS, @buf, sizeof(buf), 0, MyHKB);
append(ft);
write(ft,buf);
closefile(ft);
MyHKB := 0;
end;
end;
Result := CallNextHookEx(HookHandle, Code, WParam, LParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
assignfile(ft,'log.txt');
rewrite(ft);
closefile(ft);
HookHandle := SetWindowsHookEx(WH_JOURNALRECORD , @KBHookProc, hinstance, 0);
end;
编辑1:
我的代码如下捕捉WM_KEYDOWN
成功,但没有数据被写入到文件:-(
一些建议吗?
var
Form1: TForm1;
HookHandle: hHook;
ft: text;
implementation
{$R *.dfm}
function LowLevelKeyboardProc(nCode: Integer; wParam: wParam;
lParam: lParam): LRESULT; stdcall;
var
_Msg: TMessage;
VK: Integer;
SC: Integer;
buf: Char;
KS: TKeyboardState;
MyHKB: HKL;
begin
if (nCode >= 0) and (wParam = WM_KEYDOWN) then
begin
VK := _Msg.WParam;
MyHKB := GetKeyboardLayout(_Msg.LParam);
SC := MapVirtualKeyEx(VK, MAPVK_VK_TO_VSC, MyHKB);
GetKeyboardState(KS);
ToUnicodeEx(VK, SC, KS, @buf, sizeof(buf), 0, MyHKB);
append(ft);
write(ft,buf);
closefile(ft);
MyHKB := 0;
end;
Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;
function InstallHook: Boolean;
begin
Result := False;
if HookHandle = 0 then
begin
HookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, 0, 0);
Result := HookHandle <> 0;
end;
end;
function UninstallHook: Boolean;
begin
Result := UnhookWindowsHookEx(HookHandle);
HookHandle := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
assignfile(ft,'log.txt');
rewrite(ft);
closefile(ft);
InstallHook;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UninstallHook;
end;
解决方案!
下面是完整的代码工作:d
我愿意为Backspace
关键建议。
例如,当按下此键时,删除文件末尾的最后一个字符。
如果存在其他方式来做到这一点,我也接受。
var
Form1: TForm1;
HookHandle: hHook;
ft: text;
implementation
{$R *.dfm}
function LowLevelKeyboardProc(nCode: Integer; wParam: wParam;
lParam: lParam): LRESULT; stdcall;
var
vkey: Cardinal;
buff: WideChar;
kbState: TKeyboardState;
keybLayout: HKL;
_msg: PEventMsg;
begin
_msg := Pointer(lParam);
if (nCode >= 0) and (wParam = WM_KEYDOWN) then
begin
GetKeyboardState(kbState);
KeybLayout:=GetKeyboardLayout(0);
vkey := MapVirtualKeyEx(_msg.paramL, MAPVK_VSC_TO_VK, keybLayout);
ToUnicodeEx(vkey, _msg.paramL, @kbState, @buff, 1, 0, keybLayout);
append(ft);
if vkey = 8 then
write(ft,'{BKS}')
else
if vkey = 16 then
write(ft,'{SHIFT}')
else
if vkey = 20 then
write(ft,'{CAPS}')
else
write(ft,buff);
closefile(ft);
end;
Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;
function InstallHook: Boolean;
begin
Result := False;
if HookHandle = 0 then
begin
HookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, 0, 0);
Result := HookHandle <> 0;
end;
end;
function UninstallHook: Boolean;
begin
Result := UnhookWindowsHookEx(HookHandle);
HookHandle := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
assignfile(ft,'log.txt');
rewrite(ft);
closefile(ft);
InstallHook;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UninstallHook;
end;
为了使代码正常工作,您必须更改哪些主要内容? –
@Rob肯尼迪,可以帮助我[这个问题](http://stackoverflow.com/questions/41008676/how-make-setthreaddesktop-api-work-from-of-a-console-application?noredirect=1# comment69226584_41008676)? – Saulo
为什么您使用'WH_JOURNALRECORD'而不是'WH_KEYBOARD'或'WH_KEYBOARD_LL'?而你的'KBHookProc()'使用'_Msg',而不先分配任何东西。为什么不处理'WM_CHAR' /'WM_UNICHAR'窗口消息而不是'WM_KEYDOWN'键盘消息?如果您只是为自己的应用程序处理键盘输入,请改用“TApplication.OnMessage”。如果您要挂钩其他应用程序,请考虑使用[原始输入API](https://msdn.microsoft.com/en-us/library/windows/desktop/ms645536.aspx),而不要使用“SetWindowsHookEx()”。 –
@RemyLebeau,我编辑了我的问题。为什么没有写入文件? – Saulo
我似乎记得原生的Delphi文件函数不能很好地处理Unicode。除此之外,你是否做过任何调试,以确认你调用的所有API函数返回你期望的结果?我在这里没有看到任何错误检查代码。 –