[Vista][gelöst] Maus Ereignisse ausserhalb eigener Anwendung

[The Riddler]

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.