Ideas y Trucos en Delphi

Conocer la ubicación del ejecutable

ExtractFilePath(Application.ExeName) o ExtractFilePath(ParamStr(0))

Compartir carpetas en Windows.

En principio es tan sencillo o tan complicado como usar la función de la API de Windows "NetShareAdd". La pregunta es: ¿dónde está esta función? Pues bien, esta función se puede encontrar en la DLL "SrvApi.dll" en los sistemas Win9x y WinMe, o en la DLL "NetApi32.dll" en los sistemas Windows NT y 2000 (y supongo que XP).

Borland, ante este problema de que dicha función dependa del sistema operativo lo que ha hecho es pasar de todo y no incluir esta función (ni muchas otras de redes locales) en sus archivos de sistema de la VCL, por lo que para poder usar tendremos que declarar nosotros mismos esta función.

Aquí surge una duda de como cargar la DLL que vayamos a usar: estática o dinámicamente.
Si declaramos la función estáticamente, es decir, con un "external XXXXX" después de la declaración, nuestro ejecutable dependerá de dicha DLL y no nos funcionará en el otro tipo de plataforma. Si por ejemplo cargamos estáticamente NetApi32.dll porque estamos en NT ó 2000 no podremos ejecutar nuestra aplicación en Win9x ó Me.
Esto nos lleva a que la mejor forma de hacerlo es cargando la función dinámicamente (LoadLibrary, GetProcAddress, ...) y evitar la dependencia del sistema operativo.

Por otra parte está el hecho de que esta función utiliza unas estructuras (records en Delphi) que tampoco están declaradas y tendremos que declararlas a mano. Estas son: "share_info_50" para sistemas 9x y Me y "share_info_2" para sistemas NT/2000.

Para declarar estas estructuras y otras constantes necesarias he creado el fichero NetShare.pas que es como sigue:

unit NetShare;

interface
uses Windows;

const
LM20_NNLEN = 12;
SHPWLEN = 8;

SHI50F_RDONLY = 1;
SHI50F_FULL = 2;
SHI50F_DEPENDSON = (SHI50F_RDONLY or SHI50F_FULL);
SHI50F_ACCESSMASK = (SHI50F_RDONLY or SHI50F_FULL);
SHI50F_PERSIST = 256;
SHI50F_SYSTEM = 512;

STYPE_DISKTREE = 0;
ACCESS_NONE = 0;
ACCESS_READ = $01;
ACCESS_WRITE = $02;
ACCESS_CREATE = $04;
ACCESS_EXEC = $08;
ACCESS_DELETE = $10;
ACCESS_ATRIB = $20;
ACCESS_PERM = $40;
ACCESS_GROUP = $8000;
ACCESS_ALL = (ACCESS_READ or ACCESS_WRITE or ACCESS_CREATE or
ACCESS_EXEC or ACCESS_DELETE or ACCESS_ATRIB or ACCESS_PERM);

type
share_info_2= record
shi2_netname : PWideChar;
shi2_type : DWORD;
shi2_remark : PWideChar;
shi2_permissions : DWORD;
shi2_max_uses : DWORD;
shi2_current_uses : DWORD;
shi2_path : PWideChar;
shi2_passwd : PWideChar;
end;

share_info_50 = packed record
shi50_netname : array [0..LM20_NNLEN] of Char;
shi50_type : Byte;
shi50_flags : Short;
shi50_remark : PChar;
shi50_path : PChar;
shi50_rw_password: array [0..SHPWLEN] of Char;
shi50_ro_password: array [0..SHPWLEN] of Char;
end;

implementation
end.

La llamada a la función para compartir una carpeta sería algo así:


procedure TForm1.Button1Click(Sender: TObject);

var
hDll : THandle;
NetShareAddWin9x : function(pszServer : PChar;
sLevel : Short;
pbBuffer : Pointer;
cbBuffer : Short):DWORD;stdcall;

NetShareAddWinNT : function(servername : PWideChar;
level : DWORD;
buf : Pointer;
var parm_Err : DWORD):DWORD;stdcall;

si50 : share_info_50;
si2 : share_info_2;
tamano : Short;
res, err : DWORD;
begin
// Habría que comprobar la versión de windows
// con la función EsNT que tiene que devolver
// true si estamos en NT ó 2000 y si no false.

if (not EsNT) then
begin
// Probamos con la librería de Win 95/98/Me
hDll := LoadLibrary('SvrApi.dll');
if hDll > 32 then
begin
NetShareAddWin9x := GetProcAddress(hDll, 'NetShareAdd');
tamano := sizeof(si50);
FillChar(si50, tamano, 0);
StrCopy(si50.shi50_netname, 'PRUEBA');
si50.shi50_type := STYPE_DISKTREE;
si50.shi50_flags := SHI50F_RDONLY;
si50.shi50_path := 'D:\TEMP';
res := NetShareAddWin9x(nil, 50, @si50, tamano);
FreeLibrary(hDll);
end;
end
else
begin
// Probamos con la librería de Win NT/2000
hDll := LoadLibrary('NetApi32.dll');
if hDll > 32 then
begin
NetShareAddWinNT := GetProcAddress(hDll, 'NetShareAdd');
tamano := sizeof(si2);
FillChar(si2, tamano, 0);
si2.shi2_netname := 'PRUEBA';
si2.shi2_type := STYPE_DISKTREE;
si2.shi2_permissions := ACCESS_READ;
si2.shi2_max_uses := 1;
si2.shi2_current_uses := 1;
si2.shi2_path := 'C:\WINNT';
res := NetShareAddWinNT(nil, 2, @si2, err);
FreeLibrary(hDll);
end;
end;
end;

NOTA: en Win9x/ME hay que poner el parámetro "shi50_path" en mayúsculas para que funcione.

Obtener el número de serie de nuestro Windows

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_Local_Machine;
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\',False);
ShowMessage (Reg.ReadString('ProductID'));
finally
Reg.Free;
end;
end;

password en paradox con delphi

Suponiendo que Table1 sea nuestra tabla el codigo a poner seria el siguiente:
Table1.Active:=FALSE;
Session.AddPassword('Password/Clave');
Table1.Active := True;

Para quitar el pasword utiliza este codigo:

Session.RemovePassword('My secret password');

Prevenir dos ejecuciones simultaneas de tu aplicación

Esto sirve para que no ejecuten tu programa más de una vez simultaneamente. Puede que quieras simplemente denegar la creación de la segunda instancia de tu aplicación, o puede que lo que quieras es que no sólo no se abra la segunda instancia, sino que se restaure la primera (que igual está minimizada, por ejemplo).
Hay muchas maneras de hacer esto. En este truco he querido poner una que me ha llamado la atención por su sencillez. En Delphi 1 el detectar una instancia anterior era tan fácil como chequear la variable hPrevinst, pero en Delphi 32 bits esta variable ya no existe, así que tenemos que buscar otra manera de detectar otra copia de nuestra aplicación.
Aqui la buscaremos con ayuda de FindWindow y un pequeño truco para simplificar la búsqueda:

Meteremos este código en el código del proyecto, para lo cual has de habilitar la pestaña de ver código del proyecto, que está en: View->Project Source

program Project1;

uses
Forms, Windows, Messages,
Unit1 in 'Unit1.pas' {Form1};

const
CM_RESTORE = WM_USER + $1000;

var
RvHandle : hWnd;

{$R *.RES}

begin
{Si existe otra instancia ya ejecutandose, la activamos}

RvHandle := FindWindow('Mi programa Delphi', NIL);
if RvHandle > 0 then
begin
PostMessage(RvHandle, CM_RESTORE, 0, 0);
Exit;
end;

{Sino, haz lo normal}

Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

En la declaración de la form, añadiremos este código, (la constante y las dos procedures que hay en la parte public)


const
CM_RESTORE = WM_USER + $1000;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure CreateParams(var Params: TCreateParams); override;
Procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
end;

Y en la implementation de la form, pondremos el código de las dos procedures que hemos definido:

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := 'Mi programa Delphi';
end;

procedure TForm1.RestoreRequest(var message: TMessage);
begin
if IsIconic(Application.Handle) = TRUE then
Application.Restore
else
Application.BringToFront;
end;

El funcionamiento de todo esto es el siguiente:

* Definimos un nuevo CreateParams para nuestra form, que lo que hace es asignar 'Mi programa Delphi' al WinClassName para luego poder buscar nuestra aplicación con mayor facilidad mediante FindWindow

* Creamos una procedure de tratamiento de nuestro mensaje: CM_RESTORE, que servirá para decirle a la primera instancia de nuestra aplicación que queremos que 'resucite'

* Y por ultimo, en el fuente del proyecto, buscamos una instancia previa de nuestra aplicación mediante FindWindow, y, si la encontramos, la enviamos nuestro propio mensaje CM_RESTORE para que resucite.

Otro ejemplo, mediante un semáforo

Pon esto en el OnCreate de tu form:

procedure TMainForm.FormCreate(Sender: TObject);
var Sem : THandle;
begin
Sem := CreateSemaphore(nil,0,1,'PROGRAM_NAME');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
CloseHandle( Sem );
ShowMessage('This program is already running.'+
'Este programa ya se está ejecutando...');
Halt;
end;
end;

Otro ejemplo, mediante la unit TLHelp32 y el nombre del ejecutable

Simplemente detectaremos si hay otro ejecutable ejecutándose que se llame igual que el nuestro.

* Añade 'TLHelp32' en el uses de tu form

* Añade esta función en el implementation de la form:



function ProgramaAbiertoDosVeces:Boolean;
var
Datos :TProcessEntry32; {Estructura interna de datos de un proceso}
hID :DWord; {identificador del proceso}
Snap :Integer;
NombreArchivo :String; {path del archivo original}
Repetido :Boolean; {true si el programa se ha abierto dos veces}
Handle1 :Hwnd; {thandle}
Contador :Integer; {Contador de aperturas}

begin
Contador:=0;
NombreArchivo:=Application.Exename;
Repetido:=False;
GetWindowThreadProcessId(Handle1,@hID);
Snap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
try
Datos.dwSize:=SizeOf(Datos);
if(Process32First(Snap,Datos))then
begin
repeat
if NombreArchivo=StrPas(Datos.szExeFile) then
begin
Inc(contador);
if Contador>=2 then Repetido:=true;
end;
until (not(Process32Next(Snap,Datos))) or (Repetido);
end;
finally
Windows.CloseHandle(Snap);
end;
Result:=Repetido;
end;

* Ahora, pon este código en el evento OnCreate de la form principal:


procedure TForm1.FormCreate(Sender: TObject);
begin
if ProgramaAbiertoDosVeces then
begin
showmessage('El programa ha sido abierto mas de una vez');
Application.terminate;
end;
end;

Capturar teclas de todas las aplicaciones Windows (hooks)

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 envie a nuestra aplicacion, con lo que tampoco habremos resuelto el problema.

¿Cual 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 algun 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 aplicacion receptora, así que haremos que lo lea de un fichero mapeado en memoria que crearemos desde la propia aplicacion.
Tienes un ejemplo de uso de ficheros mapeados en memoria en el truco:

- Compartir datos entre dos aplicaciones Delphi

Enviaremos los datos desde la DLL a la aplicacion a través de un mensaje de usuario. Tienes otros trucos en donde tambien se usa esta técnica, por ejemplo:

- Prevenir dos ejecuciones simultaneas de tu aplicacion

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, Radikal.
Como lo que queremos es capturar las teclas pulsadas en cualquier parte
de Windows, necesitamos instalar la funcion 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.}

begin
{Si una tecla fue pulsada o liberada}

if code=HC_ACTION then
begin
{Miramos si existe el fichero}

FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElReceptor');
{Si no existe, no enviamos nada a la aplicacion receptora}

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;
{Llamamos al siguiente hook de teclado de la cadena}

Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;

procedure HookOn; stdcall;
{Procedure que instala el hook}

begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;

procedure HookOff; stdcall;
begin
{procedure para desinstalar el hook}

UnhookWindowsHookEx(HookDeTeclado);
end;

exports
{Exportamos las procedures...}

HookOn,
HookOff;

begin
end.
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...}

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}

GetKeyNameText(Message.LParam,@NombreTecla,100);

{Miramos si la tecla fué pulsada, soltada o repetida}

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}

if Assigned(HookOff) then HookOff;

{Liberamos la DLL}

if HandleDLL<>0 then
FreeLibrary(HandleDLL);

{Cerramos la vista del fichero y el fichero}

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 aqui, deberás tener en el directorio de los dos proyectos una DLL (HookTeclado.DLL) y el ejecutable de la aplicacion 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 aqui lo tienes, paso a paso:

Vamos a partir del evento OnCreate de la aplicacion:

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...}

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 excepcion, 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');

* 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');

{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}

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 funcion 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.}

begin
{Si una tecla fue pulsada o liberada}

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 aplicacion, 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}

FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElReceptor');
{Si no existe, no enviamos nada a la aplicacion receptora}

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}

Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;

Bien, tenemos instalado un hook, que captura los eventos de teclado y los reenvia a nuestra aplicacion... ¿cual 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}

GetKeyNameText(Message.LParam,@NombreTecla,100);

{Miramos si la tecla fué pulsada, soltada o repetida}

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, traduciendola a su nombre de tecla y añadiendola al TMemo.
Si quieres más informacion sobre los parámetros que recibirá la funcion, 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 funcion HookOff de la DLL. Ojo, hay que usar el if Assigned, pues si hubiese habido algun problema al cargar la DLL en el OnCreate... ahora intentariamos ejecutar algo que no fue inicializado.

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Desactivamos el Hook}

if Assigned(HookOff) then HookOff;

Ahora nos deshacemos de la DLL (si fué cargada):


{Liberamos la DLL}

if HandleDLL<>0 then
FreeLibrary(HandleDLL);

Y nos deshacemos del fichero mapeado en memoria:

{Cerramos la vista del fichero y el fichero}

if FicheroM<>0 then
begin
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;

Para aquellos que no les ha funcionado, no olviden asociar los eventos de OnCreate y OnDestroy de la forma principal, con los eventos correspondientes.

Eso es básico, y no se debería de olvidar.

Ocultar La Aplicación De La De La Barra De Tareas.

La opción típica de

ShowWindow(Application.Handle, SW_HIDE);

ya no es válida en los últimos Windows. Al menos en XP funciona la que envía:

Andrés Galluzzi, a Trucomanía


procedure TfrmMain.BtnHideFromTaskBarClick(Sender: TObject);
begin
ShowWindow( Application.Handle, SW_HIDE );
SetWindowLong( Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
ShowWindow( Application.Handle, SW_SHOW );
end;



Obtener el nombre de usuario.
(José Luis Freire)

Se obtiene a través de la función del API de Windows, GerUserName.

procedure TForm1.Button1Click(Sender: TObject);

var
buffer : array[0..255] of char;
Tambuffer : DWORD;
begin
Tambuffer := sizeOf(buffer);
GetUserName(@buffer, tambuffer);
ShowMessage(buffer);
end;

Cómo Cambiar La Resolución De Pantalla Desde El Programa

function DynamicResolution(X, Y: word): BOOL;
var lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X; lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if DynamicResolution(800, 600) then ShowMessage('Resolución a: 800*600');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DynamicResolution(640, 480) then ShowMessage('Resolución a: 640*480');
end;

Cómo saber la posición del ratón en cualquier punto de la pantalla.

Creamos un Timer, por ejemplo, para la visualización, supongamos que con un intervalo de 100 y en el evento OnTimer un
procedure de esta forma:

procedure TForm1.Timer1Timer(Sender: TObject);

var position:tpoint;
begin
getcursorpos(position);
label1.Caption:='X: '+inttostr(position.x)+' Y: '+inttostr(position.y);
end;
end.