Page 1 of 2 1 2 LastLast
Results 1 to 15 of 17

Thread: KeyboardHook in Windows 7

  1. #1
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262

    KeyboardHook in Windows 7

    Nog in het windows XP tijdperk heb ik een klein programma geschreven welke in de systeemtray op de achtergrond draait. Deze controleert realtime doormiddel van een KeyboardHook op bepaalde toetsen en zal dan een extern LEDje aansturen. Hiervoor gebruikte ik de volgende procedure:
    Code:
    SetWindowsHookEx(WH_JOURNALRECORD, KeyboardHook, hInstance, 0);
    Helaas werkt dit niet meer in Windows 7 door de rechten van de UAC. Na het uitschakelen van de UAC werkt alles weer zoals het ook in XP deed. Echter is dit natuurlijk geen verantwoorde oplossing en zou ik mijn programma moeten certificeren om volledige toegang te krijgen. Dit vind ik persoonlijk een beetje omslachtig voor een programma dat enkel voor eigen gebruik is.

    Op zoek naar een alternatief kwam ik een keyboardhook via een DLL tegen. De DLL voert een keyboardhook uit en stuurt de toetsaanslagen via een postmessage door naar mijn programma. In mijn programma lees ik deze vervolgens uit en laat ik controleren of een bepaalde toets is ingedrukt, om vervolgens daaraan een handeling uit te voeren. (zoals bijv. het laten branden van een LEDje.)
    Als ik dit vervolgens test wanneer mijn programma actief is krijg ik netjes de key nummers doorgestuurd zonder speciale rechten aan het programma te hoeven toekennen. Maar zodra mijn programma op de achtergrond draait vangt deze geen waardes meer af die de DLL verstuurd.

    Hoe krijg ik een KeyboardHook weer fatsoenlijk aan de praat in Windows 7?


    DLL:
    Delphi Code:
    1. library hookdll;
    2.  
    3. uses
    4. SysUtils, Dialogs, Windows, Classes, Messages;
    5.  
    6.  
    7. var
    8. HookHandle : Integer;
    9. I: Integer;
    10.  
    11. procedure SendKey;
    12. const
    13. WM_LOOK = WM_USER + 1234;
    14. var
    15. WndHandle: HWND;
    16. begin
    17. WndHandle:= FindWindow(nil,PChar('Form1'));
    18. SendMessage(WndHandle, WM_LOOK, 0, lParam(PChar(I)));
    19. end;
    20.  
    21. function KeyboardProc(code:Integer;vkey:WPARAM;Flags:LPARAM):Integer; stdcall;
    22. begin
    23. if Code=0 then
    24. begin
    25. I:= 0;
    26. I:=(vkey);
    27. SendKey;
    28. end;
    29.   Result:=CallNextHookEx(HookHandle,Code,vkey,flags);
    30. end;
    31.  
    32.  
    33.  
    34. function DLLHook:Boolean;
    35. begin
    36. HookHandle:=SetWindowsHookEx(WH_KEYBOARD,Addr(KeyBoardProc),HInstance,0);
    37. if HookHandle=0 then
    38.    Result:=False
    39. else
    40.     Result:=True;
    41. end;
    42.  
    43. function DLLUnhook:Boolean;
    44. begin
    45. if UnhookWindowsHookEx(HookHandle)=False then
    46.    Result:=False
    47. else
    48.     Result:=True;
    49. HookHandle:=0;
    50. end;
    51.  
    52.  
    53. exports
    54. SendKey,
    55. DLLHook,
    56. DLLUnhook,
    57. KeyBoardProc;
    58.  
    59. end.


    Programma:
    Delphi Code:
    1. unit hookkbd;
    2.  
    3. interface
    4.  
    5. uses
    6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7.   StdCtrls, ExtCtrls;
    8.  
    9. const
    10. WM_LOOK = WM_USER + 1234;
    11.  
    12. procedure SendPChar; stdcall; external 'HOOKDLL.DLL';
    13.  
    14. type
    15.   TForm1 = class(TForm)
    16.     btnActivate: TButton;
    17.     Edit1: TEdit;
    18.     procedure btnActivateClick(Sender: TObject);
    19.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    20.     procedure FormCreate(Sender: TObject);
    21.   private
    22.   Toets: Integer;
    23.     { Private declarations }
    24.   public
    25.     { Public declarations }
    26.   protected
    27. procedure mWM_LOOK(var message: TMessage); message WM_LOOK;
    28.   end;
    29.  
    30. var
    31.   Form1: TForm1;
    32.  
    33.  
    34.  
    35. implementation
    36.  
    37. {$R *.DFM}
    38.  
    39. function DLLHook : Boolean; external 'HOOKDLL.DLL';
    40. function DLLUnhook : Boolean; external 'HOOKDLL.DLL';
    41.  
    42. procedure TForm1.mWM_LOOK(var message: TMessage);
    43. begin
    44. Toets:= (Integer(PChar(message.LParam)));
    45. Form1.Edit1.Text := IntToStr(Toets);
    46. if Toets = 68 {D} then
    47. // Doe iets...
    48. end;
    49.  
    50. procedure TForm1.btnActivateClick(Sender: TObject);
    51. begin
    52. if btnActivate.Caption='Activate' then
    53. begin
    54. if DLLHook then
    55.  btnActivate.Caption:='Deactivate'
    56.  else
    57.  ShowMessage('Hook failed!');
    58.  end
    59.  else
    60.  begin
    61.  if DLLUnHook then
    62.  btnActivate.Caption:='Activate'
    63.   else
    64.    ShowMessage('UnHook failed!');
    65.   end;
    66. end;
    67.  
    68.  
    69. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    70. begin
    71. if btnActivate.Caption='Deactivate' then
    72. begin
    73. if DLLUnHook then
    74.  btnActivate.Caption:='Activate'
    75. else
    76. ShowMessage('UnHook failed!');
    77.  end;
    78. end;
    79.  
    80. procedure TForm1.FormCreate(Sender: TObject);
    81. begin
    82. btnActivate.Caption:='Activate';
    83. Toets:= 0;
    84. end;
    85.  
    86. end.

  2. #2
    Quote Originally Posted by sandertje View Post
    Maar zodra mijn programma op de achtergrond draait vangt deze geen waardes meer af die de DLL verstuurd.
    Wat bedoel je met op de achtergrond?
    Hier even de code getest en hij werkt perfect (even een Memo1 gemaakt om de keys in op te slaan).
    Ook als ik het project minimaliseer ontvangt ie de keys goed.
    Wel komen sommige keys dubbel binnen.... (dus dat zal je volgende probleem zijn )

  3. #3
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Met op de achtergrond bedoel ik wanneer mijn project geminimaliseerd is naar de taakbalk of systeemtray. Wanneer ik een Memo gebruik en het project geminimaliseerd is registreert hij alleen de eerste twee toetsaanslagen of helemaal niets. Wanneer ik weer terug keer en daarna op een toets druk, word het memo achteraf pas gevuld met alle keys. Of doe ik iets fout?

  4. #4
    Quote Originally Posted by sandertje View Post
    Wanneer ik een Memo gebruik en het project geminimaliseerd is registreert hij alleen de eerste twee toetsaanslagen of helemaal niets. Wanneer ik weer terug keer en daarna op een toets druk, word het memo achteraf pas gevuld met alle keys. Of doe ik iets fout?
    Hoe constateer je dat als je form geminimaliseerd is?
    Je ziet die Memo1 dan toch helemaal niet als je form geminimaliseerd is?

    Als de keys achteraf wel allemaal in de memo komen dan werkt het in principe wel. Alleen als jij bij het weer groot maken van je form alle keys in één keer in de memo1 ziet stromen kunnen er twee dingen aan de hand zijn.

    1) De message-queue wordt niet direct afgehandeld en de messages worden pas verwerkt op het moment dat je form weer groot wordt (dit lijkt mij sterk want je form zou gewoon messages moeten kunnen ontvangen, ook als ie geminimaliseerd is)

    2) Je memo1 laat de tekens pas wat later zien.

    Zou je het eens met een beep kunnen doen (naast het opslaan van het karakter in de Memo1)?
    Die beep zou je in ieder geval ook moeten kunnen horen als je form geminimaliseerd is (bij mij in ieder geval wel).
    (ik heb zelf nog niet naar Systray geprobeerd maar als jij zegt dat naar de taakbalk ook niet werkt.... bij mij dus wel)

  5. #5
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Quote Originally Posted by rvk View Post
    Hoe constateer je dat als je form geminimaliseerd is?
    Je ziet die Memo1 dan toch helemaal niet als je form geminimaliseerd is?
    Doordat het memo niet volledig was gevuld met de toetsen die ik wel had ingedrukt. Maar door middel van een Beep, zoals jij zelf al zei, is het toch beter om iets te constateren.

    Inmiddels ben ik erachter gekomen dat dit probleem door Delphi zelf werd veroorzaakt. Wanneer ik mijn projectje buiten Delphi om test, worden mooi alle toetsen geregistreerd. Waarom het precies fout gaat wanneer Delphi actief is weet ik niet. Mogelijk de manier hoe Delphi (versie 3) nog met het project communiceert?
    Maargoed, waar het om gaat is dat het probleem uiteindelijk is opgelost.

    Quote Originally Posted by rvk
    Wel komen sommige keys dubbel binnen.... (dus dat zal je volgende probleem zijn )
    Dat de key's dubbel binnen kwamen komt doordat de DLL zowel op de KEYDOWN als KEYUP event reageert.
    Doormiddel van een kleine aanpassing zal hij de key alleen nog maar doorsturen wanneer de toets weer is losgelaten.

    Voor de geïnteresseerden:


    DLL:
    Delphi Code:
    1. library hookdll;
    2.  
    3. uses
    4. SysUtils, Dialogs, Windows, Classes, Messages;
    5.  
    6.  
    7. var
    8. HookHandle : Integer;
    9.  
    10.  
    11. procedure SendKey(IKey: Integer);
    12. const
    13.   WM_LOOK = WM_USER + 1234;
    14. var
    15.   WndHandle: HWND;
    16. begin
    17.   WndHandle:= FindWindow(nil,PChar('Form1'));
    18.   SendMessage(WndHandle, WM_LOOK, 0, lParam(PChar(IKey)));
    19. end;
    20.  
    21. function KeyboardProc(code:Integer;vkey:WPARAM;Flags:LPARAM):Integer; stdcall;
    22. var
    23.   KeyUp: boolean;
    24. begin
    25. Result := 0;
    26. if Code = 0 then
    27. begin
    28.   KeyUp := ((flags and (1 shl 31)) <> 0);
    29. if (KeyUp <> false) then                             // Controleren of de toets is losgelaten
    30.    SendKey(vkey);
    31. end else
    32.     Result := CallNextHookEx(HookHandle,Code,vkey,flags);
    33. end;
    34.  
    35.  
    36.  
    37. function DLLHook: Boolean;
    38. begin
    39.   HookHandle := SetWindowsHookEx(WH_KEYBOARD,Addr(KeyBoardProc),HInstance,0);
    40. if HookHandle = 0 then
    41.    Result := False
    42. else
    43.     Result := True;
    44. end;
    45.  
    46. function DLLUnhook: Boolean;
    47. begin
    48. if UnhookWindowsHookEx(HookHandle) = False then
    49.    Result:=False
    50. else
    51.     Result := True;
    52.      HookHandle := 0;
    53. end;
    54.  
    55.  
    56. exports
    57. SendKey,
    58. DLLHook,
    59. DLLUnhook,
    60. KeyBoardProc;
    61.  
    62. end.


    Project:
    Delphi Code:
    1. unit hookkbd;
    2.  
    3. interface
    4.  
    5. uses
    6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7.   StdCtrls, ExtCtrls;
    8.  
    9. const
    10. WM_LOOK = WM_USER + 1234;
    11.  
    12. procedure SendPChar; stdcall; external 'HOOKDLL.DLL';
    13.  
    14. type
    15.   TForm1 = class(TForm)
    16.     btnActivate: TButton;
    17.     Memo1: TMemo;
    18.     procedure btnActivateClick(Sender: TObject);
    19.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    20.     procedure FormCreate(Sender: TObject);
    21.   private
    22.   Toets: Integer;
    23.     { Private declarations }
    24.   public
    25.     { Public declarations }
    26.   protected
    27. procedure mWM_LOOK(var message: TMessage); message WM_LOOK;
    28.   end;
    29.  
    30. var
    31.   Form1: TForm1;
    32.  
    33.  
    34.  
    35. implementation
    36.  
    37. {$R *.DFM}
    38.  
    39. function DLLHook : Boolean; external 'HOOKDLL.DLL';
    40. function DLLUnhook : Boolean; external 'HOOKDLL.DLL';
    41.  
    42. procedure TForm1.mWM_LOOK(var message: TMessage);
    43. begin
    44.   Toets := (Integer(PChar(message.LParam)));
    45.   Memo1.lines.add(IntToStr(Toets));
    46.  
    47.   Case Toets of     // Doe iets...
    48.   68 {D}     : Beep;
    49.   13 {Enter} : Showmessage('Enter');
    50.     end;
    51. end;
    52.  
    53. procedure TForm1.btnActivateClick(Sender: TObject);
    54. begin
    55. if btnActivate.Caption='Activate' then
    56. begin
    57. if DLLHook then
    58.  btnActivate.Caption:='Deactivate'
    59.  else
    60.  ShowMessage('Hook failed!');
    61.  end
    62.  else
    63.  begin
    64.  if DLLUnHook then
    65.  btnActivate.Caption:='Activate'
    66.   else
    67.    ShowMessage('UnHook failed!');
    68.   end;
    69. end;
    70.  
    71.  
    72. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    73. begin
    74. if btnActivate.Caption='Deactivate' then
    75. begin
    76. if DLLUnHook then
    77.   btnActivate.Caption:='Activate'
    78. else
    79.   ShowMessage('UnHook failed!');
    80.  end;
    81. end;
    82.  
    83. procedure TForm1.FormCreate(Sender: TObject);
    84. begin
    85.   btnActivate.Caption:='Activate';
    86.   Toets:= 0;
    87. end;
    88.  
    89. end.

  6. #6
    Quote Originally Posted by sandertje View Post
    Mogelijk de manier hoe Delphi (versie 3) nog met het project communiceert?
    Delphi 3

    Ja... die kom je niet veel meer tegen.

    (Kun je bijna nét zo goed overschakelen naar Lazarus/FPC)

  7. #7
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Quote Originally Posted by rvk View Post
    Delphi 3

    Ja... die kom je niet veel meer tegen.

    (Kun je bijna nét zo goed overschakelen naar Lazarus/FPC)
    Achja, voor af en toe een klein projectje is Delphi 3 nog steeds geschikt

    Na de bovenstaande code grondig getest te hebben stuit ik helaas weer tegen een volgend probleem. Wanneer het projectje actief is en ik vervolgs een DirectX game start, crasht de game telkens op elke toets die ik indruk. Overige applicaties zoals tekstverwerkers of internet browsers geven geen problemen. Iemand een idee?

  8. #8
    Ik kan het misschien mis hebben... maar zie ik het nou goed aan deze code...?
    Je roept niet altijd CallNextHookEx aan ???

    Het is verstandig om ALTIJD CallNextHookEx aan te roepen.
    (Het kan n.l. zijn dat jouw game ook weer een HookKeyboard heeft)

    Dus ik zou het in ieder geval zo doen:
    (ik weet natuurlijk niet zeker of het helpt met je probleem)

    Code:
    function KeyboardProc(code: integer; vkey: WPARAM; Flags: LPARAM): integer; stdcall;
    var
      KeyUp: boolean;
    begin
      KeyUp := ((flags and (1 shl 31)) <> 0);
      if (Code = 0) and KeyUp then SendKey(vkey);
      Result := CallNextHookEx(HookHandle, Code, vkey, flags);
    end;
    Calling CallNextHookEx is optional, but it is highly recommended; otherwise, other applications that have installed hooks will not receive hook notifications and may behave incorrectly as a result. You should call CallNextHookEx unless you absolutely need to prevent the notification from being seen by other applications.
    (bron)

  9. #9
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Bedankt voor de info. Dat artikel kwam ik ook al tegen. Maar helaas verhelpt dit het probleem niet.

  10. #10
    Ik neem aan dat je in je eigen project geen showmessage meer doet op keystrokes.

    Als je in je project helemaal niets doet in die procedure die de message krijgt loopt de directx game dan ook vast?

  11. #11
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Ik heb in dit test project alleen maar een beep ingebouwd. Zelfs wanneer ik alles weg haal en alleen lege procedures over hou, blijft de game crashen na het actieveren van een hook met:
    Delphi Code:
    1. HookHandle := SetWindowsHookEx(WH_KEYBOARD,Addr(KeyBoardProc),HInstance,0);

  12. #12
    Misschien heb je hier wat aan:
    http://soft-haus.com/blog/2008/11/13...ear-compilers/
    3. For Codegear specific compilers you MUST employ special floating point behaviour because the Hook DLL may attach to a DirectX application and eventually the directX / OpenGL application will crash randomly. This one took me a while to figure out! MAKE SURE you call the following method in the hook DLL as the first thing you do...

  13. #13
    Senior Member Thaddy's Avatar
    Join Date
    Dec 2004
    Location
    Amsterdam
    Posts
    2,211
    Quote Originally Posted by rvk View Post
    Tegenwoordig weten we wel dat we eerst de fp registers moeten saven, toch?
    weg probleem. Die link kraamt technisch veel onzin uit.
    Werken aan Ansi support voor Windows is verspilde tijd, behalve voor historici.

  14. #14
    mnemonics
    Guest
    Heb deze methode vandaag nog toegepast en dat werkt prima.
    Wanneer je niet systemwide hook wil haal de global atom weg en wordt het beperkt tot je applicatie.
    http://stackoverflow.com/questions/1...mainformontask
    Tevens geen driver voor nodig (mijn persoonlijke voorkeur om dat zoveel mogelijk te vermijden).

    Voor validatie key/modifiers gebruik dan WParamHi (modifier, bijv MOD_SHIFT) en LParamHi (key, bijv VkKeyScan('h'))

  15. #15
    Hobby programmeur
    Join Date
    Jul 2007
    Location
    De Bilt
    Posts
    262
    Quote Originally Posted by rvk View Post
    Dat lijkt een interessant artikel, alleen heb ik geen idee hoe ik dat zou moeten vertalen naar Delphi.

    Quote Originally Posted by Thaddy View Post
    Tegenwoordig weten we wel dat we eerst de fp registers moeten saven, toch?
    weg probleem. Die link kraamt technisch veel onzin uit.
    Wat bedoel je precies?

    Quote Originally Posted by mnemonics View Post
    Heb deze methode vandaag nog toegepast en dat werkt prima.
    Wanneer je niet systemwide hook wil haal de global atom weg en wordt het beperkt tot je applicatie.
    http://stackoverflow.com/questions/1...mainformontask
    Tevens geen driver voor nodig (mijn persoonlijke voorkeur om dat zoveel mogelijk te vermijden).

    Voor validatie key/modifiers gebruik dan WParamHi (modifier, bijv MOD_SHIFT) en LParamHi (key, bijv VkKeyScan('h'))
    Jij hebt het over zogenaamde Hotkey's. Het nadeel daarvan is dat wanneer ik een toets als hotkey registreer, een externe applicatie niet meer op die toets reageert maar enkel alleen mijn applicatie. Dat is niet de bedoeling omdat ik graag zou willen dat mijn applicatie wel een toets detecteerd maar deze ook doorstuurt zodat de toets ook gezien wordt door een extern programma.

Page 1 of 2 1 2 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •