08 agosto 2007

Operaciones con cadenas de texto (II)

Continuamos viendo funciones para manejo de cadenas de caracteres:

function AnsiIndexStr( const AText: string; const AValues: array of string ): Integer;

Esta función comprueba si alguna de las cadenas contenidas en el array AValues coincide extactamente con la cadena AText (distingue mayúsculas y minúsculas). Si la encuentra nos devuelve el número de índice del array donde se encuentra (empieza por cero), en caso contrario nos devuelve -1. Por ejemplo:

AnsiIndexStr( 'JUAN', ['CARLOS','PABLO','JUAN','ROSA'] ) devuelve 2
AnsiIndexStr( 'JUAN', ['CARLOS','PABLO','Juan','ROSA'] ) devuelve -1

Como vemos en el primer ejemplo nos dice que JUAN se encuentra en la posición 2 del array. Sin embargo en el sedungo ejemplo devuelve -1 porque JUAN es distinto de Juan.

function AnsiIndexText( const AText: string; const AValues: array of string ): Integer;

Funciona exactamente igual que la función AnsiIndexStr salvo que no distingue mayúsculas y minúsculas. Según el ejemplo anterior ambas llamadas a la función devuelven idéntico resultado:

AnsiIndexText( 'JUAN', ['CARLOS','PABLO','JUAN','ROSA'] ) devuelve 2
AnsiIndexText( 'JUAN', ['CARLOS','PABLO','Juan','ROSA'] ) devuelve 2

function AnsiLeftStr( const AText: AnsiString; const ACount: Integer ): AnsiString;

Esta función devuelve la parte izquierda de la cadena AText según el número de caracteres que le indiquemos en ACount. Sería algo así:

AnsiLeftStr( 'PROGRAMANDO CON DELPHI', 6 ) devuelve PROGRA
AnsiLeftStr( 'PROGRAMANDO CON DELPHI', 11 ) devuelve PROGRAMANDO
AnsiLeftStr( 'PROGRAMANDO CON DELPHI', 18 ) devuelve PROGRAMANDO CON DE

function AnsiLowerCase( const S: string ): string;

Devuelve la cadena S convertida toda en minúsculas (si tiene letras, naturalmente). Veamos un par de ejemplos:

AnsiLowerCase( 'Programando con Delphi' ) devuelve:

programando con delphi

AnsiLowerCase( 'MANIPULANDO CADA CARÁCTER DE LA CADENA' ) devuelve:

manipulando cada carácter de la cadena

Como vemos nos ha respetado la tílde en la palabra carácter.

function AnsiMatchStr( const AText: string; const AValues: array of string ): Boolean;

Esta función nos dice si alguna de las cadenas contenidas en el array AValues coincide exactamente con la cadena AText (comprobando mayúsculas y minúsculas). Aunque esta función pueda parecer igual a AnsiIndexStr se diferencia en que sólo responde True o False si la encontrado o no, al contrario que AnsiIndexStr que nos devuelve que la posición donde la ha encontrado. Con un ejemplo se ve mas claro:

AnsiMatchStr( 'JUAN', ['CARLOS','PABLO','JUAN','ROSA'] ) devuelve True
AnsiMatchStr( 'JUAN', ['CARLOS','PABLO','Juan','ROSA'] ) devuelve False

Nota: La ayuda de Delphi 7 dice que esta función devuelve un Integer y realmente devuelve un Boolean, será un error de documentación (ya estamos acostumbrados a la 'magnífica' documentación de Borland). En cambio si está corregido en la función:

function AnsiMatchText( const AText: string; const AValues: array of string ): Boolean;

Similar a la función anterior AnsiMatchStr pero sin diferenciar mayúsculas y minúsculas. Siguiendo el mismo ejemplo:

AnsiMatchText( 'JUAN', ['CARLOS','PABLO','JUAN','ROSA'] ) devuelve True
AnsiMatchText( 'JUAN', ['CARLOS','PABLO','Juan','ROSA'] ) devuelve True

function AnsiMidStr( const AText: AnsiString; const AStart, ACount: Integer ): AnsiString;

Devuelve un trozo de la cadena AText cuya posición comienza en AStart (el primer elemento es el 1) y cuyo número de caracteres viene determinado por ACount. Por ejemplo:

AnsiMidStr( 'PROGRAMANDO CON DELPHI', 7, 5 ) devuelve MANDO
AnsiMidStr( 'PROGRAMANDO CON DELPHI', 17, 6 ) devuelve DELPHI

function AnsiPos( const Substr, S: string ): Integer;

Devuelve la posición de la cadena Substr que está dentro de la cadena S. Si no la encuentra devuelve un cero (el primer elemento comienza por 1). También distingue entre mayúsculas y minúsculas. Veamos como funciona:

AnsiPos( 'PALABRA', 'BUSCANDO UNA PALABRA' ) devuelve 14
AnsiPos( 'Palabra', 'BUSCANDO UNA PALABRA' ) devuelve 0

function AnsiReplaceStr( const AText, AFromText, AToText: string ): string;

Esta función nos devuelve la cadena AText reemplazando las palabras que contenga según la variable AFromText sustituyéndolas por AToText. Tiene encuentra mayúsculas y minúsculas:

AnsiReplaceStr( 'CORRIGIENDO TEXTO DENTRO DE UNA FRASE', 'TEXTO', 'UNA PALABRA' ) devuelve:

CORRIGIENDO UNA PALABRA DENTRO DE UNA FRASE

AnsiReplaceStr( 'CORRIGIENDO TEXTO DENTRO DE UNA FRASE', 'Texto', 'UNA PALABRA' ) devuelve:

CORRIGIENDO TEXTO DENTRO DE UNA FRASE

Como vemos en el segundo ejemplo al no encontrar Texto por contener minúsculas ha dejado la frase como estaba.

function AnsiReplaceText( const AText, AFromText, AToText: string ): string;

Igual a la función AnsiReplaceStr sin distinguir mayúsculas y minúsculas:

AnsireplaceText( 'CORRIGIENDO TEXTO DENTRO DE UNA FRASE', 'TEXTO', 'UNA PALABRA' ) devuelve:

CORRIGIENDO UNA PALABRA DENTRO DE UNA FRASE

AnsireplaceText( 'CORRIGIENDO TEXTO DENTRO DE UNA FRASE', 'Texto', 'UNA PALABRA' ) devuelve:

CORRIGIENDO UNA PALABRA DENTRO DE UNA FRASE


El próximo artículo continuará con más funciones de manipulación de texto.

Pruebas realizadas en Delphi 7.

07 agosto 2007

Operaciones con cadenas de texto (I)

Delphi posee un amplio repertorio de funciones para el análisis y manipulación de cadenas de texto que nos harán la vida mucho más fácil una vez las conozcamos. Comencemos con ellas:

function AnsiCompareStr( const S1, S2: string ): Integer;

Esta función compara dos cadenas de texto carácter a carácter y nos dice si son iguales (diferencia mayúsculas y minúsculas). Si ambas cadenas son iguales devuelve un cero. Devolverá un 1 si la cadena S1 es superior a la cadena S2 y devuelve un -1 si la cadena S1 es inferior a la cadena S2. Veamos un ejemplo:

AnsiCompareStr( 'HOLA', 'HOLA' ) devuelve 0
AnsiCompareStr( 'HOLA', 'HOLa' ) devuelve 1
AnsiCompareStr( 'HOLa', 'HOLA' ) devuelve -1

¿Cuando se considera una cadena de texto superior a otra? Pues el orden es el siguiente:

Letras mayúsculas > Letras minúsculas
Letras minúsculas > Números

function AnsiCompareText( const S1, S2: string ): Integer;

Esta función es similar a AnsiCompareStr a diferencia de que no distingue entre mayúsculas y minúsculas. En el caso anterior:

AnsiCompareText( 'HOLA', 'HOLA' ) devuelve 0
AnsiCompareText( 'HOLA', 'HOLa' ) devuelve 0
AnsiCompareText( 'HOLa', 'HOLA' ) devuelve 0
AnsiCompareText( 'HOLA', 'HOLLA' ) devuelve -1
AnsiCompareText( 'HOLLA', 'HOLA' ) devuelve 1

El orden entre cadenas se define por:

Letras > Números

function AnsiContainsStr( const AText, ASubText: string ): Boolean;

Comprueba si la cadena ASubText esta dentro de la cadena AText. Por ejemplo:

AnsiContainsStr( 'DELPHI AL LIMITE', 'LIMITE' ) devuelve True
AnsiContainsStr( 'DELPHI AL LIMITE', 'LIMITe' ) devuelve False

function AnsiContainsText( const AText, ASubText: string ): Boolean;

Esta función es igual a AnsiConstainsStr salvo que no diferencia mayúsculas de minúsculas. Veamos un ejemplo:

AnsiContainsText( 'DELPHI AL LIMITE', 'LIMITE' ) devuelve True
AnsiContainsText( 'DELPHI AL LIMITE', 'LIMITe' ) devuelve True
AnsiContainsText( 'DELPHI AL LIMITE', 'LIMITES' ) devuelve False

function AnsiEndsStr( const ASubText, AText: string ): Boolean;

La función nos devuelve True si la cadena AText termina en la cadena ASubText. He aquí un ejemplo:

AnsiEndsStr( '.avi', 'C:\Archivos de programa\Emule\Incoming\pelicula.avi' ) devuelve True
AnsiEndsStr( '.AVI', 'C:\Archivos de programa\Emule\Incoming\pelicula.avi' ) devuelve False

Para este caso es mejor utilizar la función:

function AnsiEndsText( const ASubText, AText: string ): Boolean;

Esta función obtiene el mismo resultado que AnsiEndsStr pero sin diferenciar mayúsculas de minúsculas. En el caso anterior:

AnsiEndsText( '.avi', 'C:\Archivos de programa\Emule\Incoming\pelicula.avi' ) devuelve True
AnsiEndsText( '.AVI', 'C:\Archivos de programa\Emule\Incoming\pelicula.avi' ) devuelve True

Como vemos es ideal para comprobar extensiones de archivos.

En el próximo artículo seguiremos con muchas más funciones.

Pruebas realizadas en Delphi 7.

06 agosto 2007

Dando formato a los números reales

La unidad SysUtils dispone del tipo TFloatFormat siguiente:

type TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);

Este tipo es utilizado por las funciones CurrToStrF, FloatToStrF y FloatToText para dar formato a los números reales que pasen a formato texto. Como hemos visto anteriormente, los posibles valores de TFloatFormat son:

ffGeneral

Define el formato general de un número real acercando el valor resultante tanto como sea posible. Quita los ceros que se arrastran y la coma cuando sea necesario. No muestra ningún separador de miles y utiliza el formato exponencial cuando la mantisa es demasiado grande para el valor especificado según el formato. El formato de la coma es determinado por la variable DecimalSeparator.

Veamos un ejemplo mostrando el resultado en un campo Memo:

var rCantidad: Extended; // Número real para hacer pruebas
begin
rCantidad := 1234.56;

Memo.Lines.Add( 'General 4,0 = ' + FloatToStrF( rCantidad, ffGeneral, 4, 0 ) );
Memo.Lines.Add( 'General 6,0 = ' + FloatToStrF( rCantidad, ffGeneral, 6, 0 ) );
Memo.Lines.Add( 'General 6,2 = ' + FloatToStrF( rCantidad, ffGeneral, 6, 2 ) );
Memo.Lines.Add( 'General 3,2 = ' + FloatToStrF( rCantidad, ffGeneral, 3, 2 ) );

El resultado que nos muestra es el siguiente:

General 4,0 = 1235
General 6,0 = 1234,56
General 6,2 = 1234,56
General 3,2 = 1,23E03

Como vemos la función FloatToStrF toma los siguientes parámetros:

function FloatToStrF(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string; overload;

Value es el número real que vamos a pasar a texto.
Format es el tipo de formato en coma flotante que vamos a utilizar (en este caso ffGeneral).
Precision es el número máximo de dígitos enteros que soporta el formato.
Digits es el número máximo de decimales que soporta el formato.

En el caso anterior cuando forzamos a mostrar menos dígitos de precisión de lo que el número real tiene lo que hace la función es recortar o bien decimales o si la cantidad entera es superior al formato lo pasa al formato exponencial.

Veamos el resto de formatos:

ffExponent

Muestra el número real en formato científico cuyo exponente viene representado con la letra E con base 10. Por ejemplo E+15 significa 1015. El carácter de la coma es representado por la variable DecimalSeparator.

Aquí vemos como queda el mismo número en distintos formatos exponenciales:

Memo.Lines.Add( 'Exponencial 4,0 = ' + FloatToStrF( rCantidad, ffExponent, 4, 0 ) );
Memo.Lines.Add( 'Exponencial 6,0 = ' + FloatToStrF( rCantidad, ffExponent, 6, 0 ) );
Memo.Lines.Add( 'Exponencial 6,2 = ' + FloatToStrF( rCantidad, ffExponent, 6, 2 ) );
Memo.Lines.Add( 'Exponencial 3,2 = ' + FloatToStrF( rCantidad, ffExponent, 3, 2 ) );

cuyo resultado es:

Exponencial 4,0 = 1,235E+3
Exponencial 6,0 = 1,23456E+3
Exponencial 6,2 = 1,23456E+03
Exponencial 3,2 = 1,23E+03

El formato ffFixed

Este formato no utiliza ningún separador de unidades de millar. Al igual que los formatos anteriores si la precisión del número real es superior al formato entonces muestra el resultado en notación científica. Quedaría de la siguiente manera:

Memo.Lines.Add( 'Fijo 4,0 = ' + FloatToStrF( rCantidad, ffFixed, 4, 0 ) );
Memo.Lines.Add( 'Fijo 6,0 = ' + FloatToStrF( rCantidad, ffFixed, 6, 0 ) );
Memo.Lines.Add( 'Fijo 6,2 = ' + FloatToStrF( rCantidad, ffFixed, 6, 2 ) );
Memo.Lines.Add( 'Fijo 3,2 = ' + FloatToStrF( rCantidad, ffFixed, 3, 2 ) );

dando los valores:

Fijo 4,0 = 1235
Fijo 6,0 = 1235
Fijo 6,2 = 1234,56
Fijo 3,2 = 1,23E03

El formato ffNumber

Es igual al formato ffFixed salvo que también incluye el separador de unidades de millar, el cual viene representado por la variable ThousandSeparator. En nuestro ejemplo:

Memo.Lines.Add( 'Número 4,0 = ' + FloatToStrF( rCantidad, ffNumber, 4, 0 ) );
Memo.Lines.Add( 'Número 6,0 = ' + FloatToStrF( rCantidad, ffNumber, 6, 0 ) );
Memo.Lines.Add( 'Número 6,2 = ' + FloatToStrF( rCantidad, ffNumber, 6, 2 ) );
Memo.Lines.Add( 'Número 3,2 = ' + FloatToStrF( rCantidad, ffNumber, 3, 2 ) );

mostraría:

Número 4,0 = 1.235
Número 6,0 = 1.235
Número 6,2 = 1.234,56
Número 3,2 = 1,23E03

El formato ffCurrency

Es similar al formato ffNumber pero con un símbolo de secuencia agregado, según se haya definido en la variable CurrencyString. Este formato también esta influenciado por las variables CurrencyFloat y NegCurrFloat. Sigamos el ejemplo:

Memo.Lines.Add( 'Moneda 4,0 = ' + FloatToStrF( rCantidad, ffCurrency, 4, 0 ) );
Memo.Lines.Add( 'Moneda 6,0 = ' + FloatToStrF( rCantidad, ffCurrency, 6, 0 ) );
Memo.Lines.Add( 'Moneda 6,2 = ' + FloatToStrF( rCantidad, ffCurrency, 6, 2 ) );
Memo.Lines.Add( 'Moneda 3,2 = ' + FloatToStrF( rCantidad, ffCurrency, 3, 2 ) );

Da como resultado:

Moneda 4,0 = 1.235 €
Moneda 6,0 = 1.235 €
Moneda 6,2 = 1.234,56 €
Moneda 3,2 = 1,23E03

según las variables mencionadas anteriormente que recogen el formato moneda por defecto configurado en Windows.

Pruebas realizadas en Delphi 7.

03 agosto 2007

El tipo Variant

Las variables de tipo Variant dan una gran flexibilidad a Delphi permitiendo el almacenamiento de cualquier tipo de dato básico dentro de las mismas.

Estas variables son muy útiles cuando se necesitan procesar muchos datos en tiempo de ejecución antes de saber su tipo, pero debido a los errores que puede causar hay que tener cuidado al utilizarlas.

Lo que no pueden contener es ninguna estructura de datos, objetos ni punteros. Por ejemplo, no se puede hacer:

var
Variable: Variant;
begin
Variable := nil;

Ya que provocaría un error al compilar. Pero si se puede hacer:

Variable := NULL;

Y mucho ojo porque no es lo mismo una variable Nula que una variable Vacia. Cuando se crea una variable Variant y no se hace nada con ella sigue siendo una variable Vacia, pero no nula. Será Nula si nosotros se lo decimos como hemos visto anteriormente.

¿Pero como sabemos que tipo tipo de dato contiene una variable Variant? Pues para eso tenemos la función VarType que nos devuelve el tipo de dato que contiene una variable Variant. Aquí tenemos una función que nos devuelve el tipo de dato de un Variant:

function TipoVariable( Variable: Variant ): String;
var iTipo: Integer;
begin
iTipo := VarType( Variable );

case iTipo of
varEmpty : Result := 'Vacía';
varNull : Result := 'Nula';
varSmallInt : Result := 'SmallInt';
varInteger : Result := 'Integer';
varSingle : Result := 'Single';
varDouble : Result := 'Double';
varCurrency : Result := 'Currency';
varDate : Result := 'Date';
varOleStr : Result := 'OleStr';
varDispatch : Result := 'Dispatch';
varError : Result := 'Error';
varBoolean : Result := 'Boolean';
varVariant : Result := 'Variant';
varUnknown : Result := 'Desconocida';
varByte : Result := 'Byte';
varWord : Result := 'Word';
varLongWord : Result := 'LongWord';
varInt64 : Result := 'Int64';
varStrArg : Result := 'StrArg';
varString : Result := 'String';
varAny : Result := 'Any';
end;

Result := 'Tipo ' + Result;
end;

Veamos un ejemplo de su utilización volcando el contenido en un Memo:

var
Variable: Variant;
begin
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := NULL;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 125;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 1250;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 125000;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := -1800;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := -1900000;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 'Cadena de texto';
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := True;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );

El resultado que mostrará en pantalla será el siguiente:

Variable=
Tipo Vacía
Variable=
Tipo Nula
Variable=125
Tipo Byte
Variable=1250
Tipo Word
Variable=125000
Tipo LongWord
Variable=-1800
Tipo SmallInt
Variable=-1900000
Tipo Integer
Variable=Cadena de texto
Tipo String
Variable=True
Tipo Boolean

Como vemos según el dato que guardamos en la variable va adaptándose de un tipo a otro.

Pruebas realizadas en Delphi 7.

02 agosto 2007

Conversiones entre unidades de medida

Delphi incorpora una librería interesante encargada de realizar conversiones entre unidades de tiempo, volumen, distancia, etc. Para ello hay que añadir las unidades ConvUtils y StdConvs:

uses
Windows, Messages, ..., ConvUtils, StdConvs;

La función encargada de realizar conversiones es la siguiente:

Convert( ValorAConvertir: Double; DesdeUnidad, HastaUnidad: TConvType): Double;

Veamos algunos ejemplos mostrando el resultado en un campo Memo.
Para convertir de millas a kilómetros:

var dMillas, dKilometros: Double;
begin
dMillas := 15;
dKilometros := Convert( dMillas, duMiles, duKilometers );
Memo.Lines.Add( Format( '%8.4f Millas = %8.4f Kilometros', [dMillas, dKilometros] ) );

Esta otra convierte de pulgadas de área a centímetros de area:

var dPulgadas, dCentimetros: Double;
begin
dPulgadas := 21;
dCentimetros := Convert( dPulgadas, auSquareInches, auSquareCentimeters );
Memo.Lines.Add( Format( '%8.4f Pulgadas de área = %8.4f Centímetros de área', [dPulgadas, dCentimetros] ) );

Y si queremos convertir libras en kilogramos:

var dLibras, dKilos: Double;
begin
dLibras := 60;
dKilos := Convert( dLibras, muPounds, muKilograms );
Memo.Lines.Add( Format( '%8.4f Libras = %8.4f Kilos', [dLibras, dKilos] ) );

También podemos convertir unidades de temperatura:

var dFahrenheit, dCelsius: Double;
begin
dFahrenheit := 84;
dCelsius := Convert( dFahrenheit, tuFahrenheit, tuCelsius );
Memo.Lines.Add( Format( '%8.4fº Fahrenheit = %8.4fº Celsius', [dFahrenheit, dCelsius] ) );

Así como conversión entre unidades de volumen:

var dMetrosCubicos, dLitros: Double;
begin
dMetrosCubicos := 43;
dLitros := Convert( dMetrosCubicos, vuCubicMeters, vuLiters );
Memo.Lines.Add( Format( '%8.4f Metros cúbicos = %8.4fº Litros', [dMetrosCubicos, dLitros] ) );

Ahora vamos a ver todos los tipos de conversión según las unidades de medida.
Para convertir entre unidades de área tenemos:

auSquareMillimeters
auSquareCentimeters
auSquareDecimeters
auSquareMeters
auSquareDecameters
auSquareHectometers
auSquareKilometers
auSquareInches
auSquareFeet
auSquareYards
auSquareMiles
auAcres
auCentares
auAres
auHectares
auSquareRods

Convertir entre unidades de distancia:

duMicromicrons
duAngstroms
duMillimicrons
duMicrons
duMillimeters
duCentimeters
duDecimeters
duMeters
duDecameters
duHectometers
duKilometers
duMegameters
duGigameters
duInches
duFeet
duYards
duMiles
duNauticalMiles
duAstronomicalUnits
duLightYears
duParsecs
duCubits
duFathoms
duFurlongs
duHands
duPaces
duRods
duChains
duLinks
duPicas
duPoints

Convertir entre unidades de masa:

muNanograms
muMicrograms
muMilligrams
muCentigrams
muDecigrams
muGrams
muDecagrams
muHectograms
muKilograms
muMetricTons
muDrams
muGrains
muLongTons
muTons
muOunces
muPounds
muStones

Convertir entre unidades de temperatura:

tuCelsius
tuKelvin
tuFahrenheit
tuRankine
tuReamur

Convertir entre unidades de tiempo:

tuMilliSeconds
tuSeconds
tuMinutes
tuHours
tuDays
tuWeeks
tuFortnights
tuMonths
tuYears
tuDecades
tuCenturies
tuMillennia
tuDateTime
tuJulianDate
tuModifiedJulianDate

Convertir entre unidades de volumen:

vuCubicMillimeters
vuCubicCentimeters
vuCubicDecimeters
vuCubicMeters
vuCubicDecameters
vuCubicHectometers
vuCubicKilometers
vuCubicInches
vuCubicFeet
vuCubicYards
vuCubicMiles
vuMilliLiters
vuCentiLiters
vuDeciLiters
vuLiters
vuDecaLiters
vuHectoLiters
vuKiloLiters
vuAcreFeet
vuAcreInches
vuCords
vuCordFeet
vuDecisteres
vuSteres
vuDecasteres
vuFluidGallons
vuFluidQuarts
vuFluidPints
vuFluidCups
vuFluidGills
vuFluidOunces
vuFluidTablespoons
vuFluidTeaspoons
vuDryGallons
vuDryQuarts
vuDryPints
vuDryPecks
vuDryBuckets
vuDryBushels
vuUKGallons
vuUKPottles
vuUKQuarts
vuUKPints
vuUKGills
vuUKOunces
vuUKPecks
vuUKBuckets
vuUKBushels

Pruebas realizadas en Delphi 7.

01 agosto 2007

Tipos de puntero

Pointer:

- Es un tipo general de puntero hacia cualquier objeto o variable en memoria.
- Al no ser de ningún tipo suele ser bastante peligroso si provoca desbordamientos de memoria.

PAnsiChar:

- Es un tipo de puntero hacia un valor AnsiChar.
- También puede ser utilizado para apuntar a caracteres dentro de una cadena AnsiString.
- Al igual que otros punteros permite la aritmética, es decir, los procedimientos Inc y Dec pueden utilizarse para mover el puntero en memoria.

PAnsiString:

- Apunta hacia una cadena AnsiString.
- Debido a que AnsiString ya es un puntero hacia si misma, el puntero PAnsiString no suele utilizarse mucho.

PChar:

- Es un tipo de puntero hacia un valor Char.
- Puede ser utilizado para apuntar a caracteres dentro de una cadena string.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.
- Suele utilizarse mucho para procesar cadenas de caracteres terminadas en cero, tal como las utilizadas en el lenguaje C/C++.
- Los caracteres Char son idénticos a los de las variables AnsiChar, siendo de 8 bits de tamaño.

PCurrency:

- Apunta hacia un valor Currency.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PDateTime:

- Apunta hacia un valor TDateTime.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PExtended:

- Apunta hacia un valor Extended.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PInt64:

- Apunta hacia un valor Int64.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PShortString:

- Apunta hacia una cadena ShortString.
- Debido a que las variables ShortString difieren de las variables string,
para apuntar a una variable ShortString es necesario utilizar la función Addr.

PString:

- Apunta hacia una cadena String.
- Al ser la cadena String un puntero en si misma no suele utilizarse mucho este puntero.

PVariant:

- Apunta hacia un valor Variant.
- Al ser Variant un tipo genérico y variable hay que extremar la precaución en el manejo de este puntero.

PWideChar:

- Apunta hacia un valor WideChar.
- Puede ser utilizado para apuntar a caracteres dentro de una cadena WideString.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PWideString:

- Apunta hacia una cadena WideString.
- Al ser ya cadena WideString un puntero en si misma no suele utilizarse mucho.

Pruebas realizadas en Delphi 7.

31 julio 2007

Tipos de variable para el manejo de caracteres

AnsiChar:

- Permite el almacenamiento de un carácter o un número entero.
- Valores comprendidos entre 0 y 255.
- Gasta un byte de memoria (8 bits).

AnsiString:

- Un tipo de dato que almacena una cadena de caracteres tipo AnsiChar.
- Cada carácter gasta un byte de memoria (8 bits), aunque la longitud de la cadena puede ser ilimitada.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- El primer elemento comienza por [1].

ShortString:

- Variable para guardar un simple carácter o un número entero.
- Valores comprendidos entre 0 y 255.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- Permite un máximo de 255 caracteres.
- El primer elemento comienza por [1].

String:

- Un tipo de dato que almacena una cadena de caracteres.
- Cuando se crea es tratado como AnsiString.
- La longitud es ilimitada siendo cada carácter de un byte (8 bits).
- El primer elemento comienza por [1].

WideChar:

- Almacena un carácter internacional.
- Puede guardar un carácter o un número entero entre 0 y 65535.
- Gasta 2 bytes de memoria (16 bits).

WideString:

- Un tipo de dato que almacena una cadena de caracteres tipo WideChar.
- Cada carácter gasta 2 bytes de memoria (16 bits), aunque la longitud de la cadena puede ser ilimitada.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- El primer elemento comienza por [1].

Pruebas realizadas en Delphi 7.

30 julio 2007

Los tipos reales en Delphi

Currency:

- Tipo flotante de punto fijo con 4 decimales usado para valores financieros, minimizando así los errores de redondeo (recomendado para programas de gestión).
- Gasta 8 bytes de memoria (64 bits).

Double:

- Tipo flotante de uso general.
- Soporta hasta 15 dígitos de precisión.
- Gasta 8 bytes de memoria (64 bits).

Extended:

- Tipo flotante con alta capacidad y precisión.
- Soporta hasta 19 dígitos de precisión.
- Gasta 10 bytes de memoria (80 bits).

Real:

- Tipo flotante general obsoleto mantenido por compatibilidad hacia atrás (usar Double en su lugar).
- Soporta hasta 15 dígitos de precisión.
- Gasta 8 bytes de memoria (64 bits).

Real48:

- Tipo flotante general obsoleto mantenido por compatibilidad hacia atrás (usar Extended en su lugar).
- Soporta hasta 11 dígitos de precisión.
- Gasta 6 bytes de memoria (48 bits).

Single:

- El tipo flotante que tiene menos capacidad y precisión, aunque es el más rápido de procesar.
- Soporta hasta 7 dígitos de precisión.
- Gasta 4 bytes de memoria (32 bits).

Pruebas realizadas en Delphi 7.

27 julio 2007

Los tipos enteros en Delphi

Byte:

- Tipo entero que soporta valores entre 0 y 255.
- Gasta un byte de memoria (8 bits).

Cardinal:

- Tipo entero básico sin signo.
- Soporta valores entre 0 y 4294967295.
- Gasta 4 bytes de memoria (32 bits).

Integer:

- Tipo entero con signo.
- Soporta valores entre -2147483648 y 2147483647.
- Gasta 4 bytes de memoria (32 bits)

Int64:

- Tipo entero con signo.
- Alcanza valores desde -9223372036854775808 hasta 9223372036854775807.
- Gasta 8 bytes de memoria (64 bits).

LongInt:

- Tipo entero con signo.
- Valores comprendidos entre -2147483648 y 2147483647.
- Gasta 4 bytes de memoria (32 bits).
- Es un tipo fijo que no cambiará en futuras versiones de Delphi.

LongWord:

- Tipo entero sin signo.
- Valores comprendidos entre 0 y 4294967295.
- Gasta 4 bytes de memoria (32 bits).

DWord:

- Igual que LongWord;

ShortInt:

- Tipo entero con signo.
- Valores comprendidos entre -128 y 127.
- Gasta 1 byte de memoria (8 bits).

SmallInt:

- Tipo entero con signo.
- Valores comprendidos entre -32768 y 32767.
- Gasta 2 bytes de memoria (16 bits).

Word:

- Tipo entero sin signo.
- Valores comprendidos entre 0 y 65535.
- Gasta 2 bytes de memoria (16 bits).

Pruebas realizadas en Delphi 7.

26 julio 2007

Trabajando con arrays dinámicos

Una de las ventajas de los arrays dinámicos respecto a los estáticos es que pueden modificar su tamaño en tiempo de ejecución y no es necesaria la gestión de memoria para los mismos, ya que se liberan automáticamente al terminar el procedimiento, función o clase donde están alojados. También son ideales para enviar un número indeterminado de parámetros a funciones o procedimientos.

Para crear una array dinámico lo que hacemos es declarar el array pero sin especificar su tamaño:

public
Clientes: array of string;

Antes de meter un elemento al array hay que especificar su tamaño con la función SetLength. En este ejemplo creamos tres elementos:

SetLength( Clientes, 3 );

Y ahora introducimos los datos en el mismo:

Clientes[0] := 'JUAN';
Clientes[1] := 'CARLOS';
Clientes[2] := 'MARIA';

A diferencia de los arrays estáticos el primer elemento es el cero y no
el uno. Como he dicho antes no es necesario liberarlos de memoria, pero
si aún así deseamos hacerlo sólo es necesario hacer lo siguiente:

Clientes := nil;

con lo cual el array queda inicializado para que pueda volver a ser utilizado.

Pruebas realizadas en Delphi 7.

25 julio 2007

Clonar las propiedades de un control

Cuantas veces hemos deseado en tiempo de ejecución copiar las características de un control a otro según las acciones del usuario. Por ejemplo si tenemos nuestro propio editor de informes se podrían copiar las carácterísticas de las etiquetas seleccionas por el usuario al resto del formulario (font, color, width, etc.)

Para ello tenemos que añadir la unidad TypInfo:


uses
Windows, Dialogs, ..., TypInfo;

A esta función que voy a mostrar hay que pasarle el control origen y el destino (la copia) así como que propiedades deseamos copiar:

function ClonarPropiedades( Origen, Destino: TObject;
Propiedades: array of string ): Boolean;
var
i: Integer;
begin
Result := True;
try
for i := Low( Propiedades ) to High( Propiedades ) do
begin
// ¿Existe la propiedad en el control origen?
if not IsPublishedProp( Origen, Propiedades[I] ) then
Continue;

// ¿Existe la propiedad en el control destino?
if not IsPublishedProp( Destino, Propiedades[I] ) then
Continue;

// ¿Son del mismo tipo las dos propiedades?
if PropType( Origen, Propiedades[I]) <>
PropType( Destino, Propiedades[I] ) then
Continue;

// Copiamos la propiedad según si es variable o método
case PropType(Origen, Propiedades[i]) of
tkClass:
SetObjectProp( Destino, Propiedades[i],
GetObjectProp( Origen, Propiedades[i] ) );

tkMethod:
SetMethodProp( Destino, Propiedades[I],
GetMethodProp( Origen, Propiedades[I] ) );
else
SetPropValue( Destino, Propiedades[i],
GetPropValue( Origen, Propiedades[i] ) );
end;
end;
except
Result := False;
end;
end;

Para copiar las características principales de una etiqueta habría que llamar a la función de la siguiente manera:

ClonarPropiedades( Label1, Label2, ['Font', 'Color', 'Alignment',
'Width', 'Height', 'Layout'] );

También se pueden copiar eventos tales como OnClick, OnMouseDown, etc. permitiendo así abarcar muchos controles con un solo evento.

Pruebas realizadas en Delphi 7.

24 julio 2007

Aplicar antialiasing a una imagen

El algoritmo antialiasing se suele aplicar a una imagen para evitar los bordes dentados y los degradados bruscos de color. Lo que hace es suavizar toda la imagen.

En este caso el siguiente procedimiento toma un objeto TImage como primer parámetro y como segundo el porcentaje de antialiasing deseado, siendo normal no aplicar más del 10 o 20%:

procedure Antialiasing( Imagen: TImage; iPorcentaje: Integer );
type
TRGBTripleArray = array[0..32767] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
var
SL, SL2: PRGBTripleArray;
l, m, p: Integer;
R, G, B: TColor;
R1, R2, G1, G2, B1, B2: Byte;
begin
with Imagen.Canvas do
begin
Brush.Style := bsClear;
Pixels[1, 1] := Pixels[1, 1];

for l := 0 to Imagen.Height - 1 do
begin
SL := Imagen.Picture.Bitmap.ScanLine[l];

for p := 1 to Imagen.Width - 1 do
begin
R1 := SL[p].rgbtRed;
G1 := SL[p].rgbtGreen;
B1 := SL[p].rgbtBlue;

if (p < 1) then
m := Imagen.Width
else
m := p - 1;

R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;

if ( p > Imagen.Width - 2 ) then
m := 0
else
m := p + 1;

R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;

if ( l < 1 ) then
m := Imagen.Height - 1
else
m := l - 1;

SL2 := Imagen.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;

if ( l > Imagen.Height - 2 ) then
m := 0
else
m := l + 1;

SL2 := Imagen.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;
end;
end;
end;
end;

Suponiendo que tengamos en un formulario un objeto TImage llamado Image1 llamaríamos a este procedimiento de la siguiente manera:

Antialiasing( Image1, 10 );

Pruebas realizadas en Delphi 7.

23 julio 2007

Dibujar varias columnas en un ComboBox

Vamos a ver un ejemplo de dibujar tres columnas al desplegar un ComboBox. El truco está en guardar el valor de las tres columnas en el mismo item pero separado por un punto y coma.

Después implementamos nuestra propia función de dibujado de columnas para que muestre las tres columnas. Para ello metemos en el evento OnDrawItem del ComboBox:

procedure TFormulario.ComboBoxDrawItem( Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
var
sValor, sTodo: string;
i, iPos: Integer;
rc: TRect;
AnchoColumna: array[0..3] of Integer;
begin
ComboBox.Canvas.Brush.Style := bsSolid;
ComboBox.Canvas.FillRect( Rect );

// Las columnas deben ir separadas por un ;
sTodo := ComboBox.Items[Index];

// Establecemos el ancho de las columnas
AnchoColumna[0] := 0;
AnchoColumna[1] := 100; // Ancho de la columna 1
AnchoColumna[2] := 200; // Ancho de la columna 2
AnchoColumna[3] := 300; // Ancho de la columna 3

// Leemos el texto de la primera columna
iPos := Pos( ';', sTodo );
sValor := Copy( sTodo, 1, iPos - 1 );

for i := 0 to 3 do
begin
// Dibujamos la primera columna
rc.Left := Rect.Left + AnchoColumna[i] + 2;
rc.Right := Rect.Left + AnchoColumna[i+1] - 2;
rc.Top := Rect.Top;
rc.Bottom := Rect.Bottom;

// Escribimos el texto
Combobox.Canvas.TextRect( rc, rc.Left, rc.Top, sValor );

// Dibujamos las líneas que separan las columnas
if i < 3 then
begin
Combobox.Canvas.MoveTo( rc.Right, rc.Top );
Combobox.Canvas.LineTo( rc.Right, rc.Bottom );
end;

// Leemos el texto de la segunda columna
sTodo := Copy( sTodo, iPos + 1, Length( sTodo ) - iPos );
iPos := Pos( ';', sTodo );
sValor := Copy( sTodo, 1, iPos - 1 );
end;
end;

Modificando el bucle y el array de enteros AnchoColumna podemos crear el número de columnas que queramos. Ahora sólo hay que meter los items en el ComboBox separados por punto y coma:

with Combobox.Items do
begin
Add( 'JOSE;SANCHEZ;GARCIA;' );
Add( 'MARIA;PEREZ;GOMEZ;' );
Add( 'ANDRES;MARTINEZ;RUIZ;' );
end;

Por último hay que decirle al ComboBox que la rutina de pintar los items corre por nuestra cuenta:

procedure TFormulario.FormCreate(Sender: TObject);
begin
// Le decimos al ComboBox que lo vamos a pintar nosotros
Combobox.Style := csOwnerDrawFixed;
end;

Pruebas realizadas en Delphi 7.

20 julio 2007

Generar claves aleatorias

El siguiente procedimiento que voy a mostrar genera una clave aleatoria según el número de sílabas y números que le indiquemos. Por ejemplo:

GenerarClave( 3, 2 )

puede devolver:

catamo56
dilema12
catoye97
...

Aquí tenemos el generador de claves:

function GenerarClave( iSilabas, iNumeros: Byte ): string;
const
Consonante: array [0..19] of Char = ( 'b', 'c', 'd', 'f', 'g', 'h', 'j',
'k', 'l', 'm', 'n', 'p', 'r', 's',
't', 'v', 'w', 'x', 'y', 'z' );

Vocal: array [0..4] of Char = ( 'a', 'e', 'i', 'o', 'u' );

function Repetir( sCaracter: String; iVeces: Integer ): string;
var
i: Integer;
begin
Result := '';
for i := 1 to iVeces do
Result := Result + sCaracter;
end;

var
i: Integer;
si, sf: Longint;
n: string;
begin
Result := '';
Randomize;

if iSilabas <> 0 then
for i := 1 to iSilabas do
begin
Result := Result + Consonante[Random(19)];
Result := Result + Vocal[Random(4)];
end;

if iNumeros = 1 then
Result := Result + IntToStr(Random(9))
else
if iNumeros >= 2 then
begin
if iNumeros > 9 then
iNumeros := 9;

si := StrToInt('1' + Repetir( '0', iNumeros - 1 ) );
sf := StrToInt( Repetir( '9', iNumeros ) );
n := FloatToStr( si + Random( sf ) );
Result := Result + Copy( n, 0, iNumeros );
end;
end;

Suele utilizarse en la creación de cuentas de usuario y departamentos en programas de gestión, dejando que posteriormente el usuario pueda cambiarse la clave.

Pruebas realizadas en Delphi 7.

19 julio 2007

Meter recursos dentro de un ejecutable

Una de las cosas que mas hacen engordar el tamaño de un ejecutable es meter los mismos botones con imagenes en distintos formularios. Si diseñamos nuestros propios botones Aceptar y Cancelar y los vamos replicando en cada formulario el tamaño de nuestro programa puede crecer considerablemente.

Para evitar esto lo que vamos a hacer es meter la imagen dentro de un recurso compilado y posteriormente accederemos a la misma dentro del programa. La ventaja de utilizar este método es que la imagen sólo esta una vez en el programa independientemente del número de formularios donde vaya a aparecer.

Supongamos que vamos a meter la imagen MiBoton.jpg dentro de nuestro programa. Creamos al lado de la misma el archivo imagenes.rc el cual contiene:

1 RCDATA MiBoton.jpg

Se pueden meter en un archivo de recursos tantas imagenes como se desee, así como otros tipos de archivo (sonidos, animaciones flash, etc.). Las siguientes líneas serían:

2 RCDATA imagen2.jpg
3 RCDATA imagen3.jpg
...

Ahora abrimos una ventana de símbolo del sistema dentro del mismo directorio donde este la imagen y compilamos el recurso:

c:\imagenes\brc32 -r -v imagenes.rc

Lo cual nos creará el archivo imagenes.res.

Ahora para utilizar el recurso dentro de nuestro programa hay que añadir debajo de implementation (del formulario principal de la aplicación) la directiva {$R imagenes.res}:

implementation

{$R *.dfm}
{$R imagenes.res}

Esto lo que hace es unir todos los recursos de imagenes.res con nuestro ejecutable. Para cargar la imagen dentro de un objeto TImage hacemos lo siguiente:

procedure TFPrincipal.FormCreate( Sender: TObject );
var
Recursos: TResourceStream;
Imagen: TJPegImage;
begin
Imagen := TJPegImage.Create;
Recursos := TResourceStream.Create( hInstance, '#1', RT_RCDATA );
Recursos.Seek( 0, soFromBeginning );
Imagen.LoadFromStream( Recursos );
Imagen1.Canvas.Draw( 0, 0, Imagen );
Recursos.Free;
Imagen.Free;
end;

Donde Imagen1 es un objeto TImage. Aunque pueda parecer algo molesto tiene las siguientes ventajas:

- Evita que un usuario cualquiera utilice nuestras imagenes (a menos claro que sepa utilizar un editor de recursos).

- Facilita la distribución de nuestro programa (va todo en el exe).

- Se puede añadir cualquier tipo de archivo o dato dentro del ejecutable.

- Ahorramos mucha memoria al cargar una sola vez el recurso.

Pruebas realizadas en Delphi 7.

18 julio 2007

Dibujar un gradiente en un formulario

Con un sencillo procedimiento podemos hacer que el fondo de nuestros formularios quede con un aspecto profesional con un degradado de color. Para ello escribimos en el evento OnPaint del formulario:

procedure TFormulario.FormPaint( Sender: TObject );
var
wFila, wVertical: Word;
iRojo: Integer;
begin
iRojo := 200;
wVertical := ( ClientHeight + 512 ) div 256;

for wFila := 0 to 512 do
begin
with Canvas do
begin
Brush.Color := RGB( iRojo, 0, wFila );
FillRect( Rect( 0, wFila * wVertical, ClientWidth, ( wFila + 1 ) * wVertical ) );
Dec( iRojo );
end;
end;
end;

Lo que hace es crear un barrido vertical según el ancho y alto de nuestro formulario y va restando de la paleta RGB el componente rojo. Si queremos cambiar el color sólo hay que jugar con los componentes RGB hasta conseguir el efecto deseado.

Al maximizar o cambiar el ancho y alto de la ventana se quedará el degradado cortado. Para evitar esto le decimos en el evento OnResize que vuelva a pintar la ventana:

procedure TFormulario.FormResize( Sender: TObject );
begin
Repaint;
end;

Este efecto suele utilizarse mucho instalaciones o en CD-ROM interactivos, catálogos, etc.

Pruebas realizadas en Delphi 7.

17 julio 2007

Trocear y unir archivos

Una de las utilidades más famosas que se han asociado a la descarga de archivos es el programa Hacha, el cual trocea archivos a un cierto tamaño para luego poder unirlos de nuevo.

El siguiente procedimiento parte un archivo a la longitud en bytes que le pasemos:

procedure TrocearArchivo( sArchivo: TFileName; iLongitudTrozo: Integer );
var
i: Word;
FS, Stream: TFileStream;
sArchivoPartido: String;
begin
FS := TFileStream.Create( sArchivo, fmOpenRead or fmShareDenyWrite );

try
for i := 1 to Trunc( FS.Size / iLongitudTrozo ) + 1 do
begin
sArchivoPartido := ChangeFileExt( sArchivo, '.' + FormatFloat( '000', i ) );
Stream := TFileStream.Create( sArchivoPartido, fmCreate or fmShareExclusive );

try
if fs.Size - fs.Position < iLongitudTrozo then
iLongitudTrozo := FS.Size - FS.Position;

Stream.CopyFrom( FS, iLongitudTrozo );
finally
Stream.Free;
end;
end;
finally
FS.Free;
end;
end;

Si por ejemplo le pasamos el archivo Documentos.zip creará los archivos:

Documentos.001
Documentos.002
....

Para volver a unirlo tenemos otro procedimiento donde le pasamos el primer trozo y el nombre del archivo original:

procedure UnirArchivo( sTrozo, sArchivoOriginal: TFileName );
var
i: integer;
FS, Stream: TFileStream;
begin
i := 1;
FS := TFileStream.Create( sArchivoOriginal, fmCreate or fmShareExclusive );

try
while FileExists( sTrozo ) do
begin
Stream := TFileStream.Create( sTrozo, fmOpenRead or fmShareDenyWrite );

try
FS.CopyFrom( Stream, 0 );
finally
Stream.Free;
end;

Inc(i);
sTrozo := ChangeFileExt( sTrozo, '.' + FormatFloat( '000', i ) );
end;
finally
FS.Free;
end;
end;

Una ampliación interesante a estos procedimientos sería meter el nombre del archivo original en el primer o último trozo, así como un hash (MD4, MD5, SHA, etc.) para saber si algún trozo está defectuoso.

Pruebas realizadas en Delphi 7.

16 julio 2007

Mover componentes en tiempo de ejecución

Para darle un toque profesional a un programa no esta mal añadir un editor que permita al usuario personalizar sus formularios, informes o listados. Por ejemplo en un programa de facturación sería interesante que el usuario pudiera personalizar el formato de su factura.

Antes de nada hay que crear en la sección private del formulario tres variables encargadas de guardar las coordenadas del componente que se esta moviendo así como una variable booleana que nos dice si en este momento se esta moviendo un componente:

private
{ Private declarations }
iComponenteX, iComponenteY: Integer;
bMoviendo: Boolean;

Creamos dentro de type la definición de un control movible:

type
TMovible = class( TControl );

Los siguientes procedimientos hay que asignarlos a un componente para que puedan ser movidos por todo el formulario al ejecutar el programa:

procedure TFPrincipal.ControlMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
iComponenteX := X;
iComponenteY := Y;
bMoviendo := True;
TMovible( Sender ).MouseCapture := True;
end;

procedure TFPrincipal.ControlMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
if bMoviendo then
with Sender as TControl do
begin
Left := X - iComponenteX + Left;
Top := Y - iComponenteY + Top;
end;
end;

procedure TFPrincipal.ControlMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
if bMoviendo then
begin
bMoviendo := False;
TMovible( Sender ).MouseCapture := False;
end;
end;

Por ejemplo, si queremos mover una etiqueta por el formulario habría que asignar los eventos:

Label1.OnMouseDown := ControlMouseDown;
Label1.OnMouseUp := ControlMouseUp;
Label1.OnMouseMove := ControlMouseMove;

Con esto ya podemos crear nuestro propio editor de formularios sin tener que utilizar las propiedades DragKing y DragMode de los formularios que resultan algo engorrosas.

Pruebas realizadas en Delphi 7.

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.

06 julio 2007

Convertir un icono en imagen BMP

Aunque hay cientos de librerías de iconos por la red que suele utilizar todo el mundo para sus programas, lo ideal sería diseñar nuestros propios iconos utilizando como plantilla los que hay por Internet.

Se que hay decenas de programas de diseño que convierten entre distintos formatos, pero lo ideal sería tener nuestro propio conversor. Para ello tenemos el siguiente procedimiento que convierte un archivo ICO en una imagen BMP para que luego podamos utilizarla en nuestras aplicaciones:

procedure ConvertirImagen( sIcono, sBMP: String );
var
Bitmap: TBitmap;
Imagen: TImage;
begin
Imagen := TImage.Create( nil );
Imagen.Picture.LoadFromFile( sIcono );
Bitmap := TBitMap.Create;

with Bitmap do
begin
PixelFormat := pf24bit;
Height := Application.Icon.Height;
Width := Application.Icon.Width;
Canvas.Draw( 0, 0, Imagen.Picture.Graphic );
end;

Bitmap.SavetoFile( sBMP );

Imagen.Free;
end;

El primer parámetro es el icono y el segundo la imagen BMP resultante. Lo que hace el procedimiento es cargar el icono en un objeto TImage, para después copiar su contenido en un bitmap antes de guardarlo en un archivo.

Pruebas realizadas en Delphi 7.

05 julio 2007

Borrar archivos temporales de Internet

Uno de los componentes más útiles de Delphi hoy en día es WebBrowser el cual nos permite crear dentro de nuestros programas un navedador web utilizando el motor de Internet Explorer.

El único inconveniente es que al finalizar nuestro programa tenemos que ir a Internet Explorer y vaciar la caché, evitando que se llene el disco duro de basura.

Pues vamos a ver un procedimiento que elimina los archivos temporales de Internet Explorer, no sin antes añadir la unidad WinINet:

uses
Windows, Messages, ..., WinInet;

procedure BorrarCacheIE;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry( nil, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
GetMem( lpEntryInfo, dwEntrySize );

if dwEntrySize > 0 then
lpEntryInfo^.dwStructSize := dwEntrySize;

hCacheDir := FindFirstUrlCacheEntry( nil, lpEntryInfo^, dwEntrySize );

if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry( lpEntryInfo^.lpszSourceUrlName );
FreeMem( lpEntryInfo, dwEntrySize );
dwEntrySize := 0;
FindNextUrlCacheEntry( hCacheDir, TInternetCacheEntryInfo( nil^ ), dwEntrySize );
GetMem( lpEntryInfo, dwEntrySize );

if dwEntrySize > 0 then
lpEntryInfo^.dwStructSize := dwEntrySize;

until not FindNextUrlCacheEntry( hCacheDir, lpEntryInfo^, dwEntrySize );
end;

FreeMem( lpEntryInfo, dwEntrySize );
FindCloseUrlCache( hCacheDir );
end;

Este procedimiento habría que ejecutarlo al cerrar nuestro programa dejando el sistema limpio.

Pruebas realizadas en Delphi 7.

04 julio 2007

Deshabilitar el cortafuegos de Windows XP

Una de las tareas más frecuentes a las que se enfrenta un programador es la de crear aplicaciones que automaticen procesos de nuestra aplicación tales como subir datos por FTP, conectar con otro motor de bases de datos para enviar, etc.

Y si hay algún programa que pueda interrumpir el proceso de cara a las comunicaciones TCP/IP es el cortafuegos de Windows. Primero añadimos a uses:

uses
Windows, Messages, ..., WinSvc, ShellApi;

Este sería un el procedimiento que detiene el servicio:

procedure DeshabilitarCortafuegosXP;
var
SCM, hService: LongWord;
sStatus: TServiceStatus;
begin
SCM := OpenSCManager( nil, nil, SC_MANAGER_ALL_ACCESS );
hService := OpenService( SCM, PChar( 'SharedAccess' ), SERVICE_ALL_ACCESS );
ControlService( hService, SERVICE_CONTROL_STOP, sStatus );
CloseServiceHandle( hService );
end;

Para volver a activarlo sólo hay que ir al panel de control y ponerlo en marcha de nuevo. Esto no vale para otros cortafuegos (Panda, Norton, etc.)

Pruebas realizadas en Delphi 7.

03 julio 2007

Leer el número de serie de una unidad

Cuando se vende un programa generalmente se suele poner el precio según el número de equipos donde se va a instalar (licencia). Proteger nuestra aplicación contra copias implica leer algo característico en el PC que lo haga único.

Pues bien, cuando se formatea una unidad de disco Windows le asigna un número de serie que no cambiará hasta que vuelva a ser formateada. Lo que vamos a hacer es una función que toma como parámetro la unidad de disco que le pasemos (C:, D:, ...) y nos devolverá su número de serie:

function LeerSerieDisco( cUnidad: Char ): String;
var
dwLongitudMaxima, VolFlags, dwSerie: DWord;
begin
if GetVolumeInformation( PChar( cUnidad + ':\' ), nil, 0,
@dwSerie, dwLongitudMaxima, VolFlags, nil, 0) then
begin
// devolvemos el número de serie en hexadecimal
Result := IntToHex( dwSerie, 8 );
Insert( '-', Result, 5 );
end
else
Result := '';
end;

Nos devolverá algo como esto:

D4BD-0EC7

Con ese número ya podemos crear nuestro propio keygen alterando las letras, el orden o utilizando el algoritmo de encriptación que nos apetezca.

El único inconveniente es que si el usuario vuelve a formatear esa unidad entonces nos tiene que volver a pedir el número de serie. Hay otros programadores que prefieren leer el número de la BIOS o de la tarjeta de video, ya depende del nivel de protección que se desee.

Pruebas realizadas en Delphi 7.

02 julio 2007

Leer los archivos del portapapeles

El siguiente procedimiento lee el nombre de archivos o directorios del portapapales capturados por el usuario con CTRL + C ó CTRL + X y los muestra en un ListBox que le pasamos como parámetro:

procedure LeerArchivosPortapapeles( Lista: TListBox );
var
HPortapapeles: THandle; // Handle del portapapeles
iNumArc, i: Integer; // Nº de archivos
Archivo: array [0..MAX_PATH - 1] of char;
begin
if ClipBoard.HasFormat( CF_HDROP ) then
begin
HPortapapeles := ClipBoard.GetAsHandle( CF_HDROP );
iNumArc := DragQueryFile( HPortapapeles, $FFFFFFFF, nil, 0);

for i := 0 to iNumArc - 1 do
begin
DragQueryFile( HPortapapeles, i, @Archivo, MAX_PATH );
Lista.Items.Add( Archivo );
end;
end;
end;

Para poder compilarlo hay que añadir las unidades externas:

uses
Windows, Messages, ..., ClipBrd, ShellAPI;

Sólo mostrará archivos o directorios y no imágenes o cualquier otro archivo capturado dentro de un programa. Puede sernos de utilidad para realizar programas de copia de seguridad, conversiones de archivo, etc.

Pruebas realizadas en Delphi 7.

29 junio 2007

Listar los programas instalados en Windows

Windows almacena la lista de programas instalados (Agregar/Quitar programas) en la clave de registro:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\

En esa clave hay tantas subclaves como programas instalados. Pero lo que nos interesa a nosotros no es el nombre de la clave del programa instalado sino el nombre del programa que muestra Windows en Agregar/Quitar programas. Para ello entramos en cada clave y leemos el valor DisplayName.

Lo primero añadimos la unidad:

uses
Windows, Messages, ..., Registry;

Y aquí tenemos un procedimiento al cual le pasamos un ListBox y nos lo rellena con la lista de programas instalados en Windows:

procedure ListarAplicaciones( Lista: TListBox );
const
INSTALADOS = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';
var
Registro: TRegistry;
Lista1 : TStringList;
Lista2 : TStringList;
j, n : integer;
begin
Registro := TRegistry.Create;
Lista1 := TStringList.Create;
Lista2 := TStringList.Create;

// Guardamos todas las claves en la lista 1
with Registro do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( INSTALADOS, False );
GetKeyNames( Lista1 );
end;

// Recorremos la lista 1 y leemos el nombre del programa instalado
for j := 0 to Lista1.Count-1 do
begin
Registro.OpenKey( INSTALADOS + '\' + Lista1.Strings[j], False );
Registro.GetValueNames( Lista2 );

// Mostramos el programa instalado sólo si tiene DisplayName
n := Lista2.IndexOf( 'DisplayName' );
if ( n <> -1 ) and ( Lista2.IndexOf('UninstallString') <> -1 ) then
Lista.Items.Add( ( Registro.ReadString( Lista2.Strings[n] ) ) );
end;

Lista.Sorted := True; // Ordenamos la lista alfabéticamente
Lista1.Free;
Lista2.Free;
Registro.CloseKey;
Registro.Destroy;
end;

Con esto se podría hacer un programa que eliminara de Agregar/Quitar programas aquellas claves de programas mal desinstalados.

Pruebas realizadas en Delphi 7.

28 junio 2007

Ejecutar un programa y esperar a que termine

Uno de los problemas habituales con los que se enfrenta un programador es que su cliente le pida algo que o bien no sabe como programarlo o no dispone del componente o librería necesaria para llevar tu tarea a cabo.

Un ejemplo puede ser realizar una copia de seguridad en formatos ZIP, RAR, 7Z, etc., convertir de un formato de video o sonido a otro e incluso llamar a comandos del sistema para realizar procesos criticos en un servidor. Entonces sólo se nos ocurre llamar a un programa externo que realice la tarea por nosostros (y que soporte parámetros).

Sé lo que estáis pensando (la función WinExec), pero en este caso no me vale ya que el programa tiene que esperar a que termine de ejecutarse antes de pasar al siguiente proceso.

Aquí os muestro un procedimiento que ejecuta un programa y se queda esperando a que termine:

function EjecutarYEsperar( sPrograma: String; Visibilidad: Integer ): Integer;
var
sAplicacion: array[0..512] of char;
DirectorioActual: array[0..255] of char;
DirectorioTrabajo: String;
InformacionInicial: TStartupInfo;
InformacionProceso: TProcessInformation;
iResultado, iCodigoSalida: DWord;
begin
StrPCopy( sAplicacion, sPrograma );
GetDir( 0, DirectorioTrabajo );
StrPCopy( DirectorioActual, DirectorioTrabajo );
FillChar( InformacionInicial, Sizeof( InformacionInicial ), #0 );
InformacionInicial.cb := Sizeof( InformacionInicial );

InformacionInicial.dwFlags := STARTF_USESHOWWINDOW;
InformacionInicial.wShowWindow := Visibilidad;
CreateProcess( nil, sAplicacion, nil, nil, False,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil, nil, InformacionInicial, InformacionProceso );

// Espera hasta que termina la ejecución
repeat
iCodigoSalida := WaitForSingleObject( InformacionProceso.hProcess, 1000 );
Application.ProcessMessages;
until ( iCodigoSalida <> WAIT_TIMEOUT );

GetExitCodeProcess( InformacionProceso.hProcess, iResultado );
MessageBeep( 0 );
CloseHandle( InformacionProceso.hProcess );
Result := iResultado;
end;

El parámetro iVisibilidad puede ser:

SW_SHOWNORMAL -> Lo normal
SW_SHOWMINIMIZED -> Minimizado (ventanas MS-DOS o ventanas no modales)
SW_HIDE -> Oculto (ventanas MS-DOS o ventanas no modales)

La función devuelve un cero si la ejecución terminó correctamente.

Por ejemplo para ejecutar la calculadora de Windows y esperar a que termine:

procedure EjecutarCalculadora;
begin
if EjecutarYEsperar( 'C:\Windows\System32\Calc.exe', SW_SHOWNORMAL ) = 0 then
ShowMessage( 'Ejecución terminada con éxito.' )
else
ShowMessage( 'Ejecución no terminada correctamente.' );
end;

Pruebas realizadas en Delphi 7.

27 junio 2007

Obtener modos de video

A la hora de realizar un programa hay que tener muy presente la resolución de la pantalla y el área de trabajo donde se pueden colocar las ventanas.

Para ello tenemos el objeto TScreen que nos devuelve no sólo la resolución actual de video sino que además nos da el tamaño del escritorio y el área de trabajo del mismo (si esta fija la barra de tareas hay que respetar su espacio y procurar que nuestra ventana no se superponga a la misma).

Si utilizamos las propiedades Position o WindowsState del formulario no hay que preocuparse por esto, pero si hemos creado nuestra propia piel y pasamos de las ventanas normales de Windows hay que andarse con ojo y no dejar que el usuario se crea que ha desaparecido la barra de tareas.

El siguiente procedimiento vuelca la información de la pantalla actual en un objeto Memo llamado PANTALLA:

procedure TFInformacion.InfoPantalla;
begin
PANTALLA.Lines.Clear;
PANTALLA.Lines.Add( Format( 'Resolución: %dx%d ', [Screen.Width, Screen.Height] ) );
PANTALLA.Lines.Add( Format( 'Escritorio: x: %d y: %d Ancho: %d Alto: %d',
[Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight] ) );
PANTALLA.Lines.Add( Format( 'Area de trabajo: x: %d y: %d Ancho: %d Alto: %d',
[Screen.WorkAreaLeft, Screen.WorkAreaTop, Screen.WorkAreaWidth, Screen.WorkAreaHeight] ) );
end;

Otra información interesante sería saber que resoluciones posibles tiene nuestra tarjeta de video. Vamos a mostrar todos los modos de video posible en un ListBox llamado MODOS:

procedure TFInformacion.InfoModosVideo;
var i: Integer;
ModoVideo: TDevMode;
begin
i := 0;
MODOS.Clear;
while EnumDisplaySettings( nil, i, ModoVideo ) do
begin
with ModoVideo do
MODOS.Items.Add(Format( '%dx%d %d Colores', [dmPelsWidth, dmPelsHeight, Int64(1) shl dmBitsperPel] ) );

Inc( i );
end;
end;

Esta es la típica información que suelen mostrar los programas tipo TuneUp.

Pruebas realizadas en Delphi 7.

26 junio 2007

Formularios transparentes

Si estais hartos de que vuestros formularios tengan el mismo aspecto soso de siempre podeis crear nuevos temas y skins tales como los reproductores BSPlayer, WinDVD, PowerDVD, etc.

Para ello tenemos aquí un procedimiento que toma como parámetro un formulario y que hará que todo su fondo sea transparente. Si queremos que algo no sea transparente lo ponemos dentro de un bitmap, shape o panel.

procedure TransparentarFormulario( Form: TForm );
var
Region, RegionTemp: HRGN;
i: Integer;
Rect: TRect;
begin
Region := 0;

for i := 0 to Form.ControlCount - 1 do
begin
Rect := Form.Controls[i].BoundsRect;
OffsetRect( Rect, Form.ClientOrigin.x - Form.Left, Form.ClientOrigin.y - Form.Top );
RegionTemp := CreateRectRgnIndirect( Rect );

if Region = 0 then
Region := RegionTemp
else
begin
CombineRgn( Region, Region, RegionTemp, RGN_OR );
DeleteObject( RegionTemp );
end;
end;

RegionTemp := CreateRectRgn( 0, 0, Form.Width,
GetSystemMetrics( SM_CYCAPTION )+
GetSystemMetrics( SM_CYSIZEFRAME )+
GetSystemMetrics( SM_CYMENU ) * Ord( Form.Menu <> nil ) );

CombineRgn( Region, Region, RegionTemp, RGN_OR );
DeleteObject( RegionTemp );
SetWindowRgn( Form.Handle, Region, True );
end;

Quitando los margenes de la ventana con BorderStyle = bsNone ya tenemos un formulario completamente transparente donde sólo hay que insertarle los objetos que van a ser visibles.

Pruebas realizadas en Delphi 7.

25 junio 2007

Utilizar una fuente TTF sin instalarla

Uno de los primeros inconvenientes al distribuir nuestras aplicaciones es ver que en otros Windows aparecen nuestras etiquetas y campos desplazados debido a que la fuente que utilizan no es la que tenemos nosotros en nuestro equipo.

O bien utilizamos fuentes estandar tales como Tahoma, Arial, etc. o podemos utilizar el siguiente truco que consiste en añadir la fuente utilizada al lado de nuestro ejecutable y cargarla al arrancar nuestra aplicación.

El procedimiento para cargar una fuente es:

procedure CargarFuente( sFuente: String );
begin
AddFontResource( PChar( ExtractFilePath( Application.ExeName ) + sFuente ) );
SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
end;

Y en el procedimiento OnCreate de nuestro formulario cargamos la fuente:

procedure TFPrincipal.FormCreate( Sender: TObject );
begin
CargarFuente( 'Diner.ttf' );
Etiqueta.Font.Name := 'Diner';
end;

Donde se supone que el archivo Diner.ttf está al lado de nuestro ejecutable.

Antes de cerrar nuestra aplicación debemos liberar de memoria la fuente utilizada con el procedimiento:

procedure EliminarFuente( sFuente: String );
begin
RemoveFontResource( PChar( ExtractFilePath( Application.ExeName ) + sFuente ) );
SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
end;

Este prodecimiento sería llamado en el evento OnDestroy del formulario:

procedure TFPrincipal.FormDestroy( Sender: TObject );
begin
EliminarFuente( 'Diner.ttf' );
end;

Es recomendable hacer esto una sola vez en el formulario principal de la aplicación y no en cada formulario del programa, a menos que tengamos un formulario que utiliza exclusivamente una fuente en concreto.

Pruebas realizadas en Delphi 7.

Publicidad