Mega Code Archive

 
Categories / Delphi / LAN Web TCP
 

How to get the Internet Explorers favourites

Title: How to get the Internet Explorers favourites 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;