捕获键盘挂钩上的死键

Question

参照this question, and more specifically to this answer, it seems that dead keys are captured on a keyboad hook only after a MSB操纵。答案的作者留下了一个固定的代码，但我不知道 Delphi 等价的是什么。

我的实际代码：

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  Messages,
  SysUtils;

var
  hhk: HHOOK;
  Msg: TMsg;

{==================================================================================}

function ReverseBits(b: Byte): Byte;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to 8 do
  begin
    Result := (Result shl 1) or (b and 1);
    b := b shr 1;
  end;
end;

function GetCharFromVirtualKey(Key: Word): string;
var
  keyboardState: TKeyboardState;
  keyboardLayout: HKL;
  asciiResult: Integer;
begin
  GetKeyboardState(keyboardState);
  keyboardLayout := GetKeyboardLayout(0);
  SetLength(Result, 2);
  asciiResult := ToAsciiEx(Key, ReverseBits(MapVirtualKey(Key, MAPVK_VK_TO_CHAR)), keyboardState, @Result[1], 0, keyboardLayout);
  case asciiResult of
    0:
      Result := '';
    1:
      SetLength(Result, 1);
    2:
      ;
  else
    Result := '';
  end;
end;

{==================================================================================}

function LowLevelKeyboardProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
type
  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;

  TKBDLLHOOKSTRUCT = record
    vkCode: cardinal;
    scanCode: cardinal;
    flags: cardinal;
    time: cardinal;
    dwExtraInfo: Cardinal;
  end;

  PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct;

  TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT;
var
  LKBDLLHOOKSTRUCT: PKeyboardLowLevelHookStruct;
begin
  case nCode of
    HC_ACTION:
      begin
        if wParam = WM_KEYDOWN then
        begin
          LKBDLLHOOKSTRUCT := PKeyboardLowLevelHookStruct(lParam);
          Writeln(GetCharFromVirtualKey(LKBDLLHOOKSTRUCT^.vkCode));
        end;
      end;
  end;
  Result := CallNextHookEx(hhk, nCode, wParam, lParam);
end;

procedure InitHook;
begin
  hhk := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, HInstance, 0);
  if hhk = 0 then
    RaiseLastOSError;
end;

procedure KillHook;
begin
  if (hhk <> 0) then
    UnhookWindowsHookEx(hhk);
end;

begin
  try
    InitHook;
    while GetMessage(Msg, 0, 0, 0) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Answer 1

在回答@fpiette 的最后一条评论时，这是我的解决方案：

program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows,
  Messages,
  SysUtils;

var
  hhk: HHOOK;
  Msg: TMsg;

function IsTextCharForKeyTip(AKey: Word): Boolean;
var
  keyboardLayout: HKL;
  ActiveWindow: HWND;
  ActiveThreadID: DWord;
  ARes: UINT;
begin
  ActiveWindow := GetForegroundWindow;
  ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
  keyboardLayout := GetKeyboardLayout(ActiveThreadID);
  ARes := MapVirtualKeyEx(AKey, MAPVK_VK_TO_CHAR, keyboardLayout);
  Result := ((ARes and $FFFF0000) = 0) and (Char(ARes) <> ' ') and (CharInSet(Char(ARes), [#32..#255]));
end;

function LowLevelKeyboardProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
type
  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;

  TKBDLLHOOKSTRUCT = record
    vkCode: cardinal;
    scanCode: cardinal;
    flags: cardinal;
    time: cardinal;
    dwExtraInfo: cardinal;
  end;

  PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct;

  TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT;
var
  LKBDLLHOOKSTRUCT: PKeyboardLowLevelHookStruct;
  keyboardState: TKeyboardState;
  keyboardLayout: HKL;
  ScanCode: Integer;
  ActiveWindow: HWND;
  ActiveThreadID: DWord;
  CapsKey, ShiftKey: Boolean;
  KeyString: string;
begin
  Result := CallNextHookEx(hhk, nCode, wParam, lParam);
  case nCode of
    HC_ACTION:
      begin
        CapsKey := False;
        ShiftKey := False;
        if Odd(GetKeyState(VK_CAPITAL)) then
          if GetKeyState(VK_SHIFT) < 0 then
            CapsKey := False
          else
            CapsKey := True
        else if GetKeyState(VK_SHIFT) < 0 then
          ShiftKey := True
        else
          ShiftKey := False;

        if GetKeyState(VK_BACK) < 0 then
          Write('[Backspace]') { #08 }; // #08, overwrites what was deleted on the console :D.

        if GetKeyState(VK_SPACE) < 0 then
          Write(#32);

        if GetKeyState(VK_TAB) < 0 then
          Write(#09);

        case wParam of
          WM_KEYDOWN, WM_SYSKEYDOWN:
            begin
              LKBDLLHOOKSTRUCT := PKeyboardLowLevelHookStruct(lParam);

              if (not IsTextCharForKeyTip(LKBDLLHOOKSTRUCT^.vkCode)) then
                Exit;

              SetLength(KeyString, 2);
              ActiveWindow := GetForegroundWindow;
              ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
              keyboardLayout := GetKeyboardLayout(ActiveThreadID);
              GetKeyboardState(keyboardState);
              ScanCode := MapVirtualKeyEx(LKBDLLHOOKSTRUCT^.vkCode, MAPVK_VK_TO_CHAR, keyboardLayout);
              ToAsciiEx(LKBDLLHOOKSTRUCT^.vkCode, ScanCode, keyboardState, @KeyString[1], 0, keyboardLayout);

              if CapsKey or ShiftKey then
                Write(UpperCase(KeyString[1]))
              else
                Write(LowerCase(KeyString[1]));
            end;
        end;
      end;
  end;
end;

procedure InitHook;
begin
  hhk := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, HInstance, 0);
  if hhk = 0 then
    RaiseLastOSError;
end;

procedure KillHook;
begin
  if (hhk <> 0) then
    UnhookWindowsHookEx(hhk);
end;

begin
  try
    InitHook;
    while True do
    begin
      if PeekMessage(Msg, 0, 0, 0, 0) then
      begin
        GetMessage(Msg, 0, 0, 0);
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

捕获键盘挂钩上的死键

Capture dead keys on Keyboard hook

delphi

keyboard

hook

delphi-10.3-rio