Delphi-PRAXiS - Delphi [Vista][gelöst] Maus Ereignisse ausserhalb eigener Anwendung

Ollis Beispiel ist zwar sehr geil, aber leider für Laien absolut undurchblickbar.

Bin trotzdem gerade auf die Lösung gestoßen:

http://www.delphi3000.com/articles/article_3895.asp?SK=
Klappt unter Vista auch, bis auf das Mausrad. Fix anyone?

Falls die Seite mal down ist:
DLL-Code:

Delphi-Quellcode:

			library HookMouse;

{Demo de Hook de Ratón a nivel de sistema, Radikal.}

uses Windows, Messages;

const

CM_MANDA_DATOS = WM_USER + $1000;

type

TCompartido = record

   Receptor,

   wHitTestCode,

   x,y,

   Ventana         : hwnd;

end;

PCompartido   =^TCompartido;

var

HookDeMouse  : HHook;

FicheroM     : THandle;

Compartido   : PCompartido;

function CallBackDelHook( Code    : Integer;

                          wParam  : WPARAM;

                          lParam  : LPARAM

                          )       : LRESULT; stdcall;

var

  DatosMouse     : PMouseHookStruct;

  Intentos       : integer;

{Esta es la funcion CallBack a la cual llamará el hook.}

{This is the CallBack function called by he Hook}

begin

{Si hay un nuevo evento de raton...}

{if there is a new mouse event...}

if code=HC_ACTION then

begin

  {Miramos si existe el fichero}

  {if the mapfile exists}

  FicheroM:=OpenFileMapping(FILE_MAP_WRITE,False,'ElReceptor');

  {Si no existe, no enviamos nada a la aplicacion receptora}

  {If dont, send nothing to receiver application}

  if FicheroM<>0 then

  begin

    Compartido:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);

    {Apuntamos hacia los datos del evento del raton}

    DatosMouse:=Pointer(lparam);

    {Los guardamos en el fichero de memoria}

    Compartido^.Ventana:=DatosMouse^.hwnd;

    Compartido^.x:=DatosMouse^.pt.x;

    Compartido^.y:=DatosMouse^.pt.y;

    {Avisamos al receptor para que atienda el nuevo evento}

    {Say to receiver that there is a new event}

    PostMessage(Compartido^.Receptor,CM_MANDA_DATOS,wParam,lParam);

    UnmapViewOfFile(Compartido);

    CloseHandle(FicheroM);

  end;

end;

{Llamamos al siguiente hook de la cadena}

{call to next hook of the chain}

Result := CallNextHookEx(HookDeMouse, Code, wParam, lParam)

end;

procedure HookOn; stdcall;

{Procedure que instala el hook}

{procedure for install the hook}

begin

  HookDeMouse:=SetWindowsHookEx(WH_MOUSE, @CallBackDelHook, HInstance , 0);

end;

// stops this type of watch

procedure HookOff;  stdcall;

begin

{procedure para desinstalar el hook}

{procedure to uninstall the hook}

  UnhookWindowsHookEx(HookDeMouse);

end;

exports

{Exportamos las procedures...}

{Export the procedures}

HookOn,

HookOff;

begin

end.

Programm-Code:

Delphi-Quellcode:

			unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, ExtCtrls;

const

  NombreDLL       = 'HookMouse.dll';

  CM_MANDA_DATOS  = WM_USER + $1000;

type

TCompartido = record

   Receptor,

   wHitTestCode,

   x,y,

   Ventana         : hwnd;

end;

PCompartido   =^TCompartido;

THookMouse=procedure; stdcall;

type

  TForm1 = class(TForm)

    Memo1: TMemo;

    Panel1: TPanel;

    Label1: TLabel;

    Label2: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    { Private declarations }

    FicheroM       : THandle;

    Compartido     : PCompartido;

    HandleDLL      : THandle;

    HookOn,

    HookOff        : THookMouse;

    procedure LlegaDelHook(var message: TMessage); message  CM_MANDA_DATOS;

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

  HandleDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+

                                NombreDLL ) );

  if HandleDLL = 0 then raise Exception.Create('No se pudo cargar la DLL');

  @HookOn :=GetProcAddress(HandleDLL, 'HookOn');

  @HookOff:=GetProcAddress(HandleDLL, 'HookOff');

  if not assigned(HookOn) or

     not assigned(HookOff)  then

     raise Exception.Create('No se encontraron las funciones en la DLL'+#13+

                            'Cannot find the required DLL functions');

  {Creamos el fichero de memoria}

  FicheroM:=CreateFileMapping( $FFFFFFFF,

                              nil,

                              PAGE_READWRITE,

                              0,

                              SizeOf(Compartido),

                              'ElReceptor');

   {Si no se creó el fichero, error}

   if FicheroM=0 then

     raise Exception.Create( 'Error al crear el fichero'+

                             '/Error while create file');

   {Direccionamos nuestra estructura al fichero de memoria}

   Compartido:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);

   {Escribimos datos en el fichero de memoria}

   Compartido^.Receptor:=Handle;

   HookOn;

end;

procedure TForm1.LlegaDelHook(var message: TMessage);

var

  DatosMouse     : PMouseHookStruct;

  NombreVentana  : array [0..200] of char;

  Accion         : string;

begin

  with Compartido^ do

  begin

    {Coordenadas del raton}

    {Mouse coordinates}

    Label1.caption:='['+IntToStr(x)+':'+IntToStr(y)+']';

  end;

  {Nombre de la ventana donde esta el raton}

  {Window Name}

  GetWindowText(Compartido^.Ventana,@NombreVentana,200);

  Label2.Caption:=NombreVentana;

  case Message.wParam of

    WM_LBUTTONDBLCLK     : Accion:='WM_LBUTTONDBLCLK  ';

    WM_LBUTTONDOWN  : Accion:='WM_LBUTTONDOWN    ';

    WM_LBUTTONUP         : Accion:='WM_LBUTTONUP      ';

    WM_MBUTTONDBLCLK     : Accion:='WM_MBUTTONDBLCLK  ';

    WM_MBUTTONDOWN       : Accion:='WM_MBUTTONDOWN    ';

    WM_MBUTTONUP         : Accion:='WM_MBUTTONUP      ';

    WM_MOUSEMOVE         : Accion:='WM_MOUSEMOVE      ';

    WM_NCHITTEST         : Accion:='WM_NCHITTEST      ';

    WM_NCLBUTTONDBLCLK   : Accion:='WM_NCLBUTTONDBLCLK';

    WM_NCLBUTTONDOWN     : Accion:='WM_NCLBUTTONDOWN  ';

    WM_NCLBUTTONUP       : Accion:='WM_NCLBUTTONUP    ';

    WM_NCMBUTTONDBLCLK   : Accion:='WM_NCMBUTTONDBLCLK';

    WM_NCMBUTTONDOWN     : Accion:='WM_NCMBUTTONDOWN  ';

    WM_NCMBUTTONUP       : Accion:='WM_NCMBUTTONUP    ';

    WM_NCMOUSEMOVE       : Accion:='WM_NCMOUSEMOVE    ';

    WM_NCRBUTTONDBLCLK   : Accion:='WM_NCRBUTTONDBLCLK';

    WM_NCRBUTTONDOWN     : Accion:='WM_NCRBUTTONDOWN  ';

    WM_NCRBUTTONUP       : Accion:='WM_NCRBUTTONUP    ';

    WM_RBUTTONDBLCLK     : Accion:='WM_RBUTTONDBLCLK  ';

    WM_RBUTTONDOWN       : Accion:='WM_RBUTTONDOWN    ';

    WM_RBUTTONUP         : Accion:='WM_RBUTTONUP      ';

  end;

  Memo1.Lines.Append(Accion);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{Desactivamos el Hook}

{Uninstall the Hook}

if Assigned(HookOff) then HookOff;

{Liberamos la DLL}

{Free the DLL}

if HandleDLL<>0 then

  FreeLibrary(HandleDLL);

{Cerramos la vista del fichero y el fichero}

{Close the memfile and the View}

if FicheroM<>0 then

begin

   UnmapViewOfFile(Compartido);

   CloseHandle(FicheroM);

end;

end;

end.