Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Wiedermal Maushook (https://www.delphipraxis.net/92437-wiedermal-maushook.html)

ghost007 19. Mai 2007 18:46


Wiedermal Maushook
 
Hallo,
ich verwende folgenden code von den schweizern:

Delphi-Quellcode:
unit Unit1;

interface

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

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

var
  Form1: TForm1;


implementation

{$R *.dfm}

var
  JHook: THandle;

// The JournalRecordProc hook procedure is an application-defined or library-defined callback
// function used with the SetWindowsHookEx function.
// The function records messages the system removes from the system message queue.
// A JournalRecordProc hook procedure does not need to live in a dynamic-link library.
// A JournalRecordProc hook procedure can live in the application itself.

// WH_JOURNALPLAYBACK Hook Function

//Syntax

// JournalPlaybackProc(
// nCode: Integer; {a hook code}
// wParam: WPARAM; {this parameter is not used}
// lParam: LPARAM {a pointer to a TEventMsg structure}
// ): LRESULT; {returns a wait time in clock ticks}


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);//<-------------------------hier bei dem "@JournalProc"
  {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.
Um an die events der maus zu kommen.
Wenn ich den code aber mal testcompilieren will, bekomm ich folgenden Error:

Zitat:

Zitat von Delphi 7
Undeclared Identifier: "JournalProc"

In der oben im code gekennzeichneten zeile.
Wo is hier der wurm drin ?!

MfG - Ghost007

halinchen 19. Mai 2007 18:58

Re: Wiedermal Maushook
 
Vielleicht so?

Delphi-Quellcode:
unit Unit1;

interface

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

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

var
  Form1: TForm1;
  //////////
  function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
  //////////
implementation

...

ghost007 19. Mai 2007 20:57

Re: Wiedermal Maushook
 
hm, jetzt läufts zwar, aber die application friert komplett ein, und windows auch, es geht nur noch der taskmanager über STRG + ALT + Entf

halinchen 20. Mai 2007 10:09

Re: Wiedermal Maushook
 
Ich hab genau deinen Code genommen und er geht.
Ich kann die Form während der Laufzeit verschieben, vergrößern, also wie normal.

[ot] Du wirst es nicht glauben, genau das habe ich schon wieder gesucht! Vielleicht haben wie ja das selbe Projekt :mrgreen: [/ot]

ghost007 20. Mai 2007 10:18

Re: Wiedermal Maushook
 
lol nu geht der code bei mir auch .... anscheinend darf man den hook nich zu oft ein/ausschalten während einer session >_>

MfG - Ghost007

P.S.:Was haste denn für 'n projekt ?!

halinchen 20. Mai 2007 10:27

Re: Wiedermal Maushook
 
Zitat:

Zitat von ghost007
P.S.:Was haste denn für 'n projekt ?!

Ein Programm zum Anzeigen aller Handles, Prozesse und Systeminformationen. Und dann halt auch das Feature "Fenster unter der Maus bestimmen".

ghost007 20. Mai 2007 10:33

Re: Wiedermal Maushook
 
achso, ne ich bau ein applet für die G15 tastatur von logitech (die mit dem LCD) ;) auf dem LCD sollen tasten anschläge und mausstats angezeigt werden ;)

MfG - Ghost007

halinchen 20. Mai 2007 17:01

Re: Wiedermal Maushook
 
Achso ja. Hätte ich auch drauf kommen können. Das Thema "Terminal-Font" hab ich auch gelesen. :wall: :wall: :mrgreen:

halinchen 27. Mai 2007 13:25

Re: Wiedermal Maushook
 
Ich hab einen Fehler entdeckt: :mrgreen:
Bei ApplicationEvents1Message:

JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0 hInstance, 0);

Sonst geht der Hook nach Strg-Alt-Entf nicht mehr...

Hier der gesamte Code:

Delphi-Quellcode:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  Handled := False;
  if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then
    //falsch:
    //JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
    //richtig:
    JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
end;

stoxx 7. Jun 2007 05:28

Re: Wiedermal Maushook
 
bei mir friert die Anwendung ständig ein, wenn ich das Programm mit Windows booten lasse, und ein paar Fenster geöffnet sind, dann eigentlich immer ohne Ausnahme.
Obwohl ich diesen Tip schon berücksichtigt habe:

http://www.experts-exchange.com/Prog..._20550935.html

an was kann das noch liegen?

vielen Dank !!

Delphi-Fan-Friedrichsdorf 8. Jun 2007 14:42

Re: Wiedermal Maushook
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo halinchen,
wenn du das Fensterhandle unter der Maus willst brauchst du keine Maushook.
Ich benutze Delphi 5 und mach das so:

Delphi-Quellcode:
procedure TForm1.Timer1Timer(Sender: TObject);// Interval so klein wie möglich(,aber nicht kleiner als 200 würde ich sagen, sonst wird es zu langsam.)

var pos:TPoint;
    h:THandle;
    WinCaption : string;
    Len: integer;
begin

GetCursorPos(pos); //Mausposition abfragen
h:=WindowFromPoint(pos); //Fenster-handle an dieser Position speichern

Label1.Caption:='Mausposition: '+IntToStr(pos.x)+'/'+IntToStr(pos.y); //Nich so wichtig: Mausposition anzeigen

if h>0 then //Handle prüfen
begin

 Len := GetWindowTextLength(h); //Titellänge abfragen
 SetLength(WinCaption, Len); //Länge setzen
 GetWindowText(h, PChar(WinCaption), Len+1); //Text holen

 Label2.Caption:='Fenstertitel: '+WinCaption; //Titel anzeigen

end else Label2.Caption:='Fenstertitel: Kein Titel'; //Fehlerbehandlung

end;

SirThornberry 8. Jun 2007 14:53

Re: Wiedermal Maushook
 
also wenn ich mir das Beispiel angucke bekomm ich Angst. :shock: Da wird doch nicht etwa in jeden gehookten Prozess noch ein Form mit gepackt? Leider ist das Projekt unvollständig so das man auch nicht sehen kann ob das Form auch in jedem Prozess instanziert wird mit Laden der dll. Wenn dem nicht so ist bekomme ich noch mehr angst weil dann in jedem Prozess eine Zugriffsverletzung vorprogrammiert ist.
Wer solche Dinge nutzt sollte tunlichst auch wissen was er da macht!

bitsetter 8. Jun 2007 15:11

Re: Wiedermal Maushook
 
Zitat:

Zitat von SirThornberry
Leider ist das Projekt unvollständig so das man auch nicht sehen kann ob das Form auch in jedem Prozess instanziert wird mit Laden der dll. Wenn dem nicht so ist bekomme ich noch mehr angst weil dann in jedem Prozess eine Zugriffsverletzung vorprogrammiert ist.
Wer solche Dinge nutzt sollte tunlichst auch wissen was er da macht!

Hallo,

warum unvollständig, in Beitrag #1 ist doch der komplette Code. :gruebel:

halinchen 8. Jun 2007 15:22

Re: Wiedermal Maushook
 
Zitat:

Zitat von SirThornberry
also wenn ich mir das Beispiel angucke bekomm ich Angst. :shock: Da wird doch nicht etwa in jeden gehookten Prozess noch ein Form mit gepackt? Leider ist das Projekt unvollständig so das man auch nicht sehen kann ob das Form auch in jedem Prozess instanziert wird mit Laden der dll. Wenn dem nicht so ist bekomme ich noch mehr angst weil dann in jedem Prozess eine Zugriffsverletzung vorprogrammiert ist.
Wer solche Dinge nutzt sollte tunlichst auch wissen was er da macht!

Falls du den Code meinst, den ich benutze:

Ähm,... Wieso DLL? Bei einem Journal-Hook ist der Hook doch in der Exe drin und wird nicht in jeden anderen Prozess geladen. Oder hab ich da was total falsch verstanden?

Zugriffsverletzungen hab ich bisher noch nicht gehabt.

[Wennfalschdannbitteberichtigen-Modus]
Und selbst wenn:Ein Journal-Hook geht nur in einer EXE, wofür ist der sonst gedacht?
[/Wennfalschdannbitteberichtigen-Modus]
Falls ich total auf den Schlauch stehe bin ich natürlich lernfähig. (D.h. das oben war in _keiner_ Hinsicht böse, abfällig oder sonstwas gemeint.)

Zitat:

Zitat von Delphi-Fan-Friedrichsdorf
Hallo halinchen,
wenn du das Fensterhandle unter der Maus willst brauchst du keine Maushook.
Ich benutze Delphi 5 und mach das so:

So hatte ich es bisher auch. Aber 1. brauch ich den Hook noch für was anderes und 2. Ist es doch so besser, da es sofort angezeigt wird.

SirThornberry 8. Jun 2007 15:56

Re: Wiedermal Maushook
 
hmm, jetzt bin ich verwirrt - Auszug aus der Hilfe:
Zitat:

The JournalRecordProc hook procedure is an application-defined or library-defined callback function
Naja, hab ich auch mal was dazu gelernt, ich hatte anfangs doch Angst was da abgeht.
Allerdings sollte man dann mit SetWindowsHookEx auch angeben das die Funktion nur im aktuellen Thread ist. (sollte ja dann immer noch funktionieren und man fährt kein Risiko das es nach einem Windows-Update nicht mehr funktioniert)

halinchen 8. Jun 2007 16:01

Re: Wiedermal Maushook
 
Zitat:

Zitat von SirThornberry
Allerdings sollte man dann mit SetWindowsHookEx auch angeben das die Funktion nur im aktuellen Thread ist.

Ich schätze du meinst als letzten Parameter GetCurrentThread (oder GetCurrentThreadID) zu nehmen.
Ich teste das sofort mal. Aber logischerweise sollte der Hook dann nicht mehr global funktionieren...

[edit]
Delphi-Quellcode:
JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, GetCurrentThread);
oder
Delphi-Quellcode:
JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, GetCurrentThreadID);
So funktioniert der Hook überhaupt nicht mehr.
[/edit]

stoxx 9. Jun 2007 10:11

Re: Wiedermal Maushook
 
mal noch eine andere Bemerkung, unter Vista funktioniert der Hook nicht mehr.
Soll das so sein, oder gibts da eine anderen Lösung.
Sind diese und andere Hooks jetzt generell abgeschafft worden?
WH_Mouse geht nämlich auch nicht mehr ... hmm

Coder1990 29. Jul 2008 12:34

Re: Wiedermal Maushook
 
Hi

habe das selbe Problem wie Halinchen hatte bzw. vll heute noch hat.

Delphi-Quellcode:
FMouseHook := SetWindowsHookEx(WH_JOURNALRECORD, @TFMain.JournalProc, hInstance, 0);
verursacht Freeze...
warum?

MfG

The Riddler 9. Nov 2008 18:38

Re: Wiedermal Maushook
 
Zitat:

Zitat von stoxx
mal noch eine andere Bemerkung, unter Vista funktioniert der Hook nicht mehr.
Soll das so sein, oder gibts da eine anderen Lösung.
Sind diese und andere Hooks jetzt generell abgeschafft worden?
WH_Mouse geht nämlich auch nicht mehr ... hmm

Ich greife die Frage mal auf. Ich suche für meine Anwendung eine Möglichkeit auf Maustasten zu reagieren, bräuchte also einen Mouse-Hook für WinXP und Vista. Gibt es da noch nichts? :-(


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:53 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