Boletín Delphi #2
INDICE
1. UNAS PALABRAS DEL EDITOR
2. UN SIMPLE BUSCADOR DE FICHEROS
- TAnimate
- TStatusBar
- TListView
- TStringList
- TSearchRec, FindFirst, FindNext, FindClose
- Una función recursiva
- El ejemplo completo
3. EL REGISTRO DE WINDOWS
- ¿Qué es el Registro de Windows?
- TRegistry
- Ejemplo: Iniciando la aplicación asociada
4. ¿QUE SIGUE?
________________________________________________________________________
1. UNAS PALABRAS DEL EDITOR
Errores, errores, errores... No podemos deshacernos de ellos, ¿verdad?
Bien, en la primera edición cometimos algunos. En el primer ejemplo de
llamada a ShellExecute comparamos si el valor devuelto era menor que 32
("< 32") para mostrar un diálogo de error, cuando en su lugar
deberíamos haber chequeado si era menor O IGUAL a 32 ("<= 32"), tal
como habíamos explicado en la introducción al tema. Por lo menos no
tenemos que hacer que un telescopio orbital caiga a la Tierra... :)
En esta edición convertiremos la simple aplicación multi-hilos de la
edición pasada en una simple aplicación para buscar ficheros. Trabaja-
remos sobre esta aplicación en futuras ediciones agregando nuevas cosas
como búsqueda inteligente de palabras claves, menúes contextuales,
diálogos para abrir y guardar, búsqueda en varios caminos, búsqueda en
archivos comprimidos y mucho, mucho más...
También en esta edición, cubriremos lo básico del Registro de Windows e
intentaremos usarlo para acceder a la información sobre la aplicación
asociada para abrir un documento y esperar a que termine.
Nos han sugerido unir los newsletters de Kylix y Delphi en un más
frecuente y genérico Pascal Newsletter que también daría cobertura a
Free Pascal, Lazarus y otros proyectos. Creemos que esta propuesta
podría ser de interés para nuestros suscriptores así que la estamos
considerando y nos gustaría conocer sus opiniones al respecto.
Este newsletter está protegido por derechos de autor, pero por favor
reenvíenlo a sus amigos, conocidos y colegas que crean puedan estar
interesados en esta publicación, siempre y cuando lo hagan en forma
completa y sin modificaciones. Por favor recuerden que para mantener
este newsletter y seguir creciendo en contenido es necesario hacerlo
crecer en audiencia.
Sus contribuciones, comentarios, críticas y preguntas son bienvenidas.
¡Manténganse en contacto!
Atentamente,
Ernesto De Spirito
eds2008 @ latiumsoftware.com
________________________________________________________________________
JfControls Lib. Multilenguaje. Multiapariencia. Skins. Privilegios. Más
de 40 componentes integrados y personalizables. Múltiples problemas de
programación resueltos. Administración centralizada de recursos. Para
Delphi 3-6 y C++ Builder 3-5. http://www.jfactivesoft.com/spindex.htm
________________________________________________________________________
2. UN SIMPLE BUSCADOR DE FICHEROS
TAnimate
========
Probablemente hayan visto en el cuadro de diálogo Buscar de Windows que
cuando está buscando ficheros una lupa se mueve sobre una hoja de papel.
Para imitar este comportamiento, podemos usar un componente de la clase
TAnimate para ejecutar AVIs sin sonido en nuestros formularios.
Es tan fácil como poner uno de estos componentes en nuestro formulario,
establecer la propiedad FileName para referenciar un fichero AVI y luego
establecer la propiedad Active en True o False para iniciar o detener la
ejecución del fichero respectivamente. Por supuesto que hay más
propiedades y métodos para especificar el cuadro inicial y final, la
cantidad de veces que la animación se va a repetir antes de detenerse
automáticamente y muchas cosas más, pero por ahora, con que el AVI se
ejecute continuamente es suficiente para nuestro propósito.
Coloquen un componente TAnimate (Animate1) en el formulario que creamos
en la edición pasada. Ubiquen un fichero AVI en su disco duro y esta-
blezcan la propiedad FileName. En el procedimiento TForm1.Button1Click
inserten esta línea:
Animate1.Active := True;
Eso hará que comience la animación aproximadamente cuando se inicie el
hilo de ejecución. La animación se detendrá agregando esta línea al
procedimiento TForm1.Thread1Done:
Animate1.Active := False;
¡Eso es todo! Ahora pueden probar el ejemplo para verlo trabajar.
TStatusBar
==========
La barra de estado es aquella línea situada al pie de muchos formularios
que se usa para mostrar información como por ejemplo información
extendida sobre las herramientas, la acción que una aplicación está
desarrollando, el estado de las teclas Bloq Num y Bloq Mayús y muchas
otras cosas, dependiendo de la aplicación.
Coloquen un componente TStatusBar en su formulario. Se alineará en la
parte inferior del formulario. Normalmente una barra de estado se divide
en unos pocos paneles, pero en nuestro ejemplo usaremos uno solo. La
manera más fácil de hacerlo es estableciendo la propiedad SimplePanel
en True. Ahora, cuando queramos mostrar algo simplemente estableceremos
la propiedad SimpleText. En nuestro ejemplo (se muestra después) la
usaremos para mostrar el estado de la búsqueda (la cantidad de elementos
encontrados).
TListView
=========
Este es un control común en Windows de 32 bits. Los elementos (habitual-
mente ficheros) se pueden mostrar en varios estilos: iconos grandes,
iconos pequeños, lista y detalles, igual que en el Explorador de
Windows.
Coloquen un control TListView en la parte inferior de su formulario y
establezcan la propiedad ViewStyle en vsReport. Vayan al editor de
columnas y creen dos columnas: Nombre y Carpeta.
Para agregar un elemento a un ListView en tiempo de ejecución normal-
mente usamos el método Add de la propiedad Items del ListView. Add
agrega un nuevo elemento a la lista Items y devuelve una referencia a
él, que podemos almacenarla en una variable. Luego podemos establecer
las propiedades del elemento, siendo Caption la más importante. Para
establecer los valores de los "captions" de las otras columnas
agregamos líneas a la propiedad SubItems (un TStringList). Por ejemplo:
var
ListItem: TListItem; // Referencia al elemento recientemente
// añadido
begin
ListItem := ListView1.Items.Add(); // Nueva fila
ListItem.Caption := 'WIN.INI'; // Primera columna
ListItem.SubItems.Add('C:\WINDOWS\'); // Segunda columna
end;
TStringList
===========
Las listas de cadenas (string lists) son muy comunes en la programación
en Delphi. Muchos objetos tienen propiedades de tipo TStringList, así
que deberían familiarizarse con ellas. Además, son muy útiles para otros
propósitos. En nuestro caso, crearemos una lista de cadenas, le carga-
remos el contenido de un fichero y luego que la usemos, liberaremos el
objeto. Por ejemplo:
var
Content: TStringList; // Declara una lista de cadenas
begin
Content := TStringList.Create(); // Crea el objeto
...
Content.LoadFromFile('C:\WINDOWS\WIN.INI');
...
Content.Free; // Libera el objeto
end;
Usaremos un código como este en nuestro ejemplo. Después de cargar la
lista con el contenido de un fichero, podemos accederlo línea por línea
usando el arreglo de la propiedad Strings, o como un todo usando la
propiedad Text, que será la que usaremos.
TSearchRec, FindFirst, FindNext, FindClose
==========================================
Para buscar ficheros que concuerden con una cierta especificación de
nombre (como 'C:\WINDOWS\*.INI') usamos las funciones FindFirst y
FindNext y el procedimiento FindClose. Para que esto funcione, necesi-
tamos un registro TSearchRec que entre otras cosas contiene información
del fichero encontrado que coincide con el criterio de búsqueda. Se usa
un código como el siguiente:
var
SearchRec: TSearchRec;
begin
if FindFirst('C:\WINDOWS\*.INI', <atributos>, SearchRec)
= 0 then begin
repeat
// Aquí procesamos cada fichero encontrado.
// Sus datos están en SearchRec.
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
Si FindFirst devuelve 0 significa que al menos se encontró un fichero
coincidente con el criterio especificado. Luego usamos FindNext para
obtener la información de los siguientes ficheros que cumplen el
criterio de búsqueda uno por uno. FindNext también devuelve 0 si se
encuentra un fichero. Después que hayamos procesado todos los ficheros
debemos cerrar la búsqueda llamando a FindClose que libera algunos
recursos en SearchRec asignados por FindFirst.
Si <atributos> es 0, FindFirst y luego FindNext encontrarán sólo
ficheros normales, excluyendo los ficheros marcados con atributos de
Archivo, Sólo Lectura, Oculto, Sistema, Directorio o Volumen. Para
incluir estos ficheros en la búsqueda sumamos sus constantes correspon-
dientes: faArchive, faReadOnly, faHidden, faSysFile, faDirectory y
faVolumeID respectivamente.
Una función recursiva
=====================
La recursividad es frecuentemente una pesadilla para los programadores
principiantes, pero provee soluciones simples y elegantes a ciertos
problemas como el que tenemos entre manos. Nuestra intención es
encontrar ficheros en un directorio (carpeta) Y SUS SUBDIRECTORIOS (y
los subdirectorios de esos subdirectorios y así sucesivamente). De modo
que ¿cómo lo hacemos? Bueno, escribimos un procedimiento que reciba
como parámetro el camino del directorio donde iniciaremos la búsqueda
(asumimos que finaliza con una barra invertida: "\"):
procedure ScanFolder(const carpeta: string);
Realizamos la búsqueda de ficheros como mostramos arriba,
if FindFirst(carpeta + '*.INI',
faReadOnly Or faHidden Or faSysFile Or faArchive,
SearchRec) = 0 then begin
repeat
// Procesamos cada fichero
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
y luego realizamos una búsqueda de directorios (usando el atributo
faDirectory) para obtener los nombres de los subdirectorios que hay en
el directorio pasado como parámetro:
if FindFirst(carpeta + '*', faReadOnly Or faHidden
Or faSysFile Or faArchive Or faDirectory,
SearchRec) = 0 then begin
repeat
// Procesamos cada subdirectorio
// Su nombre está en SearchRec.Name
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Pero, ¿cómo buscamos ficheros en esos subdirectorios? Pues para ello
tenemos un procedimiento (¡el que estamos escribiendo!) que toma un
directorio como parámetro y busca ficheros en ese directorio, así que
lo llamaremos pasando el camino del directorio que queremos procesar (el
directorio actual unido al nombre del subdirectorio encontrado más una
barra invertida):
repeat
ScanFolder(carpeta + SearchRec.Name + '\');
until FindNext(SearchRec) <> 0;
¡Y eso es todo! Bueno, casi. Antes debemos garantizar que el fichero
encontrado sea un directorio verificando sus atributos y que su nombre
no sea '.' o '..' (directorio actual y directorio padre respectiva-
mente), así que el código sería:
repeat
if ((SearchRec.Attr and faDirectory) <> 0)
and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
ScanFolder(carpeta + SearchRec.Name + '\');
until FindNext(SearchRec) <> 0;
Y ahora sí hemos terminado.
El ejemplo completo
===================
Bien, ya es hora de poner todas las pieza juntas. Para empezar necesi-
tamos un formulario de 467x354 y los siguientes controles:
3 TEdit
3 TLabel
1 TCheckBox
2 TButton
1 TAnimate
1 TListView
1 TStatusBar
Establecemos sus propiedades en el Inspector de Objetos:
Label1
Left = 3
Top = 13
Width = 55
Height = 13
Alignment = taRightJustify
Caption = 'No&mbre:'
FocusControl = Edit1
Label2
Left = 5
Top = 42
Width = 53
Height = 13
Alignment = taRightJustify
Caption = 'Con el &texto:'
FocusControl = Edit2
Label3
Left = 18
Top = 72
Width = 41
Height = 13
Alignment = taRightJustify
Caption = 'Bu&scar en:'
FocusControl = Edit3
Button1
Left = 376
Top = 6
Width = 78
Height = 24
Anchors = [akTop, akRight]
Caption = '&Buscar'
Default = True
TabOrder = 0
OnClick = Button1Click
Button2
Left = 376
Top = 38
Width = 78
Height = 24
Anchors = [akTop, akRight]
Cancel = True
Caption = '&Detener'
Enabled = False
TabOrder = 1
OnClick = Button2Click
StatusBar1
Left = 0
Top = 308
Width = 459
Height = 19
Panels = <>
SimplePanel = True
Edit1
Left = 64
Top = 8
Width = 302
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
Text = '*.ini'
Edit2
Left = 64
Top = 37
Width = 302
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = ''
Edit3
Left = 65
Top = 67
Width = 301
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Text = 'C:\WINDOWS'
CheckBox1
Left = 65
Top = 97
Width = 111
Height = 13
Caption = '&Incluir subcarpetas'
TabOrder = 6
ListView1
Left = 0
Top = 120
Width = 459
Height = 188
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
Caption = 'Nombre'
Width = 150
end
item
Caption = 'Carpeta'
Width = 300
end>
TabOrder = 7
ViewStyle = vsReport
OnDblClick = ListView1DblClick
OnMouseDown = ListView1MouseDown
Animate1
Left = 393
Top = 66
Width = 48
Height = 50
Active = False
Anchors = [akTop, akRight]
FileName = 'FileSerch.avi'
Los OnXxxxx significan que hay que generar esos controladores de
eventos. El código completo está aquí:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ShellAPI;
const
WM_ThreadDoneMsg = WM_User + 8;
type
TForm1 = class;
TThread1 = class(TThread)
private
OwnerForm: TForm1;
Ubicacion: string;
NomArch: string;
Cantidad: cardinal;
procedure Inicializar;
procedure AgregarFichero;
procedure Finalizar;
protected
procedure Execute; override;
published
constructor Create(Owner: TForm1);
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
StatusBar1: TStatusBar;
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
CheckBox1: TCheckBox;
ListView1: TListView;
Animate1: TAnimate;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListView1DblClick(Sender: TObject);
procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
Ultima: TPoint;
Thread1: TThread1;
procedure Thread1Done(var AMessage: TMessage);
message WM_ThreadDoneMsg;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// ---------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
c: char;
begin
if Edit1.Text = '' then begin
MessageDlg('Ingrese el nombre', mtWarning, [mbOK], 0);
Edit1.SetFocus;
end else if Edit2.Text = '' then begin
MessageDlg('Ingrese el texto a buscar', mtWarning, [mbOK], 0);
Edit2.SetFocus;
end else if Edit3.Text = '' then begin
MessageDlg('Ingrese la carpeta', mtWarning, [mbOK], 0);
Edit3.SetFocus;
end else begin
c := Edit3.Text[Length(Edit3.Text)];
if (c <> '\') and (c <> ':') then
Edit3.Text := Edit3.Text + '\';
Button1.Enabled := False;
Edit1.Enabled := False;
Edit2.Enabled := False;
Edit3.Enabled := False;
Checkbox1.Enabled := False;
Button2.Enabled := True;
Thread1 := TThread1.Create(Self);
Animate1.Active := True;
end; // if
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Thread1.Terminate;
end;
procedure TForm1.Thread1Done(var AMessage: TMessage);
begin
Animate1.Active := False;
Button1.Enabled := True;
Edit1.Enabled := True;
Edit2.Enabled := True;
Edit3.Enabled := True;
Checkbox1.Enabled := True;
Button2.Enabled := False;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if Button2.Enabled then begin
Thread1.Terminate;
Thread1.WaitFor;
end; // if
Action := caFree;
end;
// ---------------------------------------------------------------
constructor TThread1.Create(Owner: TForm1);
begin
inherited Create(True);
OwnerForm := Owner;
Priority := tpHigher;
FreeOnTerminate := True;
Suspended := False;
end;
destructor TThread1.Destroy;
begin
PostMessage(OwnerForm.Handle,
WM_ThreadDoneMsg, Self.ThreadID, 0);
inherited destroy;
end;
procedure TThread1.Execute;
var
Content: TStringList;
Keywords: string;
procedure ScanFolder(const carpeta: string);
var
SearchRec: TSearchRec;
begin
if FindFirst(carpeta + OwnerForm.Edit1.Text,
faReadOnly Or faHidden Or faSysFile Or faArchive,
SearchRec) = 0 then begin
repeat
try
NomArch := SearchRec.Name;
Content.LoadFromFile(carpeta + NomArch);
if AnsiPos(Keywords, AnsiUpperCase(Content.Text))
<> 0 then begin
Inc(Cantidad);
Ubicacion := carpeta;
Synchronize(AgregarFichero);
end; // if
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end; // if
if (not Terminated) and OwnerForm.Checkbox1.Checked then begin
if FindFirst(carpeta + '*.*', faReadOnly Or faHidden
Or faSysFile Or faArchive Or faDirectory,
SearchRec) = 0 then begin
repeat
try
if ((SearchRec.Attr and faDirectory) <> 0)
and (SearchRec.Name <> '.')
and (SearchRec.Name <> '..') then
ScanFolder(carpeta + SearchRec.Name + '\');
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end; // if
end; // if
end;
begin // procedure TThread1.Execute;
Synchronize(Inicializar);
Cantidad := 0;
Content := TStringList.Create();
Keywords := AnsiUpperCase(OwnerForm.Edit2.Text);
ScanFolder(OwnerForm.Edit3.Text);
Content.Free;
Synchronize(Finalizar);
end;
procedure TThread1.Inicializar;
begin
OwnerForm.StatusBar1.SimpleText :=
'Buscando... (0 ficheros encontrados)';
OwnerForm.ListView1.Items.Clear;
end;
procedure TThread1.AgregarFichero;
var
ListItem: TListItem;
begin
OwnerForm.StatusBar1.SimpleText := 'Buscando... (' +
IntToStr(Cantidad) + ' ficheros encontrados)';
ListItem := OwnerForm.ListView1.Items.Add();
ListItem.Caption := NomArch;
ListItem.SubItems.Add(Ubicacion);
end;
procedure TThread1.Finalizar;
begin
if Terminated then
OwnerForm.StatusBar1.SimpleText := 'Búsqueda cancelada ('
+ IntToStr(Cantidad) + ' ficheros encontrados).'
else
OwnerForm.StatusBar1.SimpleText := 'Búsqueda finalizada ('
+ IntToStr(Cantidad) + ' ficheros encontrados).'
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
i, n, RelativeX, StartX: Integer;
ListItem: TListItem;
begin
ListItem := ListView1.GetItemAt(Ultima.X, Ultima.Y);
if ListItem <> nil then begin
if ShellExecute(Self.Handle, nil,
PChar(ListItem.SubItems.Strings[0] + ListItem.Caption),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then
Application.MessageBox('No se pudo ejecutar la aplicación',
'Error', MB_ICONEXCLAMATION);
end else begin
i := ListView1.TopItem.Index;
n := i + ListView1.VisibleRowCount - 1;
if ListView1.TopItem.Position.Y >= Ultima.Y then begin
while (i <= n) and (ListView1.Items[i+1].Position.Y
< Ultima.Y) do inc(i);
if (i <= n) then begin
ListItem := ListView1.Items[i];
RelativeX := Ultima.X - ListItem.Position.X - 2;
StartX := ListView1.Columns[0].Width;
if (RelativeX >= StartX) and (RelativeX <= StartX
+ ListView1.StringWidth(ListItem.SubItems[0])) then
if ShellExecute(Self.Handle, 'explore',
PChar(ListItem.SubItems.Strings[0]),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then
Application.MessageBox('No se pudo ejecutar la '
+ 'aplicación', 'Error', MB_ICONEXCLAMATION);
end; // if
end; // if
end; // if
end;
procedure TForm1.ListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Ultima.X := X;
Ultima.Y := Y;
end;
end.
Ahora hechemos un vistazo a algunas cosas...
Para comenzar, en las declaraciones de tipos la primera línea es
TForm1 = class;
Esto declara la clase como "forward", queriendo significar que la clase
será declarada en forma completa más adelante, pero esto permite
referenciarla antes de eso en las declaraciones de tipos. Lo hacemos de
esta forma porque TThread1 referencia TForm1 y viceversa, así que
deberíamos declarar TForm1 antes de TThread1 y viceversa, lo que es
imposible, así que Object Pascal nos provee esta solución.
Usaremos el hilo (thread) para buscar ficheros y a medida que los encon-
tremos los iremos agregando al ListView y actualizaremos la barra de
estado para mostrar la cantidad de ficheros encontrados. En vez de tener
una referencia a estos componentes, en esta oportunidad simplemente
tendremos una referencia al formulario dueño del hilo (en la propiedad
OwnerForm) que usaremos para acceder a los componentes que contiene y
sus propiedades. Esta vez usaremos tres métodos sincronizados:
Inicializar, AgregarFichero y Finalizar, así como tres variables para
comunicarnos con estos métodos: Ubicacion, NomArch y Cantidad. Sus
significados deberían ser obvios después de observar el código fuente.
Los eventos de ListView1 son un poco complicados. En el evento MouseDown
guardamos la posición donde el usuario hizo clic con el ratón para
usarla luego en el evento DblClick ya que este último no reporta la
posición donde el usuario hizo doble-clic con el ratón. Llamamos al
método GetItemAt del ListView para obtener un puntero al ListItem sobre
el cual el usuario hizo clic, de modo que podamos llamar la aplicación
asociada a ese fichero. El problema es que GetItemAt devuelve NIL si el
usuario no hizo clic en el nombre (Caption) o el icono del elemento, de
modo que si el usuario hizo clic en la carpeta (segunda columna), por
ejemplo, no tendríamos forma de saber... de saber directamente, pero
podemos usar un código complicado como el de arriba para determinar eso.
Si el usuario cliquea sobre el nombre de la carpeta entonces abrimos el
Explorador de Windows para explorar la carpeta, algo que el diálogo
Buscar de Windows no hace!
________________________________________________________________________
3. EL REGISTRO DE WINDOWS
¿Qué es el Registro de Windows?
===============================
Es el lugar donde Windows guarda muchas de sus opciones de configuración
y también permite que las aplicaciones accedan a estos datos así como
guardar sus propios datos.
Si desea hechar un vistazo al registro simplemente ejecute la aplicación
REGEDIT.EXE localizada en su directorio de Windows. Tenga cuidado de no
cambiar nada o podría terminar arruinado su instalación! Ahora bien, los
datos se guardan en el registro en forma de una estructura de árbol. Hay
varias raíces (varios árboles):
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_PERFORMANCE_DATA
HKEY_CURRENT_CONFIG
HKEY_DYN_DATA
Cada raíz contiene valores y claves. Los valores son datos guardados
bajo nombres de elementos (panel derecho de RegEdit). Las claves pueden
tener valores así como otras claves, formando una estructura de árbol
(panel izquierdo de RegEdit).
TRegistry
=========
La clase TRegistry está declarada en la unidad Registry, así que tendrá
que añadirla a la cláusula "uses" de la unidad o programa donde quiera
usarla. Para acceder a un dato en el registro primero debe crear un
objeto de esta clase (TRegistry), asignar la raíz donde se encuentra el
dato en la propiedad RootKey (los valores están definidos en la unidad
Windows) y luego intentar abrir la clave donde está ese dato con el
método OpenKey que devolverá True si tuvo éxito. Lugo puede leer (con
las funciones ReadXxxx) o escribir (con los procedimientos WriteXxxx)
los valores de la clave abierta y luego de eso, debe cerrar la clave con
el método CloseKey. Cuando haya terminado con el registro, debería
liberar el objeto creado.
Veamos un ejemplo de cómo obtener el nombre del procesador que posee
nuestro ordenador. Primero creamos una nueva aplicación, luego agregamos
"Registry" a la cláusula "uses", colocamos un botón en el formulario y
generamos su evento OnClick:
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\Hardware\Description\System'
+ '\CentralProcessor\0', False) then begin
ShowMessage(Reg.ReadString('Identifier'));
Reg.CloseKey;
end; // if
Reg.Free;
end;
Por supuesto, hay muchas otras cosas que se pueden hacer con el
registro, como crear y eliminar claves y valores, pero dejémoslo para
el futuro.
La clase TRegistryIniFile hace fácil a las aplicaciones escribir y leer
su información de configuración en y desde el registro, mientras que
TRegistry opera a un nivel más bajo.
Ejemplo: Iniciando la aplicación asociada
=========================================
Ahora pasemos a algo más complicado. Lo que debemos hacer es acceder al
registro para encontrar cuál es la aplicación asociada para un documento
dado y ejecutarla esperando a que finalice. En el newsletter pasado
vimos esa última parte, así que ahora nos concentraremos en cómo
localizar una asociación en el registro.
En el formulario del ejemplo anterior colocamos un cuadro de texto para
que el usuario ingrese el nombre del documento, añadimos "ShellAPI" a
la cláusula "uses" de la unidad y modificamos el código:
procedure ExecAndWait(Command: String); forward;
procedure TForm1.Button1Click(Sender: TObject);
var
ContentType, Command: String;
p: integer;
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_EXECUTE);
Reg.RootKey := HKEY_CLASSES_ROOT;
ContentType := '';
if Reg.OpenKeyReadOnly(ExtractFileExt(Edit1.Text)) then begin
ContentType := Reg.ReadString('');
Reg.CloseKey;
end; // if
if ContentType <> '' then begin
Command := '';
if Reg.OpenKeyReadOnly(ContentType + '\Shell\Open\Command')
then begin
Command := Reg.ReadString('');
Reg.CloseKey;
end;
Reg.Free;
if Command <> '' then begin
p := pos('%1', Command);
if p = 0 then
Command := Command + ' "' + Edit1.Text + '"'
else
Command := Copy(Command, 1, p-1) + Edit1.Text +
Copy(Command, p+2, Length(Command) - p - 1);
ExecAndWait(Command);
end; // if
end else begin
Reg.Free;
end; // if
end;
procedure ExecAndWait(Command: String);
var
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: longword;
begin
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
if CreateProcess(nil, PChar(Command), nil,
nil, false, CREATE_DEFAULT_ERROR_MODE
+ NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
proc_info) <> False then begin
GetExitCodeProcess(proc_info.hProcess, ExitCode); // Opcional
CloseHandle(proc_info.hProcess);
Application.MessageBox((PChar(Format(
'¡Aplicación terminada! (Código de retorno=%d)', [ExitCode])),
'Aviso', MB_ICONINFORMATION);
end else begin
Application.MessageBox('No se pudo iniciar la aplicación',
'Error', MB_ICONEXCLAMATION);
end; // if
end;
El parámetro KEY_EXECUTE pasado al constructor Create significa que el
registro se abrirán con derechos de acceso mínimos (solo lectura).
Empleamos OpenKeyReadOnly en lugar de OpenKey ya que es la forma
preferida de abrir una clave cuando no se tiene la intención de
escribir valores o hacerle ningún cambio. La cadena vacía ('') pasada
como parámetro a ReadString significa que deseamos obtener el dato del
valor predeterminado de la clave abierta.
Lo que hicimos primero fue obtener el "tipo" de archivo asociado con la
extensión del nombre del fichero ingresado en el cuadro de texto. Estos
"tipos" se encuentran bajo
HKEY_CLASSES_ROOT\.ext\(predeterminado)
donde ".ext" es la extensión de fichero que uno quiera (como ".txt",
".bmp", etc.). Luego obtuvimos la línea de comandos usada para abrir ese
tipo de ficheros. Para hacerlo, obtuvimos el valor bajo
HKEY_CLASSES_ROOT\tipo\Shell\Open\Command\(predeterminado)
donde "tipo" es el tipo de fichero al que está asociado una extensión
(que era lo que habíamos obtenido antes). Esa cadena usualmente tiene la
forma
"D:\PATH\APPNAME.EXT" "%1" -OPTIONS
donde '%1' es el indicador de posición del documento a abrir con la
aplicación, así que buscamos su posición dentro de la cadena y lo
sustituimos por el nombre del fichero ingresado en el cuadro de texto
para obtener la línea de comandos que necesitamos para abrir la
aplicación, y entonces llamamos al procedimiento ExecAndWait para hacer
eso. Este procedimiento usa casi el mismo código que usamos en el número
pasado para ejecutar una aplicación y esperar a que ésta termine.
Debemos advertirles que hemos experimentado problemas con
WaitForSingleObject en combinación con ciertas aplicaciones y hemos
tenido que finalizarlas con el Administrador de Tareas. Otras
aplicaciones no se cierran bien y WaitForSingleObject nunca vuelve. No
parece haber una solución fácil a este problema pero aquí intentaremos
ensayar una. Primero agregamos un TTimer y otro TButton al formulario.
Establecemos la propiedad Enabled de ambos a False y establecemos el
intervalo (Interval) del temporizador (Timer1) en 200. Luego agregamos
unas pocas declaraciones en la sección privada del formulario:
type
TForm1 = class(TForm)
...
private
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: LongWord;
procedure ExecAndWait(Command: String);
...
Ahora eliminamos la declaración "forward" que teníamos y modificamos
ExecAndWait:
procedure TForm1.ExecAndWait(Command: String);
begin
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
if CreateProcess(nil, PChar(Command), nil,
nil, false, CREATE_DEFAULT_ERROR_MODE
+ NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
proc_info) then begin
Button1.Enabled := False;
Button2.Enabled := True;
Timer1.Enabled := True;
end else begin
CloseHandle(proc_info.hProcess);
Application.MessageBox('No se pudo iniciar la aplicación',
'Error', MB_ICONEXCLAMATION);
end; // if
end;
Generamos el evento OnTimer del temporizador Timer1:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if GetExitCodeProcess(proc_info.hProcess, ExitCode) then
if ExitCode = STILL_ACTIVE then
Timer1.Enabled := True
else begin
Button2.Enabled := False;
Button1.Enabled := True;
CloseHandle(proc_info.hProcess);
end
else begin
Button2.Enabled := False;
Button1.Enabled := True;
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
end;
end;
Generamos el evento OnClick del botón Button2:
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := False;
if Application.MessageBox('Debería finalizar la ' +
'aplicación normalmente.'#13#13'¿Finalizarla igual?',
'Warning', MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION +
MB_TASKMODAL) = ID_YES then begin
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
Button2.Enabled := False;
Button1.Enabled := True;
end else begin
Timer1.Enabled := True;
end;
end;
Generamos el evento OncloseQuery del formulario:
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if Button2.Enabled then begin
Button2Click(Button2);
if Button2.Enabled then CanClose := False;
end;
end;
El propósito de todo este código es verificar el estado de la aplicación
iniciada (llamando GetExitCodeProcess) a intervalos (en el evento
Timer). Si el proceso ha terminado, lo cerramos. La implementación que
elegimos permite que el proceso sea terminado desde nuestra aplicación
llamando a TerminateProcess después de haberle preguntado al usuario
(no se recomienda el uso de TerminateProcess y debería ser el último
recurso para terminar una aplicación).
________________________________________________________________________
4. ¿QUE SIGUE?
Con la aprobación de nuestros suscriptores, esta podría ser la última
edición del Delphi Newsletter, ya que en el futuro se convertiría en el
Pascal Newsletter. En un par de semanas esperamos tener nuestro sitio
listo. Será demasiado amateur quizás, pero allí encontraran listas de
correo, artículos, ejemplos, código fuente, componentes, aplicaciones y
otros recursos. Creemos que todo eso hará que este newsletter sea más
dinámico, permitiendo así responder mejor a sus necesidades de progra-
mación.
¡Nos vemos!
________________________________________________________________________
Si no has recibido el archivo con el código fuente completo de los
ejemplos que se presentan en este boletín, puedes descargarlo de la
siguiente dirección: http://www.latiumsoftware.com/es/file.php?id=d02
________________________________________________________________________
Página principal: http://www.latiumsoftware.com/es/pascal/index.php
Página del grupo: http://espanol.groups.yahoo.com/group/boletin-pascal/
Para suscribirse / apuntarse: boletin-pascal-subscribe@gruposyahoo.com
Para cancelar / removerse: boletin-pascal-unsubscribe@gruposyahoo.com
Para reportar problemas con la suscripción: eds2008 @ latiumsoftware.com
________________________________________________________________________
Este boletín se provee "TAL Y COMO ESTA", sin garantía de ninguna clase.
Su uso implica la aceptación de nuestros términos de licencia y de la
ausencia de garantía que puedes leer en nuestro sitio web. Allí también
encontrarás una nota sobre marcas registradas. Te animamos a que redis-
tribuyas este boletín, siempre y cuando lo hagas en forma completa
(incluyendo la información de copyright), sin modificaciones y de manera
gratuita. Los artículos son copyright de sus respectivos autores y se
reproducen aquí con el permiso de los mismos.
________________________________________________________________________
Latium Software http://www.latiumsoftware.com/es/index.php
Copyright (c) 2000 por Ernesto De Spirito. Todos los derechos reservados
________________________________________________________________________
|
