DLL
library xakk;
uses Windows,
Messages;
const
CM_MANDA_TECLA = WM_USER + $1000;
var
HookDeTeclado : HHook;
FicheroM : THandle;
PReceptor : ^Integer;
function CallBackDelHook( Code: Integer;wParam:WPARAM;lParam : LPARAM): LRESULT; stdcall;
begin
if code=HC_ACTION then
begin
FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElReceptor');
if FicheroM<>0 then
begin
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_READ,0,0,0);
PostMessage(PReceptor^,CM_MANDA_TECLA,wParam,lParam);
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;
procedure HookOn; stdcall;
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;
procedure HookOff; stdcall;
begin
UnhookWindowsHookEx(HookDeTeclado);
end;
exports
HookOn,
HookOff;
begin
end.
És az unit
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
NombreDLL = 'xakk.dll';
CM_MANDA_TECLA = WM_USER + $1000;
type
THookTeclado=procedure; stdcall;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FicheroM : THandle;
PReceptor : ^Integer;
HandleDLL : THandle;
HookOn,
HookOff : THookTeclado;
procedure LlegaDelHook(var message: TMessage); message CM_MANDA_TECLA;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.ReadOnly:=TRUE;
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');
FicheroM:=CreateFileMapping( $FFFFFFFF,nil,PAGE_READWRITE,0,
SizeOf(Integer),'ElReceptor');
if FicheroM=0 then
raise Exception.Create( 'Error al crear el fichero'+
'/Error while create file');
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
PReceptor^:=Handle;
HookOn;
end;
procedure TForm1.LlegaDelHook(var message: TMessage);
var
NombreTecla : array[0..100] of char;
Accion : string;
begin
GetKeyNameText(Message.LParam,@NombreTecla,100);
if ((Message.lParam shr 31) and 1)=1 then Accion:='Soltada'
else
if ((Message.lParam shr 30) and 1)=1 then Accion:='Repetida'
else Accion:='Pulsada';
Memo1.Lines.Append( Accion+' tecla: '+String(NombreTecla) );
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(HookOff) then HookOff;
if HandleDLL<>0 then FreeLibrary(HandleDLL);
if FicheroM<>0 then
begin
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
end.
|