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.

Copyright © por AjpdSoft Derechos Reservados.

Publicado el: 2003-12-11 (943 Lecturas)