function ToUnicodeEx(wVirtKey, wScanCode: UINT; lpKeyState: PByte; pwszBuff: PWideChar; cchBuff: Integer;
wFlags: UINT; dwhkl: HKL): Integer; stdcall; external 'user32.dll';
const
LLKHF_ALTDOWN = KF_ALTDOWN shr 8;
WH_KEYBOARD_LL = 13;
type
PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
TKBDLLHOOKSTRUCT = packed record
vkCode: DWORD;
scanCode: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
var
llKeyboardHook: HHOOK = 0;
AltDown, ShiftDown, CtrlDown: Boolean;
KeyBoardState: TKeyboardState;
KeyBoardLayOut: HKL;
function LowLevelKeyboardHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): HRESULT; stdcall;
var
pkbhs: PKBDLLHOOKSTRUCT;
AChr: array[0..1] of WideChar;
VirtualKey: integer;
ScanCode: integer;
ConvRes: integer;
ActiveWindow: HWND;
ActiveThreadID: DWord;
Str: widestring;
begin
pkbhs := PKBDLLHOOKSTRUCT(Pointer(lParam));
if nCode = HC_ACTION then
begin
VirtualKey := pkbhs^.vkCode;
Str := '';
//Alt key, log once on keydown
if LongBool(pkbhs^.flags and LLKHF_ALTDOWN) and (not AltDown) then
begin
Str := '[Alt]';
AltDown := True;
end;
if (not LongBool(pkbhs^.flags and LLKHF_ALTDOWN)) and (AltDown) then
AltDown := False;
//Ctrl key, log once on keydown
if (WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (not CtrlDown) then
begin
Str := '[Ctrl]';
CtrlDown := True;
end;
if (not WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (CtrlDown) then
CtrlDown := False;
//Shift key, log once on keydown
if ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) and (not ShiftDown) then
begin
Str := '[Shift]';
ShiftDown := True;
end;
if (wParam = WM_KEYUP) and ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) then
ShiftDown := False;
//Other Virtual Keys, log once on keydown
if (wParam = WM_KEYDOWN) and
((VirtualKey <> VK_LMENU) and (VirtualKey <> VK_RMENU)) and //not Alt
(VirtualKey <> VK_LSHIFT) and (VirtualKey <> VK_RSHIFT) and // not Shift
(VirtualKey <> VK_LCONTROL) and (VirtualKey <> VK_RCONTROL) then //not Ctrl
begin
Str := fMain.TranslateVirtualKey(VirtualKey);
if Str = '' then
begin
ActiveWindow := GetForegroundWindow;
ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
GetKeyboardState(KeyBoardState);
KeyBoardLayOut := GetKeyboardLayout(ActiveThreadID);
ScanCode := MapVirtualKeyEx(VirtualKey, 0, KeyBoardLayOut);
if ScanCode <> 0 then
begin
ConvRes := ToUnicodeEx(VirtualKey, ScanCode, @KeyBoardState, @AChr, SizeOf(Achr), 0, KeyBoardLayOut);
if ConvRes > 0 then
Str := AChr;
end;
end;
end;
//do whatever you have to do with Str, add to memo, write to file, etc...
if Str <> '' then
fMain.mLog.Text := fMain.mLog.Text + UTF16ToUTF8(Str);
end;
Result := CallNextHookEx(llKeyboardHook, nCode, wParam, lParam);
end;