22 junio 2007

Obtener los favoritos de Internet Explorer

El siguiente procedimiento recursivo obtiene la lista de los enlaces favoritos de Internet Explorer. Puede ser de mucha utilidad en el caso de formatear el equipo y salvar la lista de favoritos a un archivo de texto o a una base de datos.

Lo primero es añadir en uses:

uses
Windows, Dialogs, ..., ShlObj;

Y este sería el procedimiento:

function ObtenerFavoritosIE( sRutaFavoritos: String ): TStrings;
var
Busqueda: TSearchrec;
ListaFavoritos: TStrings;
sRuta, sDirectorio, sArchivo: String;
Buffer: array[0..2047] of Char;
iEncontrado: Integer;
begin
ListaFavoritos := TStringList.Create;
try
sRuta := sRutaFavoritos + '\*.url';
sDirectorio := ExtractFilepath( sRuta );
iEncontrado := FindFirst( sRuta, faAnyFile, Busqueda );

while iEncontrado = 0 do
begin
SetString( sArchivo, Buffer,
GetPrivateProfileString( 'InternetShortcut',
PChar( 'URL' ), nil, Buffer, SizeOf( Buffer ),
PChar( sDirectorio + Busqueda.Name ) ) );
ListaFavoritos.Add( sArchivo );
iEncontrado := FindNext( Busqueda );
end;

iEncontrado := FindFirst( sDirectorio + '\*.*', faAnyFile, Busqueda );

while iEncontrado = 0 do
begin
if ( ( Busqueda.Attr and faDirectory ) > 0 ) and ( Busqueda.Name[1] <> '.' ) then
ListaFavoritos.AddStrings( ObtenerFavoritosIE( sDirectorio + '\' + Busqueda.name ) );

iEncontrado := FindNext( Busqueda );
end;

FindClose( Busqueda );
finally
Result := ListaFavoritos;
end;
end;

Para utilizar el procedimiento supongamos que en el formulario tenemos un componente ListBox (FAVORITOS) y un botón (BFavoritos) que al pulsarlo nos trae todos los favoritos a dicha lista:

procedure TFPrincipal.BFavoritosClick( Sender: TObject );
var
pidl: PItemIDList;
sRutaFavoritos: array[0..MAX_PATH] of Char;
begin
SHGetSpecialFolderLocation( Handle, CSIDL_FAVORITES, pidl );
SHGetPathFromIDList( pidl, sRutaFavoritos );
FAVORITOS.Items := ObtenerFavoritosIE( StrPas( sRutaFavoritos ) );
end;

Pruebas realizadas en Delphi 7.

21 junio 2007

Crear un acceso directo

Aquí tenemos un pequeño pero interesante procedimiento para crear accesos directos en Windows. Antes de implementarlo hay que añadir en uses una serie de unidades externas:

uses
Windows, Dialogs, ..., ShlObj, ActiveX, StdCtrls, Registry, ComObj;

Este sería el procedimiento:

procedure CrearAccesoDirecto( sExe, sArgumentos, sDirTrabajo, sNombreLnk, sDirDestino: string );
var
Objeto: IUnknown;
UnSlink: IShellLink;
FicheroP: IPersistFile;
WFichero: WideString;
begin
Objeto := CreateComObject( CLSID_ShellLink );
UnSlink := Objeto as IShellLink;
FicheroP := Objeto as IPersistFile;

with UnSlink do
begin
SetArguments( PChar( sArgumentos ) );
SetPath( PChar( sExe ) );
SetWorkingDirectory( PChar( sDirTrabajo ) );
end;

WFichero := sDirDestino + '\' + sNombreLnk;
FicheroP.Save( PWChar( WFichero ), False );
end;

Y estos son sus parámetros:

sExe -> Ruta que apunta al ejecutable o archivo a crear el acceso directo
sArgumentos -> Parámetros que le mandamos al EXE
sDirTrabajo -> Ruta al directorio de trabajo del ejecutable
sNombreLnk -> Nombre del acceso directo
sDirDestino -> Ruta destino donde se creará el acceso directo

Aquí os muestro un ejemplo de cómo crear un acceso directo de la calculadora de Windows al escritorio:

procedure CrearAccesoCalculadora;
var
sEscritorio: String;
Registro: TRegistry;
begin
Registro := TRegistry.Create;

// Leemos la ruta del escritorio
try
Registro.RootKey := HKEY_CURRENT_USER;

if Registro.OpenKey( '\Software\Microsoft\Windows\CurrentVersion\explorer\Shell Folders', True ) then
sEscritorio := Registro.ReadString( 'Desktop' );
finally
Registro.CloseKey;
Registro.Free;
inherited;
end;

CrearAccesoDirecto( 'C:\Windows\System32\calc.exe', '',
'C:\Windows\System32\', 'Calculadora.lnk', sEscritorio );
end;

Pruebas realizadas en Delphi 7.

20 junio 2007

Averiguar la versión de Windows

La siguiente función nos devuelve la versión de Windows donde se está ejecutando nuestro programa:

function ObtenerVersion: String;
var
osVerInfo: TOSVersionInfo;
VersionMayor, VersionMenor: Integer;
begin
Result := 'Desconocida';
osVerInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );

if GetVersionEx( osVerInfo ) then
begin
VersionMenor := osVerInfo.dwMinorVersion;
VersionMayor := osVerInfo.dwMajorVersion;

case osVerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if VersionMayor <= 4 then
Result := 'Windows NT'
else
if ( VersionMayor = 5 ) and ( VersionMenor = 0 ) then
Result := 'Windows 2000'
else
if ( VersionMayor = 5 ) and ( VersionMenor = 1 ) then
Result := 'Windows XP'
else
if ( VersionMayor = 6 ) then
Result := 'Windows Vista';
end;

VER_PLATFORM_WIN32_WINDOWS:
begin
if ( VersionMayor = 4 ) and ( VersionMenor = 0 ) then
Result := 'Windows 95'
else
if ( VersionMayor = 4 ) and ( VersionMenor = 10 ) then
begin
if osVerInfo.szCSDVersion[1] = 'A' then
Result := 'Windows 98 Second Edition'
else
Result := 'Windows 98';
end
else
if ( VersionMayor = 4 ) and ( VersionMenor = 90 ) then
Result := 'Windows Millenium'
else
Result := 'Desconocida';
end;
end;
end;
end;

Primero averigua de que plataforma se trata. Si es Win32 los sistemas operativos pueden ser: Windows 95, Windows 98, Windows 98 Second Edition y Windows Millenium. Por otro lado, si se trata de la plataforma NT entonces las versiones son: Windows NT, Windows 2000, Windows XP y Windows Vista.

Esta función puede ser de utilidad para saber que librerias DLL tiene instaladas, que comandos del sistema podemos ejecutar o para saber si tenemos que habilitar o deshabilitar ciertas funciones de nuestra aplicación.

Pruebas realizadas en Delphi 7.

19 junio 2007

Recorrer un árbol de directorios

El procedimiento que voy a mostrar a continuación recorre el contenido de directorios, subdirectorios y archivos volcando la información en un campo memo (TMemo).

Modificando su comportamiento puede ser utilizado para realizar copias de seguridad, calcular el tamaño de un directorio o borrar el contenido de los mismos.

El procedimiento RecorrerDirectorio toma como primer parámetro la ruta que desea recorrer y como segundo parámetro si deseamos que busque también en subdirectorios:

procedure TFBuscar.RecorrerDirectorio( sRuta: String; bIncluirSubdirectorios: Boolean );
var
Directorio: TSearchRec;
iResultado: Integer;
begin
// Si la ruta no termina en contrabarra se la ponemos
if sRuta[Length(sRuta)] <> '\' then
sRuta := sRuta + '\';

// ¿No existe el directorio que vamos a recorrer?
if not DirectoryExists( sRuta ) then
begin
Application.MessageBox( PChar( 'No existe el directorio:' + #13 + #13 + sRuta ), 'Error', MB_ICONSTOP );
Exit;
end;

iResultado := FindFirst( sRuta + '*.*', FaAnyfile, Directorio );
while iResultado = 0 do
begin
// ¿Es un directorio y hay que entrar en él?
if ( Directorio.Attr and faDirectory = faDirectory ) and bIncluirSubdirectorios then
begin
if ( Directorio.Name <> '.' ) and ( Directorio.Name <> '..' ) then
RecorrerDirectorio( sRuta + Directorio.Name, True );
end
else
// ¿No es el nombre de una unidad ni un directorio?
if ( Directorio.Attr and faVolumeId <> faVolumeID ) then
Archivos.Lines.Add( sRuta + Directorio.Name );

iResultado := FindNext( Directorio );
end;

SysUtils.FindClose( Directorio );
end;

Antes de comenzar a buscar directorios se asegura de que la ruta que le pasemos termine en contrabarra y en el caso de que no sea así se la pone al final.

Para recorrer un directorio utiliza la estructura de datos TSearchRec la cual se utiliza para depositar en ella la información del contenido de un directorio mediante las funciones FindFirst y FindNext.

TSearchRec no contiene la información de todo el directorio sino que es un puntero al directorio o archivo actual. Sólo mirando los atributos mediante la propiedad Attr podemos saber si lo que estamos leyendo es un directorio, archivo o unidad.

También se cuida de saltarse los directorios '.' y '..' ya que sino el procedimiento recursivo RecorrerDirectorio se volvería loco hasta reventar la pila.

Realizar modificaciones para cambiar su comportamiento puede ser peligroso si no lleváis cuidado ya que la recursividad puede de dejar sin memoria la aplicación. Al realizar tareas como borrar subdirectorios mucho cuidado no darle la ruta C:\. Mejor hacer ensayos volcando el contenido en un Memo hasta tener el resultado deseado.

Pruebas realizadas en Delphi 7.

18 junio 2007

Ejecutar un programa al arrancar Windows

Para ejecutar automáticamente nuestra aplicación al arrancar Windows vamos a utilizar la siguiente clave del registro del sistema:

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\

Todos los programas que se introduzcan dentro de esa clave (antivirus, monitores del sistema, etc.) arrancarán al iniciar Windows.

Para ello vamos a utilizar el objeto TRegistry. Para ello hay que añadir su unidad correspondiente en uses:

uses Windows, Messages, ..., Registry;

Ahora vamos con el procedimiento encargado de poner nuestro programa
al inicio de Windows:

procedure TFPrincipal.PonerProgramaInicio;
var Registro: TRegistry;
begin
Registro := TRegistry.Create;
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( 'Software\Microsoft\Windows\CurrentVersion\Run', FALSE ) then
begin
Registro.WriteString( ExtractFileName( Application.ExeName ), Application.ExeName );
Registro.CloseKey;
end;

Registro.Free;
end;

El método WriteString toma como primer parámetro la el nombre del valor en el registro y como segúndo parámetro la ruta donde se encuentra el programa a ejecutar. En nuestro caso como nombre del valor le he dado el nombre de nuestro ejecutable y como segundo la ruta desde donde estamos ejecutando el programa en este mismo instante.

Si en un futuro deseamos quitar el programa entonces sólo hay que eliminar la clave:

procedure TFPrincipal.QuitarProgramaInicio;
var Registro: TRegistry;
begin
Registro := TRegistry.Create;
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( 'Software\Microsoft\Windows\CurrentVersion\Run', FALSE ) then
begin
// ¿Existe el valor que vamos a borrar?
if Registro.ValueExists( ExtractFileName( Application.ExeName ) ) then
Registro.DeleteValue( ExtractFileName( Application.ExeName ) );

Registro.CloseKey;
end;

Registro.Free;
end;

Hay ciertos antivirus como el NOD32 que saltan nada más compilar nuestro programa por el simple hecho de tocar la clave Run. Habrá que decirle a nuestro antivirus que nuestro programa no es maligno.

Pruebas realizadas en Delphi 7.

Publicidad