unit U_Mouse;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms,
StdCtrls, ExtCtrls;
type TmyPanel=class(TCustomPanel)
constructor create(AOwner:TComponent; FocusedWindow:TWinControl);
reintroduce;
destructor Destroy;
override;
private
FPage:pointer;
//zeigt auf Adresse, die mit virtualalloc reserviert wird
FSize:integer;
//größe des reservierten Speichers
//für Hookvariante
FHook:hhook;
//Handle des Hooks
//für SubclassingVariante
FFocusedWindowHandle:hwnd;
//Handle des Windows (Formulars) zum subclassen
FOldwndProc:integer;
//alte WndProc des Formulars
//Methode auf die alle Messages vom übergeordneten Formular gehen sollen
procedure wndProcEx(
var message:tmessage);
end;
type
TForm1 =
class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
panel1:Tmypanel;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var Form:TCustomForm;
begin
//erzeugen des Panels
Form:=getparentform(self);
panel1:=tmypanel.Create(self,Form);
panel1.Parent:=self;
panel1.Left:=10;
panel1.Top:=10;
panel1.width:=200;
panel1.Height:=200;
end;
//jetzt folgen die zwei Varianten (subclassing und lokaler hook)
//EINE MUSS AUSKOMMENTIERT WERDEN
{********** Variante Subclassing ****************}
//vor scWndProc stehen noch folgende Variablen:
//@CallWindowProc
//FOldwindowproc
//@wndprocEx
//form1
function SCwndProc(wnd,msg,wparam,lparam:integer):integer;
stdcall;
//Code (etwa):
//var x:Tmessage
//begin
//x.msg:=msg; x.wparam:=wparam; x.lparam:=lparam;
//wndprocex(x);
//if result<=0 then result:=CallWindowproc(FoldWindowProc,wnd,msg,wparam,lparam);
//end;
asm
call @@n
@@n:
pop ecx
sub ecx,8
mov eax,dword ptr [ecx-4]
push ecx
xor edx,edx
push edx
push lparam
push wparam
push msg
mov edx,esp
call [ecx-8]
//Methodenaufruf (wndprocEx) EAX=form1; EDX=x:Tmessage
pop ecx
pop ecx
pop ecx
pop eax
pop ecx
cmp eax,0
jg @@1
push ecx
push lparam
push wparam
push msg
push wnd
push [ecx-12]
call [ecx-16]
pop ecx
@@1:
end;
procedure endpoint;
asm nop
end;
constructor tmypanel.create(AOwner:TComponent; FocusedWindow:TWinControl);
var size:integer;
page:pointer;
proc:pointer;
begin
inherited create(AOwner);
size:=integer(@endpoint)-integer(@SCwndProc);
Fsize:=size+16;
page:=virtualalloc(
nil,Fsize,Mem_commit,Page_execute_readwrite);
FPage:=page;
FoldwndProc:=getwindowlong(FocusedWindow.Handle,gwl_wndproc);
asm
//Adresse von Callwindowproc in Win-API ermitteln
push eax
lea eax,dword ptr windows.Callwindowproc
add eax,2
mov eax,[eax]
mov eax,[eax]
mov proc,eax
pop eax
end;
move(proc,page^,4);
asm add page,4
end;
move(Foldwndproc,page^,4);
asm
//Adresse aus Methodenzeiger holen
push eax
lea eax,dword ptr wndprocex
mov proc,eax
pop eax
end;
asm add page,4
end;
move(proc,page^,4);
asm add page,4
end;
move(self,page^,4);
asm add page,4
end;
move(Scwndproc,page^,size);
FfocusedwindowHandle:=focusedwindow.Handle;
setwindowlong(focusedwindow.Handle,gwl_wndproc,integer(Page));
end;
destructor tmypanel.Destroy;
begin
setwindowlong(FfocusedwindowHandle,gwl_wndproc,integer(FOldWndProc));
virtualfree(fPage,Fsize,mem_decommit);
inherited destroy;
end;
{******* Variante Hook **************}
////vor hookproc stehen noch folgende Variablen:
//form1
//@CallnextHookEx
//@wndprocEx
//hookhandle = Fhook
function realHookProc(addr:ppointer;code,wparam,lparam:integer):integer;
stdcall;
forward;
procedure HookProc;
//ergänzen von addr in der Parameterliste mit der Adresse der Funktion
//um auf die 4 Variablen vor der Funktion zugreifen zu können
asm
call @@n
@@n:
pop eax
sub eax,5
pop edx
push eax
push edx
jmp realhookproc
end;
function realHookProc(addr:ppointer;code,wparam,lparam:integer):integer;
stdcall;
var CallNexthook:
function(hhk:hhook;code,wparam,lparam:integer):integer;
stdcall;
hookhandle:hhook;
oldwindowproc:pointer;
obj:Tobject;
mymsg:pmsg;
msg:Tmessage;
wndprocresult:integer;
begin
//die 4 Variablen von vor der Funktion holen
dec(addr);
obj:=addr^;
dec(addr);
callnexthook:=addr^;
dec(addr);
oldwindowproc:=addr^;
dec(addr);
hookhandle:=cardinal(addr^);
if code=hc_action
then begin
mymsg:=pmsg(lparam);
msg.Msg:=mymsg.
message;
msg.WParam:=mymsg.wParam;
msg.LParam:=mymsg.lParam;
msg.Result:=0;
asm
//aus Adressen wieder einen Methodenaufruf realisieren
mov eax,dword ptr obj
lea edx,dword ptr msg
call oldwindowproc
mov wndprocresult,eax
end;
end;
if hookhandle<>0
then result:=callnexthook(hookhandle,code,wparam,lparam)
else result:=wndprocresult;
end;
procedure endpoint;
asm nop
end;
constructor tmypanel.create(AOwner:TComponent; FocusedWindow:TWinControl);
var size:integer;
page:pointer;
proc:pointer;
hookhandle:hhook;
begin
inherited create(AOwner);
hookhandle:=0;
size:=integer(@endpoint)-integer(@Hookproc);
Fsize:=size+16;
page:=virtualalloc(
nil,Fsize,Mem_commit,Page_execute_readwrite);
FPage:=page;
move(hookhandle,page^,4);
asm add page,4
end;
asm
push eax
lea eax,dword ptr wndprocex
mov proc,eax
pop eax
end;
move(proc,page^,4);
asm add page,4
end;
asm
push eax
lea eax,dword ptr windows.CallNexthookEx
add eax,2
mov eax,[eax]
mov eax,[eax]
mov proc,eax
pop eax
end;
move(proc,page^,4);
asm add page,4
end;
move(self,page^,4);
asm add page,4
end;
move(hookproc,page^,size);
fhook:=setwindowshookex(wh_getmessage,page,0,getcurrentthreadid);
move(fhook,fpage^,4);
end;
destructor tmypanel.Destroy;
begin
unhookwindowshookex(fhook);
virtualfree(fPage,Fsize,mem_decommit);
inherited destroy;
end;
{**** meine neue/alternative WindowProc ************}
procedure tmypanel.wndProcEx(
var message:Tmessage);
var form:tform1;
begin
form:=tform1(self.Parent);
if (
message.Msg=wm_mousewheel)
then begin
form.ListBox1.Items.Add('
Wheel: '+inttostr(smallint(
message.wparamhi)));
while form.ListBox1.Items.count>30
do form.ListBox1.Items.Delete(0);
end;
end;
end.