首页  编辑  

收藏夹函数

Tags: /超级猛料/OS.操作系统/IE.扩展/历史记录、Cache、收藏夹、Cookie/   Date Created:

Dll 文件:shdocvw.dll

procedure DoOrganizeFavDlg(h:hwnd;path:pchar);stdcall;external 'shdocvw.dll';

第二个参数指定收藏夹的位置,如果第二个参数为Nil的话,默认IE得收藏夹位置。

AddUrlToFavorites

DoAddToFavDlg

DoAddToFavDlgW

DoFileDownload

DoFileDownloadEx

DoOrganizeFavDlgW

SHAddSubscribeFavorite

SetShellOfflineState

SoftwareUpdateMessageBox

//添加到收藏夹

const

 CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';

var

 ShellUIHelper: ISHellUIHelper;

 url, title: Olevariant;

begin

 url:='www.csdn.net'

 title:='中国软件'

 ShellUIHelper :=CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;

 ShellUIHelper.AddFavorite(url, title);

end;

//整理收藏

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(favpath));

         end;

     FreeLibrary(h);

end;

---------

导出收藏夹

在VB中选择菜单的Project | References 选项,在References对话框中选择Microsoft Internet Controls项,然后在程序中加入以下语句:

Dim dc As New SHDocVw.ShellUIHelper

dc.ImportExportFavorites False, "c:\a.html"

Set dc = Nothing

就可以将收藏夹导出到 c:\a.htm 中了,如果要从文件导入到收藏夹,只要将上面的False改为True,将"c:\a.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;