1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
NombreDLL = 'Teclado.dll';
CM_MANDA_TECLA = WM_USER + $1000;
type
THookTeclado=procedure; stdcall;
type
TForm1 = class(TForm)
Memo1: TMemo;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FicheroM : THandle;
PReceptor : ^Integer;
HandleDLL : THandle;
HookOn,HookOff : THookTeclado;
procedure LlegaDelHook(var message: TMessage); message CM_MANDA_TECLA;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{-------------------------------------------}
procedure TForm1.LlegaDelHook(var message: TMessage);
var
NombreTecla : array[0..100] of char;
Accion : string;
begin
{Traducimos de Virtual key Code a TEXTO}
{Virtual key code to Key Name}
GetKeyNameText(Message.LParam,@NombreTecla,100);
{Miramos si la tecla fué pulsada, soltada o repetida}
{Look if the key was pressed, released o re-pressed}
if ((Message.lParam shr 31) and 1)=1
then Accion:='Soltada' {Released}
else
if ((Message.lParam shr 30) and 1)=1
then Accion:='Repetida' {repressed}
else Accion:='Pulsada'; {pressed}
Memo1.Lines.Append( Accion+' tecla: '+ String(NombreTecla) );
//Label1.Caption:=Label1.Caption+String(NombreTecla);
end;
{------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
{No queremos que el Memo maneje el teclado...}
{We dont want that the memo read the keyboard...}
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');
{Creamos el fichero de memoria}
FicheroM:=CreateFileMapping( $FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(Integer),
'Mstapha');
{Si no se creo' 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}
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
{Escribimos datos en el fichero de memoria}
PReceptor^:=Handle;
HookOn;
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(PReceptor);
CloseHandle(FicheroM);
end;
end;
end. |