Ganchos globales de teclado y raton

[jocaro]

Hola

A partir de distintos códigos vistos en internet he preparado una DLL y un form de delphi para capturar eventos de teclado y ratón de otras aplicaciones
He conseguido recoger información de eventos de teclado y, en algun momento, también de ratón, pero he debido cambiar algo y ahora sólo recibo los eventos de teclado

Si alguien me puede ayudar a continuación va el código de la Dll y del form

Código Delphi [-]

{DLL}

library Ganchos;

uses
  Windows, Messages, StrUtils, SysUtils, Math;

const
  MENSAJE_TECLA = WM_USER + $1000;
  MENSAJE_RATON = WM_USER + $2000;

var
  GanchoDeTeclado: HHook;
  GanchoDeRaton: HHook;
  FichMem: THandle;
  PReceptor: ^Integer;

function IntToBin(valor,digitos:integer):string;
 var
  resultado:string;
  i:integer;
 begin
  if digitos>32 then
   digitos:=32;
  Resultado:='';
  i:=0;
  while i< digitos do
  begin
   if ((1 shl i) AND valor)>0 then
    Resultado:='1'+resultado
   else
    Resultado:='0'+resultado;
   inc(i);
  end;
  Result:=resultado;
 end;

{Esta es la funcion CallBack a la cual llamará el Gancho de teclado.}
function CallBackDelGanchoDeTeclado( Code: Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;

begin

  { Si se ha producido una acción de pulsación de tecla }
  if (code=HC_ACTION) and
     (((lParam shr 31) and 1)<>1) and
     (((lParam shr 30) and 1)<>1) then
  begin

    {Miramos si existe el fichero de memoria}
    FichMem:=OpenFileMapping(FILE_MAP_READ,False,'Intercambio');
    {Si no existe, no enviamos nada a la aplicacion receptora}
    if FichMem > 0 then
    begin

      { Pasar como wParam del sendmessage el manejador de ventana activa y habrá
        que mantener el wParam original para enviarlo tal cual al CallNextHookEx }

      { Cargar objeto de datos de la pulsación para enviar mensaje }
      PReceptor:=MapViewOfFile(FichMem,FILE_MAP_READ,0,0,0);
      PostMessage(PReceptor^, MENSAJE_TECLA, GetforegroundWindow, lParam);
      UnmapViewOfFile(PReceptor);
      CloseHandle(FichMem);
    end;
  end;

  {Llamamos al siguiente Gancho de teclado de la cadena}
  Result := CallNextHookEx(GanchoDeTeclado, Code, wParam, lParam);

end;

{Esta es la funcion CallBack a la cual llamará el Gancho de ratón.}
function CallBackDelGanchoDeRaton( Code: Integer;
                          wParam  : WPARAM;
                          lParam  : LPARAM
                          )       : LRESULT; stdcall;

begin
  OutputDebugString( pwidechar(Code) );
  OutputDebugString( pwidechar(wparam) );
  OutputDebugString( pwidechar(lParam) );

  { Si se ha producido una acción y es click izquierdo ratón }
  if (code=HC_ACTION) then
  begin
    OutputDebugString( 'hc_action' );

    {Miramos si existe el fichero de memoria}
    FichMem:=OpenFileMapping(FILE_MAP_READ,False,'Intercambio');
    {Si no existe, no enviamos nada a la aplicacion receptora}
    if FichMem > 0 then
    begin

      { ?? }

      OutputDebugString( 'fichmem' );

      { Cargar objeto de datos de la pulsación para enviar mensaje }
      PReceptor:=MapViewOfFile(FichMem,FILE_MAP_READ,0,0,0);
      PostMessage(PReceptor^, MENSAJE_RATON, wParam, lParam);
      UnmapViewOfFile(PReceptor);
      CloseHandle(FichMem);
    end;
  end;

  {Llamamos al siguiente Gancho de ratón de la cadena}
  Result := CallNextHookEx(GanchoDeRaton, Code, wParam, lParam);

end;

{Procedure que instala el Gancho de teclado}
procedure GanchoDeTecladoOn; stdcall;
begin
  GanchoDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelGanchoDeTeclado, HInstance, 0);
end;

{procedure para desinstalar el Gancho de teclado}
procedure GanchoDeTecladoOff;  stdcall;
begin
  UnhookWindowsHookEx(GanchoDeTeclado);
end;

{Procedure que instala el Gancho de ratón}
procedure GanchoDeRatonOn; stdcall;
begin
  GanchoDeRaton:=SetWindowsHookEx(WH_MOUSE, @CallBackDelGanchoDeRaton, HInstance, 0);
end;

{procedure para desinstalar el Gancho de ratón}
procedure GanchoDeRatonOff;  stdcall;
begin
  UnhookWindowsHookEx(GanchoDeRaton);
end;

exports
{Exportamos las procedures...}
GanchoDeTecladoOn,
GanchoDeTecladoOff,
GanchoDeRatonOn,
GanchoDeRatonOff;

begin
end.

Código Delphi [-]

{PAS}

unit SimPul;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Vcl.ComCtrls;

const
  NombreDLL = 'Ganchos.dll';
  MENSAJE_TECLA = WM_USER + $1000;
  MENSAJE_RATON = WM_USER + $2000;

type
  TGanchoTeclado=procedure; stdcall;
  TGanchoRaton=procedure; stdcall;

type
  TVent = class(TForm)
    LiPuVi: TListView;
    procedure CrearForm(Sender: TObject);
    procedure DestruirForm(Sender: TObject);
  private
    { Private declarations }
    FichMem: THandle;
    PuntRecept: ^Integer;
    ManejDLL: THandle;
    GanchoDeTecladoOn, GanchoDeTecladoOff: TGanchoTeclado;
    GanchoDeRatonOn, GanchoDeRatonOff: TGanchoRaton;

    procedure LlegaDelGanchoDeTeclado(var message: TMessage); message  MENSAJE_TECLA;
    procedure LlegaDelGanchoDeRaton(var message: TMessage); message  MENSAJE_RATON;

  public
    { Public declarations }

  end;

var
  Vent: TVent;
  LisIte: TListItem;

implementation

{$R *.DFM}

procedure TVent.CrearForm(Sender: TObject);
begin

  ManejDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+
                                NombreDLL ) );
  if ManejDLL = 0 then raise Exception.Create('No se pudo cargar la DLL');

  @GanchoDeTecladoOn :=GetProcAddress(ManejDLL, 'GanchoDeTecladoOn');
  @GanchoDeTecladoOff:=GetProcAddress(ManejDLL, 'GanchoDeTecladoOff');

  @GanchoDeRatonOn :=GetProcAddress(ManejDLL, 'GanchoDeRatonOn');
  @GanchoDeRatonOff:=GetProcAddress(ManejDLL, 'GanchoDeRatonOff');

  IF not assigned(GanchoDeTecladoOn) or
     not assigned(GanchoDeTecladoOff) or
     not assigned(GanchoDeRatonOn) or
     not assigned(GanchoDeRatonOff)  then
     raise Exception.Create('No se encontraron las funciones en la DLL'+#13+
                            'Cannot find the required DLL functions');

  {Creamos el fichero de memoria}
  FichMem:=CreateFileMapping( $FFFFFFFF,
                              nil,
                              PAGE_READWRITE,
                              0,
                              SizeOf(Integer),
                              'Intercambio');

   {Si no se crea el fichero, error}
   if FichMem=0 then
     raise Exception.Create( 'Error al crear el fichero'+
                             '/Error while create file');

   {Direccionamos nuestra estructura al fichero de memoria}
   PuntRecept:=MapViewOfFile(FichMem,FILE_MAP_WRITE,0,0,0);

   {Escribimos datos en el fichero de memoria}
   PuntRecept^ := Handle;
   GanchoDeTecladoOn;
   GanchoDeRatonOn;
end;

procedure TVent.DestruirForm(Sender: TObject);
begin
{Desactivamos el Hook}
{Uninstall the Hook}
if Assigned(GanchoDeTecladoOff) then GanchoDeTecladoOff;
if Assigned(GanchoDeRatonOff) then GanchoDeRatonOff;

{Liberamos la DLL}
{Free the DLL}
if ManejDLL > 0 then
  FreeLibrary(ManejDLL);

{Cerramos la vista del fichero y el fichero}
{Close the memfile and the View}
if FichMem > 0 then
begin
   UnmapViewOfFile(PuntRecept);
   CloseHandle(FichMem);
end;

end;

{ Llegan las teclas pulsadas en Ganchos.dll }
procedure TVent.LlegaDelGanchoDeTeclado(var message: TMessage);
var
  mVenAct : array[0..100] of char;
  mNomTec : array[0..100] of char;

begin

  GetWindowText(message.WParam, mVenAct, 100);
  GetKeyNameText(Message.LParam,mNomTec,100);

  LisIte := LiPuVi.Items.Add;
  LisIte.Caption := IntToStr(message.WParam);
  LisIte.SubItems.Add(mVenAct);
  LisIte.SubItems.Add('Tecla ' + mNomTec);

end;

{ Llegan los clicks pulsadoss en Ganchos.dll }
procedure TVent.LlegaDelGanchoDeRaton(var message: TMessage);
var
//  vMouseInfo: PMouseHookStruct;
  mVenAct : array[0..100] of char;

begin

  OutputDebugString(pwidechar(message.WParam));

{  vMouseInfo := PMouseHookStruct(message.lParam);
  GetWindowText(vMouseInfo.hwnd, mVenAct, 100);

  LisIte := LiPuVi.Items.Add;
  LisIte.Caption := IntToStr(vMouseInfo.hwnd);
  LisIte.SubItems.Add(mVenAct);}

end;

end.

Código Delphi [-]

{DFM}

object Vent: TVent
  Left = 0
  Top = 0
  Caption = 'Gesti'#243'n de simulaci'#243'n'
  ClientHeight = 280
  ClientWidth = 572
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = CrearForm
  OnDestroy = DestruirForm
  PixelsPerInch = 96
  TextHeight = 13
  object LiPuVi: TListView
    Left = 16
    Top = 24
    Width = 537
    Height = 235
    Columns = <
      item
        Width = 0
      end
      item
        Caption = 'Ventana del evento'
        Width = 150
      end
      item
        Caption = 'Pulsaci'#243'n'
        Width = 75
      end
      item
        Width = 300
      end>
    TabOrder = 0
    ViewStyle = vsReport
  end
end