Kbhit delphi

No he hecho alguna aplicación como la que estas haciendo, pero quizá este truco te de alguna idea:
Mucha gente me pregunta acerca de la posibilidad de que nuestra aplicación Delphi capture las pulsaciones de teclas del usuario, aunque el usuario no las haga estando nuestra aplicación activa.
Por supuesto... lo primero que hacemos es dar una vuelta por el evento OnKeyPress de la form, y claro, sin obtener resultados positivos, incluso poniendo la propiedad KeyPreview de la form a true...
Esto ocurre porque nuestra aplicación sólo recibirá mensajes de pulsaciones de teclado cuando es ella quien tiene el foco.
El siguiente paso para resolver este 'reto' es la de pelearse con los hooks de teclado.
Un Hook (en español algo así como 'gancho') no es más que un mecanismo que nos permitirá espiar el tráfico de mensajes entre Windows y las aplicaciones.
Instalar un hook en nuestra aplicación es algo relativamente sencillo, pero claro, si lo instalamos en nuestra aplicación, tan sólo 'espiaremos' los mensajes que Windows envíe a nuestra aplicación, con lo que tampoco habremos resuelto el problema.
¿Cuál es la solución entonces?, pues la solución pasa por instalar un Hook pero a nivel de sistema, es decir, un 'gancho' que capture todos los mensajes que circulen hacia Windows.
El instalar un hook a nivel de sistema tiene una gran complicación añadida, que es el hecho de que la función a la que llama el hook ha de estar contenida en una DLL, no en nuestra aplicación Delphi.
Esta condición, nos obligará, en primer lugar a construirnos una DLL, y en segundo lugar a construirnos algún invento para comunicar la DLL con nuestra aplicación.
En este truco tienes un ejemplo de captura de teclado mediante un Hook de teclado a nivel de sistema.
El ejemplo consta de dos proyectos, uno para la DLL y otro para la aplicación de ejemplo.
El funcionamiento es el siguiente:
# Creamos una DLL con dos funciones que exportaremos, una para instalar el hook y otra para desinstalarlo.
# hay una tercera funcion que es la que ejecutará el hook una vez instalado (CallBack). En ella, lo que haremos es enviar los datos del mensaje capturado a nuestra aplicacion.
La DLL debe saber en todo momento el handle de la aplicación receptora, así que haremos que lo lea de un fichero mapeado en memoria que crearemos desde la propia aplicación.
Tienes un ejemplo de uso de ficheros mapeados en memoria en el truco:
[381] - Compartir datos entre dos aplicaciones Delphi
Enviaremos los datos desde la DLL a la aplicación a través de un mensaje de usuario. Tienes otros trucos en donde también se usa esta técnica, por ejemplo:
[162] - Prevenir dos ejecuciones simultaneas de tu aplicación
Bien, vamos con el ejemplo:
La DLL que instala el Hook:
# Crea el esqueleto de una DLL (File - New - DLL)
# Cambia el código del proyecto por éste otro:
library Project1;
{
Demo de Hook de teclado a nivel de sistema, Radical.
Como lo que queremos es capturar las teclas pulsadas en cualquier parte
De Windows, necesitamos instalar la función CallBack a la que llamará
El Hook en una DLL, que es ésta misma.
}
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;
{Esta es la funcion CallBack a la cual llamará el hook.}
{This is the CallBack function called by he Hook}
begin
{Si una tecla fue pulsada o liberada}
{if a key was pressed/released}
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
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
PostMessage(PReceptor^,CM_MANDA_TECLA,wParam,lParam);
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
{Llamamos al siguiente hook de teclado de la cadena}
{call to next hook of the chain}
Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;
procedure HookOn; stdcall;
{Procedure que instala el hook}
{procedure for install the hook}
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;
procedure HookOff; stdcall;
begin
{procedure para desinstalar el hook}
{procedure to uninstall the hook}
UnhookWindowsHookEx(HookDeTeclado);
end;
exports
{Exportamos las procedures...}
{Export the procedures}
HookOn,
HookOff;
begin
end.
Si has pegado el código en la unit, no te olvides de setear los eventos correspondientes, es decir el OnCreate y el OnDestroy de la form en el Object Inspector... sino el invento no funcionará...
Ahora graba el proyecto con el nombre: 'HookTeclado. Dpr' y la compilas (Project - Build All), y habrás generado la DLL del proyecto.
Aplicacion que recibe datos del Hook
# Crea una nueva aplicacion
# Pon un TMemo (Memo1) en la form
# Cambia el código de la unit de la form por éste otro:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
NombreDLL = 'HookTeclado.dll';
CM_MANDA_TECLA = WM_USER + $1000;
type
THookTeclado=procedure; stdcall;
type
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
Button1: TButton;
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
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
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),
'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}
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
{Escribimos datos en el fichero de memoria}
PReceptor^:=Handle;
HookOn;
end;
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) );
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.
# Graba el proyecto en el mismo directorio del proyecto de la DLL y compila la aplicación.
Si has seguido los pasos hasta aquí, deberás tener en el directorio de los dos proyectos una DLL (HookTeclado.DLL) y el ejecutable de la aplicación receptora.
Ejecutalo, y verás como en el Memo1 irán apareciendo todas las teclas que pulses en Windows.
Si tan sólo querías un ejemplo que funcionase, no hace falta que sigas leyendo. Si quieres saber un poco más de como funciona el invento... pues aquí lo tienes, paso a paso:
Vamos a partir del evento OnCreate de la aplicación:
Primero, ponemos el Memo1 a readonly. Imagina para qué, o mejor, prueba a no ponerlo, a ver que pasa... :)
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;
Ahora, cargamos la DLL, que supondremos que estará en el mismo directorio que nuestro ejecutable. Si hubiera algún problema a la hora de cargarla, generamos una excepción, de tal forma que el código siguiente no se ejecutaría.
HandleDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+
NombreDLL ) );
if HandleDLL = 0 then raise Exception.Create('No se pudo cargar la DLL');
# Una vez cargada la DLL, buscamos las dos funciones que deberian estar en ella. Si no están... pues excepcion al canto.
@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');
# Ahora nos creamos un fichero mapeado en memoria, el cual usaremos para guardar el handle de nuestra form, así la DLL sabrá a quien ha de enviarle el mensaje con la tecla que se ha pulsado con solo leer de dicho fichero.
{Creamos el fichero de memoria}
FicheroM:=CreateFileMapping( $FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(Integer),
'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}
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_WRITE,0,0,0);
# Una vez que tenemos el fichero mapeado en memoria, y una vista hacia el, grabamos el handle de la form en ella, y activamos el Hook, llamando a la procedure HookOn de la DLL:
{Escribimos datos en el fichero de memoria}
PReceptor^:=Handle;
HookOn;
end;
# Bien, ahora veamos que pasa en nuestra DLL al llamar a la función HookOn:
procedure HookOn; stdcall;
{Procedure que instala el hook}
{procedure for install the hook}
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;
Como ves, no hay más que una llamada a SetWindowsHookEx, para instalar un hook a nivel de sistema (0 en el ultimo parámetro) que ejecutará la función CallBackDelHook con cada mensaje que capture.
# Veamos que hace la funcion CallBackDelHook cuando es ejecutada por el hook:
Primero, se asegura que la función ha sido llamada por un nuevo evento de teclado, mediante el if code=HC_ACTION.
function CallBackDelHook( Code : Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;
{Esta es la funcion CallBack a la cual llamará el hook.}
{This is the CallBack function called by he Hook}
begin
{Si una tecla fue pulsada o liberada}
{if a key was pressed/released}
if code=HC_ACTION then
begin
Si es así, es decir, que es un nuevo evento de teclado que hay que atender... lo primero que debemos hacer es buscar el handle de la aplicación a la que debemos enviar el mensaje con los datos de la tecla pulsada/soltada, el cual hemos guardado en un fichero de memoria desde la aplicación, así que, intentamos abrir el fichero, y leer dicho handle, y si todo va bien, enviamos el mensaje mediante un PostMessage:
{Miramos si existe el fichero}
{if the mapfile exists}
FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElReceptor');
{Si no existe, no enviamos nada a la aplicacion receptora}
{If dont, send nothing to receiver application}
if FicheroM<>0 then
begin
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_READ,0,0,0);
PostMessage(PReceptor^,CM_MANDA_TECLA,wParam,lParam);
una vez enviado el mensaje, nos deshacemos del fichero de memoria:
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
luego, debemos llamar al siguiente hook que haya instalado.
{Llamamos al siguiente hook de teclado de la cadena}
{call to next hook of the chain}
Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;
Bien, tenemos instalado un hook, que captura los eventos de teclado y los reenvía a nuestra aplicación... ¿cuál es el siguiente paso?, claro, hacer algo para recibirlo ¿no crees?.
Tendremos que capturar el mensaje de usuario que nos hemos definido:
const
CM_MANDA_TECLA = WM_USER + $1000;
lo cual conseguiremos añadiendo esta linea en la parte private de la form:
procedure LlegaDelHook(var message: TMessage); message CM_MANDA_TECLA;
y claro, la correspondiente procedure en la parte implementation:
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) );
end;
En este ejemplo, simplemente traduzco los datos de la tecla que se ha pulsado/liberado, traduciéndola a su nombre de tecla y añadiéndola al TMemo.
Si quieres más información sobre los parámetros que recibirá la función, revisa el fichero de ayuda Win32. Hlp buscando el topic 'KeyboardProc'.
Ahí verás el significado de los parámetros wParam y lParam que recibirás en la función.
Por ultimo, nos queda deshacer todo este tinglado cuando salgamos de la aplicación ¿no?. Vayamos con el evento OnDestroy de la aplicación:
Primero, desinstalamos el hook, llamando a la función HookOff de la DLL. Ojo, hay que usar el if Assigned, pues si hubiese habido algún problema al cargar la DLL en el OnCreate... ahora intentaríamos ejecutar algo que no fue inicializado.
procedure TForm1.FormDestroy(Sender: TObject);
begin
{Desactivamos el Hook}
{Uninstall the Hook}
if Assigned(HookOff) then HookOff;
Ahora nos deshacemos de la DLL (si fué cargada):
{Liberamos la DLL}
{Free the DLL}
if HandleDLL<>0 then
FreeLibrary(HandleDLL);
Y nos deshacemos del fichero mapeado en memoria:
{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;