Dll 文件：shdocvw.dllprocedure DoOrganizeFavDlg(h:hwnd;path:pchar);stdcall;external 'shdocvw.dll';第二个参数指定收藏夹的位置，如果第二个参数为Nil的话，默认IE得收藏夹位置。AddUrlToFavoritesDoAddToFavDlgDoAddToFavDlgWDoFileDownloadDoFileDownloadExDoOrganizeFavDlgWSHAddSubscribeFavoriteSetShellOfflineStateSoftwareUpdateMessageBox//添加到收藏夹constCLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';varShellUIHelper: ISHellUIHelper;url, title: Olevariant;beginurl:='www.csdn.net'title:='中国软件'ShellUIHelper :=CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;ShellUIHelper.AddFavorite(url, title);end;//整理收藏varH: HWnd;p: procedure(Handle: THandle; Path: PChar); stdcall;beginH := LoadLibrary(PChar('shdocvw.dll'));if H <> 0 thenbeginp := GetProcAddress(H, PChar('DoOrganizeFavDlg'));if Assigned(p) then p(Application.Handle, PChar(favpath));end;FreeLibrary(h);end;---------导出收藏夹在VB中选择菜单的Project | References 选项，在References对话框中选择Microsoft Internet Controls项，然后在程序中加入以下语句：Dim dc As New SHDocVw.ShellUIHelperdc.ImportExportFavorites False, "c:.html"Set dc = Nothing就可以将收藏夹导出到 c:.htm 中了，如果要从文件导入到收藏夹，只要将上面的False改为True，将"c:.html"改为要导入的文件名就可以了。 ---------------------------------------添加到收藏夹和整理收藏夹 const CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; var p:procedure(Handle: THandle; Path: PChar); stdcall; procedure TForm1.OrganizeFavorite(Sender: Tobject); var H: HWnd; begin H := LoadLibrary(PChar('shdocvw.dll')); if H <> 0 then begin p := GetProcAddress(H, PChar('DoOrganizeFavDlg')); if Assigned(p) then p(Application.Handle, PChar(FavFolder)); end; FreeLibrary(h); end; procedure TForm1.AddFavorite(Sender: TObject); var ShellUIHelper: ISHellUIHelper; url, title: Olevariant; begin Title := Webbrowser1.LocationName; Url := Webbrowser1.LocationUrl; if Url <> '' then begin ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper; ShellUIHelper.AddFavorite(url, title); end; end; 用上面的通过ISHellUIHelper接口来打开“添加到收藏夹”对话框的方法比较简单，但是有个缺陷，就是打开的窗口不是模式窗口，而是独立于应用程序的。可以想象，如果使用与OrganizeFavorite过程同样的方法来打开对话框，由于可以指定父窗口的句柄，自然可以实现模式窗口（效果与在资源管理器和IE中打开“添加到收藏夹”对话框相同）。问题显然是这样的，上面两个过程的作者当时只知道shdocvw.dll中DoOrganizeFavDlg的原型而不知道DoAddToFavDlg的原型，所以只好用ISHellUIHelper接口来实现（或许是他不够严谨，认为是否是模式窗口无所谓？）。 下面的过程就告诉你DoAddToFavDlg的函数原型。需要注意的是，这样打开的对话框并不执行“添加到收藏夹”的操作，它只是告诉应用程序用户是否选择了“确定”，同时在DoAddToFavDlg的第二个参数中返回用户希望放置Internet快捷方式的路径，建立.Url文件的工作由应用程序自己来完成。 procedure TForm1.AddFavorite(IE: TEmbeddedWB); procedure CreateUrl(AUrlPath, AUrl: PChar); var URLfile: TIniFile; begin URLfile := TIniFile.Create(String(AUrlPath)); RLfile.WriteString('InternetShortcut', 'URL', String(AUrl)); RLfile.Free; end; var AddFav: function(Handle: THandle; UrlPath: PChar; UrlPathSize: Cardinal; Title: PChar; TitleSize: Cardinal; FavIDLIST: pItemIDList): Bool; stdcall; FDoc: IHTMLDocument2; UrlPath, url, title: array[0..MAX_PATH] of char; H: HWnd; pidl: pItemIDList; FRetOK: Bool; begin FDoc := IHTMLDocument2(IE.Document); if FDoc = nil then exit; StrPCopy(Title, FDoc.Get_title); StrPCopy(url, FDoc.Get_url); if Url <> '' then begin H := LoadLibrary(PChar('shdocvw.dll')); if H <> 0 then begin SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl); AddFav := GetProcAddress(H, PChar('DoAddToFavDlg')); if Assigned(AddFav) then FRetOK :=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title), pidl) end; FreeLibrary(h); if FRetOK then CreateUrl(UrlPath, Url); end end;
读取IE收藏夹内网址的信息 procedure TForm1.ToolButton1Click(Sender: TObject);label Write;var Favorites:String; Search:TSearchRec;begin Favorites:=GetFavoritesPath; if Favorites='' then begin MessageBox(Handle,'访问收藏夹主键错误！','提示信息',MB_OK); exit; end; Memo1.Clear; with Search,Memo1.Lines do begin if FindFirst(Favorites+'*.url',0,Search)=0 then begin Write: Add(GetFavoritesUrl(Favorites+Name)); SetLength(Name,Length(Name)-4); Add(Name); if FindNext(Search)=0 then goto Write; end; end;end; function TForm1.GetFavoritesPath:String;var reg:TRegistry;begin Result:=''; reg:=TRegistry.Create; with reg do begin RootKey:=HKEY_USERS; if OpenKey('.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders',false)=true then Result:=ReadString('Favorites')+'\'; CloseKey; Free; end;end; {function TForm1.GetFavoritesUrl(FavoritesFile: String): String;begin with TIniFile.Create(FavoritesFile)do begin Result:=ReadString('InternetShortcut','URL',''); Free; end;end;} function TForm1.GetFavoritesUrl(FavoritesFile: String): String;var i:integer;begin Result:=''; with TStringList.Create do begin LoadFromFile(FavoritesFile); i:=IndexOf('[InternetShortcut]'); if i=-1 then exit; Result:=Strings[i+1]; System.Delete(Result,1,4); Free; end;end;
Dll 文件：shdocvw.dllprocedure DoOrganizeFavDlg(h:hwnd;path:pchar);stdcall;external 'shdocvw.dll';第二个参数指定收藏夹的位置，如果第二个参数为Nil的话，默认IE得收藏夹位置。AddUrlToFavoritesDoAddToFavDlgDoAddToFavDlgWDoFileDownloadDoFileDownloadExDoOrganizeFavDlgWSHAddSubscribeFavoriteSetShellOfflineStateSoftwareUpdateMessageBox//添加到收藏夹constCLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';varShellUIHelper: ISHellUIHelper;url, title: Olevariant;beginurl:='www.csdn.net'title:='中国软件'ShellUIHelper :=CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;ShellUIHelper.AddFavorite(url, title);end;//整理收藏varH: HWnd;p: procedure(Handle: THandle; Path: PChar); stdcall;beginH := LoadLibrary(PChar('shdocvw.dll'));if H <> 0 thenbeginp := GetProcAddress(H, PChar('DoOrganizeFavDlg'));if Assigned(p) then p(Application.Handle, PChar(favpath));end;FreeLibrary(h);end;---------导出收藏夹在VB中选择菜单的Project | References 选项，在References对话框中选择Microsoft Internet Controls项，然后在程序中加入以下语句：Dim dc As New SHDocVw.ShellUIHelperdc.ImportExportFavorites False, "c:.html"Set dc = Nothing就可以将收藏夹导出到 c:.htm 中了，如果要从文件导入到收藏夹，只要将上面的False改为True，将"c:.html"改为要导入的文件名就可以了。 ---------------------------------------添加到收藏夹和整理收藏夹 const CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; var p:procedure(Handle: THandle; Path: PChar); stdcall; procedure TForm1.OrganizeFavorite(Sender: Tobject); var H: HWnd; begin H := LoadLibrary(PChar('shdocvw.dll')); if H <> 0 then begin p := GetProcAddress(H, PChar('DoOrganizeFavDlg')); if Assigned(p) then p(Application.Handle, PChar(FavFolder)); end; FreeLibrary(h); end; procedure TForm1.AddFavorite(Sender: TObject); var ShellUIHelper: ISHellUIHelper; url, title: Olevariant; begin Title := Webbrowser1.LocationName; Url := Webbrowser1.LocationUrl; if Url <> '' then begin ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper; ShellUIHelper.AddFavorite(url, title); end; end; 用上面的通过ISHellUIHelper接口来打开“添加到收藏夹”对话框的方法比较简单，但是有个缺陷，就是打开的窗口不是模式窗口，而是独立于应用程序的。可以想象，如果使用与OrganizeFavorite过程同样的方法来打开对话框，由于可以指定父窗口的句柄，自然可以实现模式窗口（效果与在资源管理器和IE中打开“添加到收藏夹”对话框相同）。问题显然是这样的，上面两个过程的作者当时只知道shdocvw.dll中DoOrganizeFavDlg的原型而不知道DoAddToFavDlg的原型，所以只好用ISHellUIHelper接口来实现（或许是他不够严谨，认为是否是模式窗口无所谓？）。 下面的过程就告诉你DoAddToFavDlg的函数原型。需要注意的是，这样打开的对话框并不执行“添加到收藏夹”的操作，它只是告诉应用程序用户是否选择了“确定”，同时在DoAddToFavDlg的第二个参数中返回用户希望放置Internet快捷方式的路径，建立.Url文件的工作由应用程序自己来完成。 procedure TForm1.AddFavorite(IE: TEmbeddedWB); procedure CreateUrl(AUrlPath, AUrl: PChar); var URLfile: TIniFile; begin URLfile := TIniFile.Create(String(AUrlPath)); RLfile.WriteString('InternetShortcut', 'URL', String(AUrl)); RLfile.Free; end; var AddFav: function(Handle: THandle; UrlPath: PChar; UrlPathSize: Cardinal; Title: PChar; TitleSize: Cardinal; FavIDLIST: pItemIDList): Bool; stdcall; FDoc: IHTMLDocument2; UrlPath, url, title: array[0..MAX_PATH] of char; H: HWnd; pidl: pItemIDList; FRetOK: Bool; begin FDoc := IHTMLDocument2(IE.Document); if FDoc = nil then exit; StrPCopy(Title, FDoc.Get_title); StrPCopy(url, FDoc.Get_url); if Url <> '' then begin H := LoadLibrary(PChar('shdocvw.dll')); if H <> 0 then begin SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl); AddFav := GetProcAddress(H, PChar('DoAddToFavDlg')); if Assigned(AddFav) then FRetOK :=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title), pidl) end; FreeLibrary(h); if FRetOK then CreateUrl(UrlPath, Url); end end;
procedure TForm1.ToolButton1Click(Sender: TObject);label Write;var Favorites:String; Search:TSearchRec;begin Favorites:=GetFavoritesPath; if Favorites='' then begin MessageBox(Handle,'访问收藏夹主键错误！','提示信息',MB_OK); exit; end; Memo1.Clear; with Search,Memo1.Lines do begin if FindFirst(Favorites+'*.url',0,Search)=0 then begin Write: Add(GetFavoritesUrl(Favorites+Name)); SetLength(Name,Length(Name)-4); Add(Name); if FindNext(Search)=0 then goto Write; end; end;end; function TForm1.GetFavoritesPath:String;var reg:TRegistry;begin Result:=''; reg:=TRegistry.Create; with reg do begin RootKey:=HKEY_USERS; if OpenKey('.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders',false)=true then Result:=ReadString('Favorites')+'\'; CloseKey; Free; end;end; {function TForm1.GetFavoritesUrl(FavoritesFile: String): String;begin with TIniFile.Create(FavoritesFile)do begin Result:=ReadString('InternetShortcut','URL',''); Free; end;end;} function TForm1.GetFavoritesUrl(FavoritesFile: String): String;var i:integer;begin Result:=''; with TStringList.Create do begin LoadFromFile(FavoritesFile); i:=IndexOf('[InternetShortcut]'); if i=-1 then exit; Result:=Strings[i+1]; System.Delete(Result,1,4); Free; end;end;