Recent

Author Topic: Global keyboard hook  (Read 8318 times)

M[a]nny

  • Full Member
  • ***
  • Posts: 122
  • Dreamer
Global keyboard hook
« on: May 29, 2017, 05:49:48 pm »
Hello,

my goal is to create opensource application for windows which is able to capture advanced key combinations. For example events like:
  • User has pressed 2x left CTRL (pause between those presses must be shorter than 500ms)
  • User has pressed F1 for a long time (long time = longer than 750ms)F
  • User has pressed key combination LEFT ALT + F1

I would like to take control over those events, maybe i am dreamer but i am thinking of something like this:
  • Windows has detected keyboard event
  • My application takes control over that event and decides whether it continues or stops the flow
  • Windows continues in its work

I have no experience in this so i will be glad for any kind of help.
This software will be used for advanced remaping keyboard.
Bad news: Time flies.
Good news: You are the pilot.

Don't try to be perfect, just be unique.

GetMem

  • Hero Member
  • *****
  • Posts: 3744
Re: Global keyboard hook
« Reply #1 on: May 29, 2017, 07:05:02 pm »
The following code(attachment) can do 90% of your requirements. With a few, small modification you should be ok(pretty close to SF though  :D). Please note:
   1. Never ever block the hook chain be using some blocking function(like ShowMessage) inside LowLevelKeyboardHook
   2. If you want to prevent a key to arrive to the destination, change the function result to -1

Code: Pascal  [Select][+][-]
  1. function ToUnicodeEx(wVirtKey, wScanCode: UINT; lpKeyState: PByte;  pwszBuff: PWideChar; cchBuff: Integer;
  2.   wFlags: UINT; dwhkl: HKL): Integer; stdcall; external 'user32.dll';
  3.  
  4. const
  5.   LLKHF_ALTDOWN = KF_ALTDOWN shr 8;
  6.   WH_KEYBOARD_LL = 13;
  7.  
  8. type
  9.   PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  10.   TKBDLLHOOKSTRUCT = packed record
  11.     vkCode: DWORD;
  12.     scanCode: DWORD;
  13.     flags: DWORD;
  14.     time: DWORD;
  15.     dwExtraInfo: DWORD;
  16.   end;
  17.  
  18. var
  19.   llKeyboardHook: HHOOK = 0;
  20.   AltDown, ShiftDown, CtrlDown: Boolean;
  21.   KeyBoardState: TKeyboardState;
  22.   KeyBoardLayOut: HKL;
  23.  
  24. function LowLevelKeyboardHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): HRESULT; stdcall;
  25. var
  26.   pkbhs: PKBDLLHOOKSTRUCT;
  27.   AChr: array[0..1] of WideChar;
  28.   VirtualKey: integer;
  29.   ScanCode: integer;
  30.   ConvRes: integer;
  31.   ActiveWindow: HWND;
  32.   ActiveThreadID: DWord;
  33.   Str: widestring;
  34. begin
  35.   pkbhs := PKBDLLHOOKSTRUCT(Pointer(lParam));
  36.   if nCode = HC_ACTION then
  37.   begin
  38.     VirtualKey := pkbhs^.vkCode;
  39.  
  40.     Str := '';
  41.     //Alt key, log once on keydown
  42.     if LongBool(pkbhs^.flags and LLKHF_ALTDOWN) and (not AltDown) then
  43.     begin
  44.       Str := '[Alt]';
  45.       AltDown := True;
  46.     end;
  47.     if (not LongBool(pkbhs^.flags and LLKHF_ALTDOWN)) and (AltDown) then
  48.       AltDown := False;
  49.  
  50.     //Ctrl key, log once on keydown
  51.     if (WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (not CtrlDown) then
  52.     begin
  53.       Str := '[Ctrl]';
  54.       CtrlDown := True;
  55.     end;
  56.     if (not WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (CtrlDown) then
  57.       CtrlDown := False;
  58.  
  59.     //Shift key, log once on keydown
  60.     if ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) and (not ShiftDown) then
  61.     begin
  62.       Str := '[Shift]';
  63.       ShiftDown := True;
  64.     end;
  65.     if (wParam = WM_KEYUP) and ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) then
  66.       ShiftDown := False;
  67.  
  68.     //Other Virtual Keys, log once on keydown
  69.     if (wParam = WM_KEYDOWN) and
  70.           ((VirtualKey <> VK_LMENU) and (VirtualKey <> VK_RMENU)) and  //not Alt
  71.            (VirtualKey <> VK_LSHIFT) and (VirtualKey <> VK_RSHIFT) and // not Shift
  72.             (VirtualKey <> VK_LCONTROL) and (VirtualKey <> VK_RCONTROL) then //not Ctrl
  73.     begin
  74.       Str := fMain.TranslateVirtualKey(VirtualKey);
  75.       if Str = '' then
  76.       begin
  77.         ActiveWindow := GetForegroundWindow;
  78.         ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
  79.         GetKeyboardState(KeyBoardState);
  80.         KeyBoardLayOut := GetKeyboardLayout(ActiveThreadID);
  81.         ScanCode := MapVirtualKeyEx(VirtualKey, 0, KeyBoardLayOut);
  82.         if ScanCode <> 0 then
  83.         begin
  84.           ConvRes := ToUnicodeEx(VirtualKey, ScanCode, @KeyBoardState, @AChr, SizeOf(Achr), 0, KeyBoardLayOut);
  85.           if ConvRes > 0 then
  86.             Str := AChr;
  87.         end;
  88.       end;
  89.     end;
  90.     //do whatever you have to do with Str, add to memo, write to file, etc...
  91.     if Str <> '' then
  92.       fMain.mLog.Text :=  fMain.mLog.Text + UTF16ToUTF8(Str);
  93.   end;
  94.   Result := CallNextHookEx(llKeyboardHook, nCode, wParam, lParam);
  95. end;

M[a]nny

  • Full Member
  • ***
  • Posts: 122
  • Dreamer
Re: Global keyboard hook
« Reply #2 on: May 29, 2017, 09:48:12 pm »
Thanks for your effort, it looks wonderful :) But i get this error message when i am trying to compile the code:
Code: Pascal  [Select][+][-]
  1. umain.pas(140,77) Error: Incompatible type for arg no. 2: Got "<address of function(LongInt;Int64;Int64):LongInt;StdCall>", expected "<procedure variable type of function(LongInt;Int64;Int64):Int64;StdCall>"
Is there something i can do in order to fix it?
Bad news: Time flies.
Good news: You are the pilot.

Don't try to be perfect, just be unique.

GetMem

  • Hero Member
  • *****
  • Posts: 3744
Re: Global keyboard hook
« Reply #3 on: May 29, 2017, 10:29:22 pm »
What is your Lazarus/FPC/Windows version? It seems like SetWindowsHookEx declaration is wrong.

Try to declare SetWindowsHookEx like this(after ToUnicodeEx):
Code: Pascal  [Select][+][-]
  1. function SetWindowsHookExA(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; stdcall; external 'user32.dll';
Then call it on line 140:
Code: Pascal  [Select][+][-]
  1. if llKeyboardHook = 0 then
  2.   llKeyboardHook := SetWindowsHookExA(WH_KEYBOARD_LL, @LowLevelKeyboardHook, HInstance, 0);

M[a]nny

  • Full Member
  • ***
  • Posts: 122
  • Dreamer
Re: Global keyboard hook
« Reply #4 on: May 29, 2017, 11:58:04 pm »
I am using Lazarus 1.6.4 and FPC 3.0.2 (both should be newest one).
I have tried what you've told me but i'm still getting the same error:

Code: Pascal  [Select][+][-]
  1. umain.pas(142,76) Error: Incompatible type for arg no. 2: Got "<address of function(LongInt;Int64;Int64):LongInt;StdCall>", expected "<procedure variable type of function(LongInt;Int64;Int64):Int64;StdCall>"
Bad news: Time flies.
Good news: You are the pilot.

Don't try to be perfect, just be unique.

GetMem

  • Hero Member
  • *****
  • Posts: 3744
Re: Global keyboard hook
« Reply #5 on: May 30, 2017, 09:09:21 am »
@M[a]nny
I finally figured out that you have installed 64 bit lazarus. The 64 bit compiler keeps insisting that SetWindowsHookEx needs <procedure variable type of function..> when it don't. The same code can be compiled both for 32/64 bit with delphi.  For now, you should compile 32 bit version of the project. In order to do this, you can:
  1. Install the 32 bit lazarus/fpc in a separate directory with fpcdeluxe(https://github.com/newpascal/fpcupdeluxe/releases/tag/1.4.0g), it won't interfere with your current installation
  2. Cross compile

Or replace {$mode objfpc}{$H+} with {$mode delphi}  and stay with 64 bit :). See Thaddy's suggestion below.
« Last Edit: May 30, 2017, 10:02:17 am by GetMem »

Thaddy

  • Hero Member
  • *****
  • Posts: 10271
Re: Global keyboard hook
« Reply #6 on: May 30, 2017, 09:31:09 am »
@GetMem
I don't think it is a good idea to promote function SetWindowsHookExA on modern Windows since the A api is merely a stub and a callthrough to function SetWindowsHookExW and has been for some time (XP time).
So it is not suited for a hook and timing, it slows it down.
Only use it if Ansi conversion is really needed, the OS is UTF16 internally. (You know that!)

@M[a]nny
Try first {$mode delphi} because that is Delphi syntax and not objfpc syntax.
Try setting assignable typed constants to true as well.

I have similar hook code running on win64, and global hooks *must* be in a dll... Afaik. The KOL code works. I'll try to look it up.

Also note this interesting remark on msdn:

"Remarks

SetWindowsHookEx can be used to inject a DLL into another process. A 32-bit DLL cannot be injected into a 64-bit process, and a 64-bit DLL cannot be injected into a 32-bit process. If an application requires the use of hooks in other processes, it is required that a 32-bit application call SetWindowsHookEx to inject a 32-bit DLL into 32-bit processes, and a 64-bit application call SetWindowsHookEx to inject a 64-bit DLL into 64-bit processes. The 32-bit and 64-bit DLLs must have different names."
« Last Edit: May 30, 2017, 09:33:57 am by Thaddy »
I am more like donkey than shrek

GetMem

  • Hero Member
  • *****
  • Posts: 3744
Re: Global keyboard hook
« Reply #7 on: May 30, 2017, 09:49:30 am »
@Thaddy
Quote
I don't think it is a good idea to promote function SetWindowsHookExA on modern Windows since the A api is merely a stub and a callthrough to function SetWindowsHookExW and has been for some time (XP time).
So it is not suited for a hook and timing, it slows it down.
Only use it if Ansi conversion is really needed, the OS is UTF16 internally. (You know that!)
FCP still links SetWindowsHookEx to SetWindowsHookExA so I did the same. Nevertheless SetWindowsHookExW is a better choice.

Quote
SetWindowsHookEx can be used to inject a DLL into another process. A 32-bit DLL cannot be injected into a 64-bit process, and a 64-bit DLL cannot be injected into a 32-bit process. If an application requires the use of hooks in other processes, it is required that a 32-bit application call SetWindowsHookEx to inject a 32-bit DLL into 32-bit processes, and a 64-bit application call SetWindowsHookEx to inject a 64-bit DLL into 64-bit processes. The 32-bit and 64-bit DLLs must have different names."
Now this is the fun part. Low level keyboard hooks can be used both with 32/64 processes. It's all there in the documentation.

Quote
Try first {$mode delphi} because that is Delphi syntax and not objfpc syntax.
Try setting assignable typed constants to true as well.
Damn! I feel like an idiot. You're absolutely right about {$mode delphi}, that should work indeed.

M[a]nny

  • Full Member
  • ***
  • Posts: 122
  • Dreamer
Re: Global keyboard hook
« Reply #8 on: May 30, 2017, 06:25:18 pm »
{$mode delphi} worked like a charm :) Thank you guys for your effort!
Bad news: Time flies.
Good news: You are the pilot.

Don't try to be perfect, just be unique.

M[a]nny

  • Full Member
  • ***
  • Posts: 122
  • Dreamer
Re: Global keyboard hook
« Reply #9 on: May 30, 2017, 07:40:58 pm »
Yet I have two more questions :)

1. Can i hook mouse also?

2. In your code i have found these lines:
Code: Pascal  [Select][+][-]
  1.         ActiveWindow := GetForegroundWindow;
  2.         ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
  3.         GetKeyboardState(KeyBoardState);
  4.         KeyBoardLayOut := GetKeyboardLayout(ActiveThreadID);
  5.         ScanCode := MapVirtualKeyEx(VirtualKey, 0, KeyBoardLayOut);
  6.  
What can i do with it?
Does it mean i am able to detect via LowLevelKeyboardHook function what window is active right now?
Bad news: Time flies.
Good news: You are the pilot.

Don't try to be perfect, just be unique.

GetMem

  • Hero Member
  • *****
  • Posts: 3744
Re: Global keyboard hook
« Reply #10 on: May 30, 2017, 07:56:51 pm »
Quote
1. Can i hook mouse also?
Yes. You can do it in a similar fashion.

Quote
What can i do with it?
Does it mean i am able to detect via LowLevelKeyboardHook function what window is active right now?
The active window(which has input focus) is needed to get the correct keyboard layout. For example if you set an input language while you type a word document, let's say German, then switch to another application where you type in English. In order to correctly translate the virtual key in both cases, the MapVirtualKeyEx function needs to know the exact keyboard layout. So yes you can get the window name if you like.

kinnon_2000

  • New member
  • *
  • Posts: 6
Re: Global keyboard hook
« Reply #11 on: June 10, 2020, 08:10:23 pm »
This is very cool.

I modified the example project slightly with a status bar and a bunch of panels, so I could display appropriate text when CTRL or ALT or SHIFT are pressed or not.

Code: Pascal  [Select][+][-]
  1. function LowLevelKeyboardHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): HRESULT; stdcall;
  2. var
  3.   pkbhs: PKBDLLHOOKSTRUCT;
  4.   AChr: array[0..1] of WideChar;
  5.   VirtualKey: integer;
  6.   ScanCode: integer;
  7.   ConvRes: integer;
  8.   ActiveWindow: HWND;
  9.   ActiveThreadID: DWord;
  10.   Str: widestring;
  11. begin
  12.   pkbhs := PKBDLLHOOKSTRUCT(Pointer(lParam));
  13.   if nCode = HC_ACTION then
  14.   begin
  15.     VirtualKey := pkbhs^.vkCode;
  16.  
  17.     Str := '';
  18.     //Alt key, log once on keydown
  19.     if LongBool(pkbhs^.flags and LLKHF_ALTDOWN) and (not AltDown) then
  20.     begin
  21.       Str := '[Alt]';
  22.       AltDown := True;
  23.       fmain.statusbar1.Panels[0].Text:='[Alt]';
  24.     end;
  25.     if (not LongBool(pkbhs^.flags and LLKHF_ALTDOWN)) and (AltDown) then  begin
  26.       AltDown := False;
  27.       fmain.statusbar1.Panels[0].Text:='';
  28.     end;
  29.  
  30.     //Ctrl key, log once on keydown
  31.     if (WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (not CtrlDown) then
  32.     begin
  33.       Str := '[Ctrl]';
  34.       CtrlDown := True;
  35.       fmain.statusbar1.Panels[1].Text:='[Ctrl]';
  36.     end;
  37.     if (not WordBool(GetAsyncKeyState(VK_CONTROL) and $8000)) and (CtrlDown) then begin
  38.       CtrlDown := False;
  39.       fmain.statusbar1.Panels[1].Text:='';
  40.     end;
  41.  
  42.     //Shift key, log once on keydown
  43.     if ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) and (not ShiftDown) then
  44.     begin
  45.       Str := '[Shift]';
  46.       ShiftDown := True;
  47.       fmain.statusbar1.Panels[2].Text:='[Shift]';
  48.     end;
  49.     if (wParam = WM_KEYUP) and ((VirtualKey = VK_LSHIFT) or (VirtualKey = VK_RSHIFT)) then begin
  50.       ShiftDown := False;
  51.       fmain.statusbar1.Panels[2].Text:='';
  52.     end;
  53.  
  54.     //Other Virtual Keys, log once on keydown
  55.     if (wParam = WM_KEYDOWN) and
  56.           ((VirtualKey <> VK_LMENU) and (VirtualKey <> VK_RMENU)) and  //not Alt
  57.            (VirtualKey <> VK_LSHIFT) and (VirtualKey <> VK_RSHIFT) and // not Shift
  58.             (VirtualKey <> VK_LCONTROL) and (VirtualKey <> VK_RCONTROL) then //not Ctrl
  59.     begin
  60.       Str := fMain.TranslateVirtualKey(VirtualKey);
  61.       if Str = '' then
  62.       begin
  63.         ActiveWindow := GetForegroundWindow;
  64.         ActiveThreadID := GetWindowThreadProcessId(ActiveWindow, nil);
  65.         GetKeyboardState(KeyBoardState);
  66.         KeyBoardLayOut := GetKeyboardLayout(ActiveThreadID);
  67.         ScanCode := MapVirtualKeyEx(VirtualKey, 0, KeyBoardLayOut);
  68.         if ScanCode <> 0 then
  69.         begin
  70.           ConvRes := ToUnicodeEx(VirtualKey, ScanCode, @KeyBoardState, @AChr, SizeOf(Achr), 0, KeyBoardLayOut);
  71.           if ConvRes > 0 then
  72.             Str := AChr;
  73.         end;
  74.       end;
  75.     end;
  76.     //do whatever you have to do with Str, add to memo, write to file, etc...
  77.     if Str <> '' then
  78.       fMain.mLog.Text :=  fMain.mLog.Text + UTF16ToUTF8(Str);
  79.   end;
  80.   Result := CallNextHookEx(llKeyboardHook, nCode, wParam, lParam);
  81. end;

I've noticed theres an issue with the Ctrl key down and release code. Tried a bunch of things and so far havent sussed it out. Anyone fancy a go?
Updated project is attached.


 

TinyPortal © 2005-2018