Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Global Keyboard Hook (https://www.delphipraxis.net/168766-global-keyboard-hook.html)

G-Baumstamm 9. Jun 2012 12:30

Global Keyboard Hook
 
Heyho,

mein Programm muss in der Lage sein, Tastendrucke egal in welchem Programm abzufangen & entsprechend darauf zu reagieren.

Dazu benutze ich folgende Prozeduren (habe ich vor ner Weile mal irgendwo gefunden, weiß die Quelle leider gerade nicht mehr, scheint aber was relativ häufig verwendetes zu sein):

Delphi-Quellcode:
procedure TMainForm.FormCreate(Sender: TObject);
begin
  // ...
  InstallHook(Handle);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  // ...
  UninstallHook;
end;

function InstallHook(Hwnd: Cardinal): Boolean; stdcall;
begin
  Result := False;
  if HookHandle = 0 then
  begin
    HookHandle := SetWindowsHookEx(13, LowLevelKeyboardProc, 0, 0);
    WindowHandle := Hwnd;
    Result := HookHandle <> 0;
  end;
end;

function UninstallHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(HookHandle);
  HookHandle := 0;
end;

function LowLevelKeyboardProc(nCode: Integer; wParam: wParam;
    lParam: lParam): LRESULT; stdcall;
  var vkCode: Cardinal;
begin
  if (nCode >= 0) and (wParam = WM_KEYDOWN) then
  begin
    vkCode := PKbdDLLHookStruct(lParam)^.vkCode;
    // meine Anweisungen
  end;
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;
Das ganze funktioniert am Anfang soweit auch. Allerdings habe ich das Problem, dass es das irgendwann einfach nicht mehr tut. Keine Ahnung womit das zusammenhängt. Ich hab das Gefühl, das es eher auftritt wenn das Programm schon ne ganze Weile läuft, es könnte aber genauso gut irgendwas anderes der Auslöser sein.

Also, kann sich irgendwer von euch ein Szenario vorstellen, in dem diese ganze Konstruktion, obwohl sie vorher einwandfrei funktioniert hat, einfach nichts mehr macht (LowLevelKeyboardProc wird nicht mehr aufgerufen) ? Am versehentlichen Aufrufen des Uninstalls kanns nicht liegen, das steht wirklich nur im OnDestroy. Wenn ich, nachdem es nicht mehr geht, allerdings einfach Uninstall und Install hintereinander aufrufe gehts übrigens wieder.

Seltsam ...

Zacherl 10. Jun 2012 05:04

AW: Global Keyboard Hook
 
Tritt das Problem auch auf, wenn du deine eigenen Anweisungen auskommentierst, also nur den hier geposteten Code verwendest?

G-Baumstamm 10. Jun 2012 10:32

AW: Global Keyboard Hook
 
Hey,

kann ich nicht testen, da dann mein Programm überhaupt nicht mehr funktionieren würde. Allerdings kann der Code, der noch im Create & Destroy ist, dafür nicht verantwortlich sein, da es anfangs ja funktioniert.

An meinem Code in der LowLevelKeyboardProc kann es auch nicht liegen, ich habe überprüft, dass sie ab einem Zeitpunkt garnicht mehr aufgerufen wird. Ansonsten ist alles was ich da mache sowieso nur, auf eine bestimmte Taste zu prüfen und ggf. nen Timer zu starten.

//Edit: konkret sieht das so aus:

Delphi-Quellcode:
function LowLevelKeyboardProc(nCode: Integer; wParam: wParam;
    lParam: lParam): LRESULT; stdcall;
  var vkCode: Cardinal;
begin
  if (nCode >= 0) and (wParam = WM_KEYDOWN) then
  begin
    vkCode := PKbdDLLHookStruct(lParam)^.vkCode;
    if (vkCode = Hotkey) and not working then    //Hotkey = vorher defnierte Taste
    begin
      BitmapCount := Project.GetFilesCount(SearchDir, '*.bmp');
      MainForm.StartTimer.Enabled := true;
    end;
  end;
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;

function TProject.GetFilesCount(Folder, WildCard: string): Integer;
var
  intFound: Integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  if (Folder <> '') and (Folder[Length(Folder)] <> '\') then
    Folder := Folder + '\';
  intFound := FindFirst(Folder + WildCard, faAnyFile, SearchRec);
  while (intFound = 0) do
  begin
    if not (SearchRec.Attr and faDirectory = faDirectory) then
      Inc(Result);
    intFound := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TMainForm.StartTimerTimer(Sender: TObject);
  var CurrBitmapCount: integer;
begin
  inc(TimerCount);
  CurrBitmapCount := Project.GetFilesCount(SearchDir, '*.bmp');
  if CurrBitmapCount > BitmapCount then
  begin
    Sleep(200);
    Project.StartWorking(false);
    TimerCount := 0;
    StartTimer.Enabled := false;
  end;
  if TimerCount >= 40 then
  begin
    TimerCount := 0;
    StartTimer.Enabled := false;
  end;
end;
Es soll also überprüft werden, ob ein Screenshot erstellt wurde, indem im entsprechenden Verzeichnis geschaut wird, ob eine neue .bmp dazugekommen ist. Keine Ahnung ob man das eleganter machen könnte, aber so funnktionierts zumindest ...

ConnorMcLeod 10. Jun 2012 11:05

AW: Global Keyboard Hook
 
*) zum Thema globaler Keyboardhook gibt es erschöpfend zu lesen, auch hier im Forum - Stichwort DLL.
*) wenn es einzig darum geht, ein Verzeichnis auf Änderungen zu überwachen, empfehle ich TRxFolderMonitor aus den RX-Tools.

Sir Rufo 10. Jun 2012 11:28

AW: Global Keyboard Hook
 
Bei der Verwendung von Hooks ist man gut beraten wenn man diesen Hook nur minimal bremst.
Die Suche nach Dateien direkt innerhalb des Hooks aufzurufen ist eher kontraproduktiv und sollte daher in einem Thread ausgelagert werden.

EDIT: Hier ein interessanter Artikel zu Hooks und Windows 7 bzgl. TimeOuts, also wenn es dem System zu lange dauert, bis die Nachricht verarbeitet wurde. Das sollte dann auch erklären, warum es zunächst funktioniert :)


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:03 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz