Delphi TWebBrowser[3] IE收藏夾操作
阿新 • • 發佈:2020-11-19
Delphi TWebBrowser[3] IE收藏夾操作
1、新增到收藏夾
const CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; procedure AddFavorite(Webbrowser:TWebBrowser); var ShellUIHelper: ISHellUIHelper; url, title: Olevariant; begin Title := Webbrowser.LocationName; Url := Webbrowser.LocationUrl; if Url <> '' then begin ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper; ShellUIHelper.AddFavorite(url, title); end; end;
2、整理收藏夾
procedure OrganizeFavorite(); var H: HWnd; p:procedure(Handle: THandle; Path: PChar); stdcall; begin H := LoadLibrary(PChar('shdocvw.dll')); if H <> 0 then begin p := GetProcAddress(H, PChar('DoOrganizeFavDlg')); if Assigned(p) then p(Application.Handle, PChar('')); end; FreeLibrary(h); end;
3、顯示收藏夾列表
uses ShlObj, ActiveX; function GetIEFavourites(const favpath: string): TStrings; {獲取IE收藏夾} 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.BitBtn1Click(Sender: TObject);
var
pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of Char;
begin
ListBox1.Visible:=not ListBox1.Visible;
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;
4、獲取收藏夾目錄
//取特殊資料夾目錄
function GetSpecialFolderDir(const folderid: integer): string;
var
pidl : pItemIDList;
buffer : array[0..255] of char;
begin
SHGetSpecialFolderLocation(Application.Handle, folderid, pidl);
SHGetPathFromIDList(pidl, buffer); //轉換成檔案系統的路徑
result := strpas(buffer);
end;
//取收藏夾目錄
function GetFavPath: string;
begin
result := GetSpecialFolderDir(CSIDL_FAVORITES);
end;
或者:
var
buffer:array[0..255] of char;
begin
SHGetSpecialFolderPath(Application.Handle,buffer,CSIDL_FAVORITES,True);
ShowMessage(buffer);
end;
建立時間:2020.11.19 更新時間: