Maus Ereignisse ausserhalb der eigenen Anwendung abfangen

[jmit]

Hallo,

ich habe mir von der Web-Site SwissDelphiCenter.ch den Quellcode von Maus Ereignisse ausserhalb der eigenen Anwendung abfangen heruntergeladen. Beim ersten Start hat das Programm die Mauspositionen in der Listbox ausgegeben. Jeder weitere Start des Programms friert den Rechner ein, bzw. das Programm reagiert nicht mehr. In der Listbox wird nichts mehr ausgegeben. Das Programm reagiert auch nicht mehr auf den Stop-Button.
Beim Aufruf des Taskmanagers wird das Fenster des Programms geschlossen, und der Rechner läuft wieder ohne Probleme.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Button_StartJour: TButton;
    Button_StopJour: TButton;
    ListBox1: TListBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure Button_StopJourClick(Sender: TObject);
    procedure Button_StartJourClick(Sender: TObject);
  private
    { Private-Deklarationen }
    FHookStarted : Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  JHook: THandle;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
  Char1: PChar;
  s: string;
begin
  {this is the JournalRecordProc}
  Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  {the CallNextHookEX is not really needed for journal hook since it it not
  really in a hook chain, but it's standard for a Hook}
  if Code < 0 then Exit;

  {you should cancel operation if you get HC_SYSMODALON}
  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then
  begin
    {
    The lParam parameter contains a pointer to a TEventMsg
    structure containing information on
    the message removed from the system message queue.
    }
    s := '';

    if EventStrut.message = WM_LBUTTONUP then
      s := 'Left Mouse UP at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

    if EventStrut.message = WM_LBUTTONDOWN then
      s := 'Left Mouse Down at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

    if EventStrut.message = WM_RBUTTONDOWN then
      s := 'Right Mouse Down at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

    if (EventStrut.message = WM_RBUTTONUP) then
      s := 'Right Mouse Up at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

    if (EventStrut.message = WM_MOUSEWHEEL) then
      s := 'Mouse Wheel at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

    if (EventStrut.message = WM_MOUSEMOVE) then
      s := 'Mouse Position at X:' +
        IntToStr(EventStrut.paramL) + ' and Y: ' + IntToStr(EventStrut.paramH);

    if s <> '' then
       Form1.ListBox1.ItemIndex :=  Form1.ListBox1.Items.Add(s);
  end;
end;

procedure TForm1.Button_StartJourClick(Sender: TObject);
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 TForm1.Button_StopJourClick(Sender: TObject);
begin
  FHookStarted := False;
  UnhookWindowsHookEx(JHook);
  JHook := 0;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  {the journal hook is automaticly camceled if the Task manager
  (Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it
  when the WM_CANCELJOURNAL is sent to the parent window, Application}
  Handled := False;
  if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then
    JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {make sure you unhook it if the app closes}
  if FHookStarted then
    UnhookWindowsHookEx(JHook);
end;

end.

Ich hoffe ich habe das Problem genügend erklärt.
Ich kann mir nicht erklären, woran es liegt.

Schon einmal schönen Dank für die Unterstützung.

Gruß Jörg

[Wotan89]

Ich bin nicht der Allwissende was Hooks betrifft, aber eigentlich muss für ein globalen Hook die JournalProc-Funktion in eine DLL_Ausgelagert werden. Dies kann ich der Anwendung nicht entnehmen... Versuch mal die JournalProc und die Installation bz.w Deinstallation in eine DLL auszulagern. Die Verarbeitung des Hooks kannst du noch von dem Programm machen lassen, indem du die nötigen Infos per Message an dein Programm schickst.

[sirius]

Hook ist gleich ganz schön viel (ausserdem gibt es einen MouseHook).

Vielleicht reicht dir auch sowas wie setCapturecontrol o.ä.

[Aurelius]

Du kannst dir auch mal JvShellControl von den JEDIS anschauen, damit geht das Ganze auch.