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
[-]
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;
function CallBackDelGanchoDeTeclado( Code: Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;
begin
if (code=HC_ACTION) and
(((lParam shr 31) and 1)<>1) and
(((lParam shr 30) and 1)<>1) then
begin
FichMem:=OpenFileMapping(FILE_MAP_READ,False,'Intercambio');
if FichMem > 0 then
begin
PReceptor:=MapViewOfFile(FichMem,FILE_MAP_READ,0,0,0);
PostMessage(PReceptor^, MENSAJE_TECLA, GetforegroundWindow, lParam);
UnmapViewOfFile(PReceptor);
CloseHandle(FichMem);
end;
end;
Result := CallNextHookEx(GanchoDeTeclado, Code, wParam, lParam);
end;
function CallBackDelGanchoDeRaton( Code: Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;
begin
OutputDebugString( pwidechar(Code) );
OutputDebugString( pwidechar(wparam) );
OutputDebugString( pwidechar(lParam) );
if (code=HC_ACTION) then
begin
OutputDebugString( 'hc_action' );
FichMem:=OpenFileMapping(FILE_MAP_READ,False,'Intercambio');
if FichMem > 0 then
begin
OutputDebugString( 'fichmem' );
PReceptor:=MapViewOfFile(FichMem,FILE_MAP_READ,0,0,0);
PostMessage(PReceptor^, MENSAJE_RATON, wParam, lParam);
UnmapViewOfFile(PReceptor);
CloseHandle(FichMem);
end;
end;
Result := CallNextHookEx(GanchoDeRaton, Code, wParam, lParam);
end;
procedure GanchoDeTecladoOn; stdcall;
begin
GanchoDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelGanchoDeTeclado, HInstance, 0);
end;
procedure GanchoDeTecladoOff; stdcall;
begin
UnhookWindowsHookEx(GanchoDeTeclado);
end;
procedure GanchoDeRatonOn; stdcall;
begin
GanchoDeRaton:=SetWindowsHookEx(WH_MOUSE, @CallBackDelGanchoDeRaton, HInstance, 0);
end;
procedure GanchoDeRatonOff; stdcall;
begin
UnhookWindowsHookEx(GanchoDeRaton);
end;
exports
GanchoDeTecladoOn,
GanchoDeTecladoOff,
GanchoDeRatonOn,
GanchoDeRatonOff;
begin
end.
Código Delphi
[-]
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
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
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');
FichMem:=CreateFileMapping( $FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(Integer),
'Intercambio');
if FichMem=0 then
raise Exception.Create( 'Error al crear el fichero'+
'/Error while create file');
PuntRecept:=MapViewOfFile(FichMem,FILE_MAP_WRITE,0,0,0);
PuntRecept^ := Handle;
GanchoDeTecladoOn;
GanchoDeRatonOn;
end;
procedure TVent.DestruirForm(Sender: TObject);
begin
if Assigned(GanchoDeTecladoOff) then GanchoDeTecladoOff;
if Assigned(GanchoDeRatonOff) then GanchoDeRatonOff;
if ManejDLL > 0 then
FreeLibrary(ManejDLL);
if FichMem > 0 then
begin
UnmapViewOfFile(PuntRecept);
CloseHandle(FichMem);
end;
end;
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;
procedure TVent.LlegaDelGanchoDeRaton(var message: TMessage);
var
mVenAct : array[0..100] of char;
begin
OutputDebugString(pwidechar(message.WParam));
end;
end.
Código Delphi
[-]
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