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.

No hay comentarios:

Publicidad