Lenguaje de programación Borland Delphi
Abajo mostramos el código fuente para obtener la lista de todas las páginas web que tenemos en la carpeta Favoritos de Internet Explorer. Para ello necesitaremos un formulario, un botón y un ListBox:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComObj, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ShlObj, ActiveX;
function GetIEFavourites(const favpath: string): TStrings;
var
searchrec: TSearchRec;
str: TStrings;
path, dir, FileName: string;
Buffer: array[0..2047] of Char;
found: Integer;
begin
str := TStringList.Create;
// Get all file names in the favourites path
path := FavPath + '\*.url';
dir := ExtractFilepath(path);
found := FindFirst(path, faAnyFile, searchrec);
while found = 0 do
begin
// Get now URLs from files in variable files
Setstring(FileName, Buffer, GetPrivateProfilestring('InternetShortcut',
PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name)));
str.Add(FileName);
found := FindNext(searchrec);
end;
// find Subfolders
found := FindFirst(dir + '\*.*', faAnyFile, searchrec);
while found = 0 do
begin
if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then
str.Addstrings(GetIEFavourites(dir + '\' + searchrec.Name));
found := FindNext(searchrec);
end;
FindClose(searchrec);
Result := str;
end;
procedure FreePidl(pidl: PItemIDList);
var
allocator: IMalloc;
begin
if Succeeded(SHGetMalloc(allocator)) then
begin
allocator.Free(pidl);
{$IFDEF VER100}
allocator.Release;
{$ENDIF}
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of Char;
begin
if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl)) then
begin
if ShGetPathfromIDList(pidl, FavPath) then
ListBox1.Items := GetIEFavourites(StrPas(FavPath));
// The calling application is responsible for freeing the PItemIDList-pointer
// with the Shell's IMalloc interface
FreePIDL(pidl);
end;
end;
end.
Publicado el: 2003-12-11