13 julio 2007

Averiguar los datos del usuario de Windows

Una de las mejores cosas que se pueden hacer en un programa cuando da un error es que nos envíe automáticamente los datos por correo electrónico. Pero es importante saber que usuario ha enviado el error dentro de la red local.

A continuación vamos a ver cuatro procedimientos que nos van a dar el nombre del usuario de Windows, el nombre de su PC en la red, su IP local y su IP pública.

Lo primero como siempre es añadir las unidades:

uses
Windows, Messages, ..., WinSock, IdHttp, WinInet;

Esta función nos devuelve el nombre del usuario:

function LeerUsuarioWindows: string;
var
sNombreUsuario: String;
dwLongitudNombre: DWord;
begin
dwLongitudNombre := 255;
SetLength( sNombreUsuario, dwLongitudNombre );

if GetUserName( PChar( sNombreUsuario ), dwLongitudNombre ) Then
Result := Copy( sNombreUsuario, 1, dwLongitudNombre - 1 )
else
Result := 'Desconocido';
end;

Y esta otra nos da el nombre del PC en la red:

function LeerNombrePC: string;
var
Buffer: array[0..255] of char;
dwLongitud: DWord;
begin
dwLongitud := 256;

if GetComputerName( Buffer, dwLongitud ) then
Result := Buffer
else
Result := ''
end;

La siguiente nos da la IP Local en la red:

function IPLocal: String;
var
p: PHostEnt;
s: array[0..128] of char;
p2: pchar;
wVersionRequested: WORD;
wsaData: TWSAData;
begin
// Arranca la librería WinSock
wVersionRequested := MAKEWORD( 1, 1 );
WSAStartup( wVersionRequested, wsaData );

// Obtiene el nombre del PC
GetHostName( @s, 128 );
p := GetHostByName( @s );

// Obtiene la dirección IP y libera la librería WinSock
p2 := iNet_ntoa( PInAddr( p^.h_addr_list^ )^ );
Result := Result + p2;
WSACleanup;
end;

Y esta última lo que hace es decirnos nuestra IP pública conectando con el servidor dyndns.org y utiliza el componente Indy HTTP el cual leer el contenido del HTML:

function IP_Publica: string;

function EsNumerico( S: string ): Boolean;
begin
Result := false;
if ( Length( S ) > 0 ) then
case S[1] of
'0'..'9': Result := True;
end;
end;
var
HTMLBody: string;
i: Integer;
IdHTTP: TIdHTTP;
begin
Result := '';

// ¿Estamos conectados a Internet?
if WinInet.InternetGetConnectedState( nil, 0 ) then
begin
IdHTTP := TIdHTTP.Create( Application );

try
HTMLBody := IdHTTP.Get( 'http://checkip.dyndns.org/' );

for i := 0 to Length( HTMLBody ) - 1 do
begin
if EsNumerico( HTMLBody[i] ) or ( HTMLBody[i] = '.' ) then
Result := Result + HTMLBody[i];
end;

finally
IdHTTP.Free;
end;
end;
end;

Pruebas realizadas en Delphi 7.

12 julio 2007

Leer la cabecera PE de un programa

¿Queréis verle las tripas a un archivo EXE? El siguiente procedimiento que voy a mostrar lee la cabecera PE de los archivos ejecutables y nos informa del punto de entrada del programa, el estado de los registros, la pila, etc.

Un archivo ejecutable se compone de distintas cabeceras dentro del mismo, ya sea si se va a ejecutar dentro del antiguo sistema operativo MS-DOS o en cualquier versión de Windows.

El siguiente procedimiento toma como parámetro un archivo ejecutable y lo guarda en un supuesto campo memo llamado INFORMACION que se encuentra en el formulario FPrincipal:

procedure TFPrincipal.ExaminarEXE( sArchivo: String );
var
FS: TFilestream;
Firma: DWORD;
Cabecera_dos: IMAGE_DOS_HEADER;
Cabecera_pe: IMAGE_FILE_HEADER;
Cabecera_opc: IMAGE_OPTIONAL_HEADER;
begin
INFORMACION.Clear;

FS := TFilestream.Create( sArchivo, fmOpenread or fmShareDenyNone );

try
FS.Read( Cabecera_dos, SizeOf( Cabecera_dos ) );

if Cabecera_dos.e_magic <> IMAGE_DOS_SIGNATURE then
begin
INFORMACION.Lines.Add( 'Cabecera DOS inválida' );
Exit;
end;

LeerCabeceraDOS( Cabecera_dos, INFORMACION.Lines );

FS.Seek( Cabecera_dos._lfanew, soFromBeginning );
FS.Read( Firma, SizeOf( Firma ) );

if Firma <> IMAGE_NT_SIGNATURE then
begin
INFORMACION.Lines.Add( 'Cabecera PE inválida' );
Exit;
end;

FS.Read( Cabecera_pe, SizeOf( Cabecera_pe ) );
LeerCabeceraPE( Cabecera_pe, INFORMACION.Lines );

if Cabecera_pe.SizeOfOptionalHeader > 0 then
begin
FS.Read( Cabecera_opc, SizeOf( Cabecera_opc ) );
LeerCabeceraOpcional( Cabecera_opc, INFORMACION.Lines );
end;
finally
FS.Free;
end;
end;

Éste a su vez llama a cada uno de los procedimientos que leen las cabeceras DOS, PE y opcional dentro del mismo EXE:

procedure LeerCabeceraDOS( const h: IMAGE_DOS_HEADER; Memo: TStrings );
begin
Memo.Add( 'Cabecera DOS del archivo' );
Memo.Add( Format( 'Número mágico: %d', [h.e_magic] ) );
Memo.Add( Format( 'Byes de la última página del archivo: %d', [h.e_cblp] ) );
Memo.Add( Format( 'Páginas en archivo: %d', [h.e_cp] ) );
Memo.Add( Format( 'Relocalizaciones: %d', [h.e_crlc] ) );
Memo.Add( Format( 'Tamaño de la cabecera en párrafos: %d', [h.e_cparhdr] ) );
Memo.Add( Format( 'Mínimo número de párrafos que necesita: %d', [h.e_minalloc] ) );
Memo.Add( Format( 'Máximo número de párrafos que necesita: %d', [h.e_maxalloc] ) );
Memo.Add( Format( 'Valor inicial (relativo) SS: %d', [h.e_ss] ) );
Memo.Add( Format( 'Valor inicial SP: %d', [h.e_sp] ) );
Memo.Add( Format( 'Checksum: %d', [h.e_csum]));
Memo.Add( Format( 'Valor inicial IP: %d', [h.e_ip] ) );
Memo.Add( Format( 'Valor inicial (relativo) CS: %d', [h.e_cs] ) );
Memo.Add( Format( 'Dirección del archivo de la tabla de relocalización: %d', [h.e_lfarlc] ) );
Memo.Add( Format( 'Número overlay: %d', [h.e_ovno]));
Memo.Add( Format( 'Identificador OEM (para e_oeminfo): %d', [h.e_oemid] ) );
Memo.Add( Format( 'Información OEM; específico e_oemid: %d', [h.e_oeminfo] ) );
Memo.Add( Format( 'Dirección de la nueva cabecera exe: %d', [h._lfanew] ) );
Memo.Add( '' );
end;

procedure LeerCabeceraPE( const h: IMAGE_FILE_HEADER; Memo: TStrings );
var
Fecha: TDateTime;
begin
Memo.Add( 'Cabecera PE del archivo' );
Memo.Add( Format( 'Máquina: %4x', [h.Machine]));

case h.Machine of
IMAGE_FILE_MACHINE_UNKNOWN : Memo.Add(' Máquina desconocida ' );
IMAGE_FILE_MACHINE_I386: Memo.Add( ' Intel 386. ' );
IMAGE_FILE_MACHINE_R3000: Memo.Add( ' MIPS little-endian, 0x160 big-endian ' );
IMAGE_FILE_MACHINE_R4000: Memo.Add( ' MIPS little-endian ' );
IMAGE_FILE_MACHINE_R10000: Memo.Add( ' MIPS little-endian ' );
IMAGE_FILE_MACHINE_ALPHA: Memo.Add( ' Alpha_AXP ' );
IMAGE_FILE_MACHINE_POWERPC: Memo.Add( ' IBM PowerPC Little-Endian ' );
$14D: Memo.Add( ' Intel i860' );
$268: Memo.Add( ' Motorola 68000' );
$290: Memo.Add( ' PA RISC' );
else
Memo.Add( ' tipo de máquina desconocida' );
end;

Memo.Add( Format( 'Número de secciones: %d', [h.NumberOfSections] ) );
Memo.Add( Format( 'Fecha y hora: %d', [h.TimeDateStamp] ) );
Fecha := EncodeDate( 1970, 1, 1 ) + h.Timedatestamp / SecsPerDay;
Memo.Add( FormatDateTime( ' c', Fecha ) );

Memo.Add( Format( 'Puntero a la tabla de símbolos: %d', [h.PointerToSymbolTable] ) );
Memo.Add( Format( 'Número de símbolos: %d', [h.NumberOfSymbols] ) );
Memo.Add( Format( 'Tamaño de la cabecera opcional: %d', [h.SizeOfOptionalHeader] ) );
Memo.Add( Format( 'Características: %d', [h.Characteristics] ) );

if ( IMAGE_FILE_DLL and h.Characteristics ) <> 0 then
Memo.Add(' el archivo es una' )
else
if (IMAGE_FILE_EXECUTABLE_IMAGE and h.Characteristics) <> 0 then
Memo.Add(' el archivo es un programa' );

Memo.Add('');
end;

procedure LeerCabeceraOpcional( const h: IMAGE_OPTIONAL_HEADER; Memo: TStrings );
begin
Memo.Add( 'Información sobre la cabecera PE de un archivo ejecutable EXE' );
Memo.Add( Format( 'Magic: %d', [h.Magic] ) );

case h.Magic of
$107: Memo.Add( ' Imagen de ROM' );
$10b: Memo.Add( ' Imagen de ejecutable' );
else
Memo.Add( ' Tipo de imagen desconocido' );
end;

Memo.Add( Format( 'Versión mayor del enlazador: %d', [h.MajorLinkerVersion] ) );
Memo.Add( Format( 'Versión menor del enlazador: %d', [h.MinorLinkerVersion]));
Memo.Add( Format( 'Tamaño del código: %d', [h.SizeOfCode]));
Memo.Add( Format( 'Tamaño de los datos inicializados: %d', [h.SizeOfInitializedData]));
Memo.Add( Format( 'Tamaño de los datos sin inicializar: %d', [h.SizeOfUninitializedData]));
Memo.Add( Format( 'Dirección del punto de entrada: %d', [h.AddressOfEntryPoint]));
Memo.Add( Format( 'Base de código: %d', [h.BaseOfCode]));
Memo.Add( Format( 'Base de datos: %d', [h.BaseOfData]));
Memo.Add( Format( 'Imagen base: %d', [h.ImageBase]));
Memo.Add( Format( 'Alineamiento de la sección: %d', [h.SectionAlignment]));
Memo.Add( Format( 'Alineamiento del archivo: %d', [h.FileAlignment]));
Memo.Add( Format( 'Versión mayor del sistema operativo: %d', [h.MajorOperatingSystemVersion]));
Memo.Add( Format( 'Versión mayor del sistema operativo: %d', [h.MinorOperatingSystemVersion]));
Memo.Add( Format( 'Versión mayor de la imagen: %d', [h.MajorImageVersion]));
Memo.Add( Format( 'Versión menor de la imagen: %d', [h.MinorImageVersion]));
Memo.Add( Format( 'Versión mayor del subsistema: %d', [h.MajorSubsystemVersion]));
Memo.Add( Format( 'Versión menor del subsistema: %d', [h.MinorSubsystemVersion]));
Memo.Add( Format( 'Valor de la versión Win32: %d', [h.Win32VersionValue]));
Memo.Add( Format( 'Tamaño de la imagen: %d', [h.SizeOfImage]));
Memo.Add( Format( 'Tamaño de las cabeceras: %d', [h.SizeOfHeaders]));
Memo.Add( Format( 'CheckSum: %d', [h.CheckSum]));
Memo.Add( Format( 'Subsistema: %d', [h.Subsystem]));

case h.Subsystem of
IMAGE_SUBSYSTEM_NATIVE:
Memo.Add( ' La imagen no requiere un subsistema. ' );

IMAGE_SUBSYSTEM_WINDOWS_GUI:
Memo.Add( ' La imagen se corre en un subsistema GUI de Windows. ' );

IMAGE_SUBSYSTEM_WINDOWS_CUI:
Memo.Add( ' La imagen corre en un subsistema terminal de Windows. ' );

IMAGE_SUBSYSTEM_OS2_CUI:
Memo.Add( ' La imagen corre sobre un subsistema terminal de OS/2. ' );

IMAGE_SUBSYSTEM_POSIX_CUI:
Memo.Add( ' La imagen corre sobre un subsistema terminal Posix. ' );
else
Memo.Add( ' Subsistema desconocido.' )
end;

Memo.Add( Format( 'Características DLL: %d', [h.DllCharacteristics]) );
Memo.Add( Format( 'Tamaño de reserva de la pila: %d', [h.SizeOfStackReserve]) );
Memo.Add( Format( 'Tamaño de trabajo de la pila: %d', [h.SizeOfStackCommit]) );
Memo.Add( Format( 'Tamaño del Heap de reserva: %d', [h.SizeOfHeapReserve]) );
Memo.Add( Format( 'Tamaño de trabajo del Heap: %d', [h.SizeOfHeapCommit]) );
Memo.Add( Format( 'Banderas de carga: %d', [h.LoaderFlags] ) );
Memo.Add( Format( 'Numeros RVA y tamaño: %d', [h.NumberOfRvaAndSizes] ) );
end;

Espero que os sea de utilidad si os gusta programar herramientas de administración de sistemas operativos Windows.

Pruebas realizadas en Delphi 7.

11 julio 2007

Leer las dimensiones de imágenes JPG, PNG y GIF

Si estáis pensando en crear un visor de fotografías aquí os traigo tres procedimientos que leen al ancho y alto de imagenes con extensión JPG, PNG y GIF leyendo los bytes de su cabecera. No hay para BMP ya que se puede hacer con un componente TImage.

Antes de nada hay que incluir una función que lee los enteros almacenados en formato del procesador motorola, que guarda los formatos enteros en memoria al contrario de los procesadores Intel/AMD:

function LeerPalabraMotorola( F: TFileStream ): Word;
type
TPalabraMotorola = record
case Byte of
0: ( Value: Word );
1: ( Byte1, Byte2: Byte );
end;
var
MW: TPalabraMotorola;
begin
F.Read( MW.Byte2, SizeOf( Byte ) );
F.Read( MW.Byte1, SizeOf( Byte ) );
Result := MW.Value;
end;

El siguiente procedimiento toma como parámetros la ruta y nombre de una imagen JPG, y dos variales enteras donde se almacenará el ancho y alto de la imagen:

procedure DimensionJPG( sArchivo: string; var wAncho, wAlto: Word );
const
ValidSig: array[0..1] of Byte = ($FF, $D8);
Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
Sig: array[0..1] of byte;
F: TFileStream;
x: integer;
Seg: byte;
Dummy: array[0..15] of byte;
Len: word;
iLongitudLinea: LongInt;
begin
FillChar( Sig, SizeOf( Sig ), #0 );

F := TFileStream.Create( sArchivo, fmOpenRead );
try
iLongitudLinea := F.Read( Sig[0], SizeOf( Sig ) );

for x := Low( Sig ) to High( Sig ) do
if Sig[x] <> ValidSig[x] then
iLongitudLinea := 0;

if iLongitudLinea > 0 then
begin
iLongitudLinea := F.Read( Seg, 1 );

while ( Seg = $FF ) and ( iLongitudLinea > 0 ) do
begin
iLongitudLinea := F.Read( Seg, 1 );

if Seg <> $FF then
begin
if ( Seg = $C0 ) or ( Seg = $C1 ) then
begin
iLongitudLinea := F.Read( Dummy[0], 3 ); // Nos saltamos estos bytes
wAlto := LeerPalabraMotorola( F );
wAncho := LeerPalabraMotorola( F );
end
else
begin
if not ( Seg in Parameterless ) then
begin
Len := LeerPalabraMotorola( F );
F.Seek( Len - 2, 1 );
F.read( Seg, 1 );
end
else
Seg := $FF; { Fake it to keep looping. }
end;
end;
end;
end;
finally
F.Free;
end;
end;

Lo mismo para una imagen PNG:

procedure DimensionPNG( sArchivo: string; var wAncho, wAlto: Word );
type
TPNGSig = array[0..7] of Byte;
const
ValidSig: TPNGSig = (137,80,78,71,13,10,26,10);
var
Sig: TPNGSig;
F: TFileStream;
x: Integer;
begin
FillChar( Sig, SizeOf( Sig ), #0 );
F := TFileStream.Create( sArchivo, fmOpenRead );
try
F.read( Sig[0], SizeOf( Sig ) );

for x := Low( Sig ) to High( Sig ) do
if Sig[x] <> ValidSig[x] then
Exit;

F.Seek( 18, 0 );
wAncho := LeerPalabraMotorola( F );
F.Seek( 22, 0 );
wAlto := LeerPalabraMotorola( F );
finally
F.Free;
end;
end;

Y para una imagen GIF:

procedure DimensionGIF( sArchivo: string; var wAncho, wAlto: Word );
type
TCabeceraGIF = record
Sig: array[0..5] of char;
ScreenWidth, ScreenHeight: Word;
Flags, Background, Aspect: Byte;
end;

TBloqueImagenGIF = record
Left, Top, Width, Height: Word;
Flags: Byte;
end;
var
F: file;
Cabecera: TCabeceraGIF;
BloqueImagen: TBloqueImagenGIF;
iResultado: Integer;
x: Integer;
c: char;
bEncontradasDimensiones: Boolean;
begin
wAncho := 0;
wAlto := 0;

if sArchivo = '' then
Exit;

{$I-}
FileMode := 0; // Sólo lectura
AssignFile( F, sArchivo );
Reset( F, 1);
if IOResult <> 0 then
Exit;

// Lee la cabecera y se asegura de que sea un archivo válido
BlockRead( F, Cabecera, SizeOf( TCabeceraGIF ), iResultado );

if ( iResultado <> SizeOf( TCabeceraGIF ) ) or ( IOResult <> 0 ) or
( StrLComp( 'GIF', Cabecera.Sig, 3 ) <> 0 ) then
begin
Close( F );
Exit;
end;

{ Skip color map, if there is one }
if ( Cabecera.Flags and $80 ) > 0 then
begin
x := 3 * ( 1 shl ( ( Cabecera.Flags and 7 ) + 1 ) );
Seek( F, x );
if IOResult <> 0 then
begin
Close( F );
Exit;
end;
end;

bEncontradasDimensiones := False;
FillChar( BloqueImagen, SizeOf( TBloqueImagenGIF ), #0 );

BlockRead( F, c, 1, iResultado );
while ( not EOF( F ) ) and ( not bEncontradasDimensiones ) do
begin
case c of
',': // Encontrada imagen
begin
BlockRead( F, BloqueImagen, SizeOf( TBloqueImagenGIF ), iResultado );
if iResultado <> SizeOf( TBloqueImagenGIF ) then
begin
Close( F );
Exit;
end;

wAncho := BloqueImagen.Width;
wAlto := BloqueImagen.Height;
bEncontradasDimensiones := True;
end;

'ÿ': // esquivar esto
begin
// Nada
end;

// No hacer nada, ignorar
end;

BlockRead( F, c, 1, iResultado );
end;

Close( F );
{$I+}
end;

Así no será necesario cargar toda la imagen para averiguar sus dimensiones.

Pruebas realizadas en Delphi 7.

10 julio 2007

Descargar un archivo de Internet sin utilizar componentes

Añadiendo a nuestro formulario la librería WinINet se pueden descargar archivos por HTTP con la siguiente función:

function DescargarArchivo( sURL, sArchivoLocal: String ): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
LongitudBuffer: DWORD;
F: File;
sMiPrograma: String;
begin
sMiPrograma := ExtractFileName( Application.ExeName );
hSession := InternetOpen( PChar( sMiPrograma ), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );

try
hURL := InternetOpenURL( hSession, PChar( sURL ), nil, 0, 0, 0 );

try
AssignFile( F, sArchivoLocal );
Rewrite( F, 1 );

repeat
InternetReadFile( hURL, @Buffer, SizeOf( Buffer ), LongitudBuffer );
BlockWrite( F, Buffer, LongitudBuffer );
until LongitudBuffer = 0;

CloseFile( F );
Result := True;
finally
InternetCloseHandle( hURL );
end
finally
InternetCloseHandle( hSession );
end
end;

El primer parámetro es la URL completa del archivo a descargar y el segundo la ruta y nombre del archivo donde se va a guardar en nuestro disco duro. Un ejemplo de llamada a la función sería:

DescargarArchivo( 'http:\\miweb.com\imagen.jpg', 'C:\Mis documentos\imagen.jpg' );

Pruebas realizadas en Delphi 7.

09 julio 2007

Averiguar el nombre del procesador y su velocidad

El registro de Windows suele almacenar gran cantidad de información no sólo de la configuración de los programas instalados, sino también el estado real del hardware de nuestro PC.

En esta ocasión vamos a leer el nombre del procesador y su velocidad desde nuestro programa. Antes de nada añadimos a uses:

uses
Windows, Messages, ..., Registry;

La siguiente función nos devuelve el nombre del procesador:

function NombreProcesador: string;
var
Registro: TRegistry;
begin
Result := '';
Registro := TRegistry.Create;

try
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( '\Hardware\Description\System\CentralProcessor\0', False ) then
Result := Registro.ReadString( 'Identifier' );
finally
Registro.Free;
end;
end;

Y esta otra nos da su velocidad (según la BIOS y el fabricante):

function VelocidadProcesador: string;
var
Registro: TRegistry;
begin
Registro := TRegistry.Create;
try
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( 'Hardware\Description\System\CentralProcessor\0', False ) then
begin
Result := IntToStr( Registro.ReadInteger( '~MHz' ) ) + ' MHz';
Registro.CloseKey;
end;
finally
Registro.Free;
end;
end;

Hay veces que dependiendo del procesador y del multiplicador de la BIOS casi nunca coincide la velocidad real que nos da Windows con la de verdad (sobre todo en procesadores AMD). Aquí tenemos otra función que calcula en un segundo la velocidad real del procesador con una pequeña rutina en ensamblador:

function CalcularVelocidadProcesador: Double;
const
Retardo = 500;
var
TimerHi, TimerLo: DWORD;
ClasePrioridad, Prioridad: Integer;
begin
ClasePrioridad := GetPriorityClass( GetCurrentProcess );
Prioridad := GetThreadPriority( GetCurrentThread );

SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );
SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL );

Sleep( 10 );

asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;

Sleep( Retardo );

asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;

SetThreadPriority( GetCurrentThread, Prioridad );
SetPriorityClass( GetCurrentProcess, ClasePrioridad );

Result := TimerLo / ( 1000 * Retardo );
end;

Nos devuelve el resultado en una variable double, donde que podríamos sacar la información en pantalla de la siguiente manera:

ShowMessage( Format( 'Velocidad calculada: %f MHz', [CalcularVelocidadProcesador] ) );

Pruebas realizadas en Delphi 7.

Publicidad