Mousehook

[hanspeter]

Hallo,
ich versuche mit einem Programm, welches im Hintergrund ständig läuft eine Mousetaste abzufangen und eine Reaktion in dem Programm auszulösen.
Das funtioniert, wenn ich den Hook direkt im Programm unterbringe, allerdings nur solange wie das Programm den Focus hat.
Ich habe jetzt den Hook in eine dll ausgelagert.
Mit dem gleichen Code wie im Programm funktiuonierte das nicht.
Ich habe deshalb hier im Forum einen Vorschlag aufgegriffen, der mit OpenFileMapping arbeitet.
Damit geht es erst mal.
Nach Postmessage setze ich in MouseProc WParam auf 0, da die Taste, egal in welchem Programm, keine weitere Wirkung haben soll.
Bei Delphi im Debugmodus kommt der Event immer 2 mal hintereinander. Ein normaler Mausclick im Fenster des Programmes, was den Hook einrichtet, führt zum Rechnerabsturz.
Delphi hängt sich so auf, das nur noch die Resettaste bleibt.
Starte ich das Programm außerhalb von Delphi, kommt der Event nur einmal. Ein anderes Mausereignis im Fenster führt jedoch ebenfalls zum Absturz.

Hier der dll - Code:

Delphi-Quellcode:

library MouseHook;

uses
  Windows,
  Messages;

{$R *.res}

type
  PHWND = ^HWND;

const
  WM_MOUSE_HOOK = WM_USER + 2013;
  WM_Mousekeydown = 523;
  WM_MousekeyUp   = 524;


var
  hHook: LongWord = 0;
  hWndBuffer: PHWND;
  hMMF: THandle;

function MouseProc(nCode: Integer; wParam: LongWord; lParam: LongWord): LongWord; stdcall;
begin
  Result := 0;
  if nCode < 0 then Exit;

  if WParam = WM_Mousekeydown then
  begin
    PostMessage(hwndBuffer^, WM_MOUSE_HOOK, WParam, 0);
    WParam := 0;
  end;
  Result := CallNextHookEx(hHook, nCode, wParam, lParam);
end;

function Mouse_CreateHook(hWnd: HWND): Boolean; stdcall;
var
  bHWND: PHWND;
begin
hMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE or SEC_COMMIT, 0, SizeOf(hWnd), 'EDO-SoftMouseHookHandle');
bHWND := MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, SizeOf(HWND));
bHWND^ := hWnd;
UnmapViewOfFile(bHWND);
GetMem(hWndBuffer, SizeOf(HWND));
hWndBuffer^ := hWnd;
if hHook = 0 then
  hHook := SetWindowsHookEx(WH_MOUSE, @MouseProc, hInstance, 0);
Result := hHook <> 0;
end;

function Mouse_DeleteHook: Boolean; stdcall;
begin
FreeMem(hWndBuffer);
CloseHandle(hMMF);
Result := UnhookWindowsHookEx(hHook);
hHook := 0;
end;

exports
  Mouse_CreateHook,
  Mouse_DeleteHook;

var
  MMF: THandle;

begin
MMF := OpenFileMapping(FILE_MAP_READ, false, 'EDO-SoftMouseHookHandle');
if MMF <> 0 then
  begin
  hWndBuffer := MapViewOfFile(MMF, FILE_MAP_READ, 0, 0, SizeOf(HWND));
  CloseHandle(MMF);
  end;
end.

Vielleicht noch der Hintergrund der Problematik.
Ich habe mir einen USB-Taster gekauft. Dieser generiert eine weitere Mousetaste (254).
Egal in welchem Programm ich gerade bin, soll das Drücken dieser Taste eine akkustische Funktion auslösen.

Hat wer eine Idee?

Gruß
Peter

[Aphton]

Was mir so auffällt - du schließt MMF direkt nach dam Mappen, was fraglich ist. Könnte es nicht sein, dass das für ein automatisches Unmapping sorgt (und somit deinen Pointer ungültig macht)?! Versuch das mal umzuschreiben

[Sir Rufo]

Nimm die LowLevel Variante vom MouseHook, dann geht das auch ohne DLL (wie ich auch hier gelernt habe)

WH_MOUSE_LL
WH_MOUSE_LL

[hanspeter]

Ich habe eigentlich alle Varianten ausprobiert, so oft wie bei diesem Projekt musste ich noch nie die Hardware-Resettaste drücken.
Die dll Variante habe ich aufgegeben, da sie unter Delphi wohl nicht zum Laufen zu bekommen ist und bin zu einem JournalHook gewechselt.
Das scheint problemlos zu funktionieren, auch der vorher mehrfach gekommene Event kommt jetzt richtig.
Hier die Lösung:

Delphi-Quellcode:

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
  Char1: PChar;
begin
  Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  if Code < 0 then Exit;

  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then
  begin
    if EventStrut.message = 523 then
    begin
      EventStrut.message := 0;
      inc(GongBums);
    end;
  end;
end;

procedure TFrmAudioCtrl.StartJour;
begin
  if FHookStarted then
  begin
    ShowMessage('Mouse is already being Journaled, can not restart');
    Exit;
  end;
  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
  {SetWindowsHookEx starts the Hook}
  if JHook > 0 then
  begin
    FHookStarted := True;
  end
  else
    ShowMessage('No Journal Hook availible');
end;

procedure TFrmAudioCtrl.StopJour;
begin
  FHookStarted := False;
  UnhookWindowsHookEx(JHook);
  JHook := 0;
end;

Interessenhalber habe ich die Hooklösung in externer dll mal in C# und VS2010 ausprobiert.
Dort funktionierte es wie gewünscht.
Da ich in meinem Legacy Projekt keinen Code mischen will, bin ich auf die beschriebene Lösung ausgewichen.

Peter

[Aphton]

Im Grunde hat das mit Delphi per se nichts zu tun. Es ist ein Programmier- und kein Sprachfehler! Ich habe selber bereits Hooks unzählige Male in "Delphi" implementiert...

[hanspeter]

Zitat von Aphton:

Im Grunde hat das mit Delphi per se nichts zu tun. Es ist ein Programmier- und kein Sprachfehler! Ich habe selber bereits Hooks unzählige Male in "Delphi" implementiert...

Mit Delphi hat es schon zu tun.
Der Debugger (XE2) scheint nicht mit Hooks umgehen zu können. Sobald in dem Programm ein break vorhanden ist, hängt sich die IDE auf (XE2).
Außerhalb der IDE läuft das Programm.
Das es ein Sprachfehler ist, habe ich nie behauptet.
Programmierfehler ja, da gibt es noch unzählige in Delphi (siehe Quality-central).

[Assarbad]

Zitat von hanspeter:

Mit Delphi hat es schon zu tun.
Der Debugger (XE2) scheint nicht mit Hooks umgehen zu können. Sobald in dem Programm ein break vorhanden ist, hängt sich die IDE auf (XE2).

Nicht alles was man in einem Debugger ausführen kann, sollte man auch dort ausführen. Für derlei Zwecke kann man noch immer OutputDebugString und Freunde einsetzen und einen Debugger oder ein Programm wie DebugView mitlaufen lassen welches die Nachrichten anzeigt. Breakpoints kann man schon setzen, setzt man sie aber strategisch falsch muß man mit den Konsequenzen leben. Mit Delphi hat das erstmal grundsätzlich nichts zu tun - kann aber zusätzlich auf einen Fehler im Delphi-Debugger hinweisen (das will ich nicht ausschließen).