用Delphi将IE收藏夹导出为HTML文件
点击次数：53 次 发布日期：2008-11-09 08:39:10 作者：源代码网
源代码网推荐 源代码网推荐 一、程序功能分析 源代码网推荐 1、将IE收藏夹导出为HTML文件，要求不打乱IE收藏夹原来网址的分类和级别关系； 源代码网推荐 2、将文件导出到Windows的桌面，并将其设置为浏览器默认首页； 源代码网推荐 源代码网推荐 二、程序具体实现 源代码网推荐 1、取得收藏夹信息，将其转化为HTML代码 源代码网推荐 收藏夹直接对应于windows目录的Favorites文家夹文件夹，这个文件夹中，每一个子文件夹就是收藏夹中的一个分类，文件夹中的每一个后缀为.URL的文件就是收藏夹的一个收藏。打开一个.名为“计算机世界报”的.URL文件，其内容如下： 源代码网推荐 [InternetShortcut] 源代码网推荐 URL=http://www.ccw.com.cn 源代码网推荐 原来，“计算机世界报”的这个收藏的网址就是文件中的URL键值。 源代码网推荐 现在，我们明白了，要导出收藏夹，只要取得Favorites文件夹的所有文件名和文件中的URL键值就可以了。我们用一个函数来实现： 源代码网推荐 function Tform1.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; 源代码网推荐 //查找所有URL文件 源代码网推荐 path := FavPath "*.url"; 源代码网推荐 dir := ExtractFilepath(path); 源代码网推荐 found := FindFirst(path, faAnyFile, searchrec); 源代码网推荐 //如果文件存在 源代码网推荐 while found = 0 do 源代码网推荐 begin 源代码网推荐 SetString(filename, Buffer, GetPrivateProfileString("InternetShortcut", 源代码网推荐 PChar("URL"), nil, Buffer, SizeOf(Buffer), PChar(dir searchrec.Name))); 源代码网推荐 //构造一个收藏的链接，每个链接加入一个换行控制符 源代码网推荐 str.Add("" copy(searchrec.Name,1,length(searchrec.Name)-4) "" " 源代码网推荐 "); 源代码网推荐 found := FindNext(searchrec); 源代码网推荐 end; 源代码网推荐 found := FindFirst(dir "*.*", faAnyFile, searchrec); 源代码网推荐 //如果是文件夹 源代码网推荐 while found = 0 do 源代码网推荐 begin 源代码网推荐 if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> ".") then 源代码网推荐 begin 源代码网推荐 //在HTML中加入一个换行控制符 源代码网推荐 str.add(" 源代码网推荐 "); 源代码网推荐 str.add(searchrec.name " 源代码网推荐 "); 源代码网推荐 str.AddStrings(GetIEFavourites(dir "" searchrec.Name)); 源代码网推荐 end; 源代码网推荐 found := FindNext(searchrec); 源代码网推荐 end; 源代码网推荐 FindClose(searchrec); 源代码网推荐 Result := str; 源代码网推荐 end; 源代码网推荐 源代码网推荐 在这个函数中，参数favpath是收藏夹的具体路径；函数直接返回一段HTML代码。以上代码中，有两个函数要必须注意： 源代码网推荐 （1）GetPrivateProfileString函数 源代码网推荐 功能是取得一个INI文件的键值，在以上代码中，是取得URL键值。函数如下： 源代码网推荐 DWORD GetPrivateProfileString( 源代码网推荐 LPCTSTR lpAppName, // points to section name 源代码网推荐 LPCTSTR lpKeyName, // points to key name 源代码网推荐 LPCTSTR lpDefault, // points to default string 源代码网推荐 LPTSTR lpReturnedString, // points to destination buffer 源代码网推荐 DWORD nSize, // size of destination buffer 源代码网推荐 LPCTSTR lpFileName // points to initialization filename 源代码网推荐 ); 源代码网推荐 参数解释： 源代码网推荐 lpAppName：INI文件的“节”，代码中为“InternetShortcut”； 源代码网推荐 lpKeyName：INI文件lpAppName节中的“键”，代码中为“URL”； 源代码网推荐 lpReturnedString：默认返回值； 源代码网推荐 nSize：缓冲大小； 源代码网推荐 lpFileName：INI文件名，代码中为每一个URL文件； 源代码网推荐 （2）copy函数 源代码网推荐 功能是拷贝字符串的一部分，在以上代码中是取得URL文件的文件名，也就是收藏夹中的单个收藏名；函数如下： 源代码网推荐 function Copy(S; Index, Count: Integer): string; 源代码网推荐 参数解释： 源代码网推荐 S：源字符串，代码中为URL文件名（带后缀）； 源代码网推荐 Index：拷贝的开始位置，代码中为S字符串的开始； 源代码网推荐 Count：要拷贝的字符串个数，代码中为URL文件名长减4，目的是去掉URL文件名的后缀“.URL”； 源代码网推荐 2、取得的信息保存为HTML文件，并将其设为浏览器首页 源代码网推荐 为了便于理解，程序中首先将取得的收藏夹信息导入到一个Richedit中，然后加入HTML文件的头尾信息（可以不要）。这样做还有一个好处是可以用户可以直接修改要生成文件的HTML源代码。 源代码网推荐 导入Richedit的程序代码如下： 源代码网推荐 procedure TForm1.Button1Click(Sender: TObject); 源代码网推荐 var 源代码网推荐 pidl: PItemIDList; 源代码网推荐 FavPath: array[0..MAX_PATH] of char; 源代码网推荐 begin 源代码网推荐 SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl); 源代码网推荐 SHGetPathFromIDList(pidl, favpath); 源代码网推荐 //加入HTML文件头信息 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add(" 源代码网推荐 我的收藏夹 源代码网推荐 "); 源代码网推荐 memo1.Lines.Add(" 源代码网推荐 -------------------------------------------------------------------------------- 源代码网推荐 源代码网推荐 源代码网推荐 "); 源代码网推荐 //取得收藏夹信息 源代码网推荐 memo1.Lines.add(GetIEFavourites(StrPas(FavPath)).gettext); 源代码网推荐 //加入HTML文件尾信息 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 button2.Enabled:=true; 源代码网推荐 showmessage("代码生成完成！"); 源代码网推荐 end; 源代码网推荐 源代码网推荐 在以上代码中，有两个函数要注意： 源代码网推荐 （1）SHGetSpecialFolderLocation 源代码网推荐 此函数的功能是取得系统特定目录的路径；函数如下： 源代码网推荐 WINSHELLAPI HRESULT WINAPI SHGetSpecialFolderLocation(; 源代码网推荐 HWND hwndOwner, 源代码网推荐 int nFolder, 源代码网推荐 LPITEMIDLIST *ppidl 源代码网推荐 ); 源代码网推荐 参数解释： 源代码网推荐 hwndOwner：HWND信息； 源代码网推荐 nFolder：需要取得的路径的代码，程序中为CSIDL_FAVORITES收藏夹路径； 源代码网推荐 *ppidl：路径保存指针； 源代码网推荐 （2）SHGetPathFromIDList 源代码网推荐 此函数从指针取得路径信息；函数如下： 源代码网推荐 源代码网推荐 WINSHELLAPI BOOL WINAPI SHGetPathFromIDList( 源代码网推荐 LPCITEMIDLIST pidl, 源代码网推荐 LPSTR pszPath 源代码网推荐 ); 源代码网推荐 参数解释： 源代码网推荐 pidl：指针信息，程序中从SHGetSpecialFolderLocation取得； 源代码网推荐 pszPath：路径保存字符串，程序中为favpath； 源代码网推荐 源代码网推荐 3、导出文件，并设置其为浏览器首页 源代码网推荐 procedure TForm1.Button2Click(Sender: TObject); 源代码网推荐 var 源代码网推荐 Reg: TRegistry; 源代码网推荐 deskpath:string; 源代码网推荐 begin 源代码网推荐 //取得桌面路径 源代码网推荐 Reg := TRegistry.Create; 源代码网推荐 try 源代码网推荐 Reg.RootKey := HKEY_CURRENT_USER; 源代码网推荐 if Reg.OpenKey("SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders", false) then 源代码网推荐 deskpath:=Reg.readString("Desktop"); 源代码网推荐 finally 源代码网推荐 Reg.CloseKey; 源代码网推荐 Reg.Free; 源代码网推荐 inherited; 源代码网推荐 end; 源代码网推荐 //设为首页 源代码网推荐 Reg := TRegistry.Create; 源代码网推荐 try 源代码网推荐 Reg.RootKey := HKEY_CURRENT_USER; 源代码网推荐 if Reg.OpenKey("SoftwareMicrosoftInternet ExplorerMain", false) then 源代码网推荐 Reg.writeString("Start Page",deskpath "我的收藏夹.htm"); 源代码网推荐 finally 源代码网推荐 Reg.CloseKey; 源代码网推荐 Reg.Free; 源代码网推荐 inherited; 源代码网推荐 end; 源代码网推荐 //将文件导出到桌面 源代码网推荐 memo1.Lines.SaveToFile(deskpath "我的收藏夹.htm"); 源代码网推荐 showmessage("文件导出完成！"); 源代码网推荐 end; 源代码网推荐 源代码网推荐 以上代码从注册表获得Windows桌面路径，然后输出文件，并将此文件设置为浏览器首页。设置为浏览器首页的实现就是修改注册表：“HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMain”中的键值“Start Page”就可以了。 源代码网推荐 源代码网推荐 三、总结与启示 源代码网推荐 看了以上代码，我们可以得到一些编程思路如：遍历文件，读写注册表等。如果仔细想想，我们还可以发现怎样将一个网址直接加入收藏夹的思路！ 源代码网推荐 源代码网推荐 完全源代码： 源代码网推荐 unit UFav2HTML; 源代码网推荐 源代码网推荐 interface 源代码网推荐 源代码网推荐 uses 源代码网推荐 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 源代码网推荐 StdCtrls,ShlObj,shellapi,Registry; 源代码网推荐 源代码网推荐 type 源代码网推荐 TForm1 = class(TForm) 源代码网推荐 Button1: TButton; 源代码网推荐 Memo1: TMemo; 源代码网推荐 Button2: TButton; 源代码网推荐 procedure Button1Click(Sender: TObject); 源代码网推荐 function GetIEFavourites(const favpath: string): TStrings; 源代码网推荐 procedure Button2Click(Sender: TObject); 源代码网推荐 private 源代码网推荐 { Private declarations } 源代码网推荐 public 源代码网推荐 { Public declarations } 源代码网推荐 end; 源代码网推荐 源代码网推荐 var 源代码网推荐 Form1: TForm1; 源代码网推荐 源代码网推荐 implementation 源代码网推荐 源代码网推荐 {$R *.DFM} 源代码网推荐 function Tform1.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; 源代码网推荐 path := FavPath "*.url"; 源代码网推荐 dir := ExtractFilepath(path); 源代码网推荐 found := FindFirst(path, faAnyFile, searchrec); 源代码网推荐 while found = 0 do 源代码网推荐 begin 源代码网推荐 SetString(filename, Buffer, GetPrivateProfileString("InternetShortcut", 源代码网推荐 PChar("URL"), nil, Buffer, SizeOf(Buffer), PChar(dir searchrec.Name))); 源代码网推荐 str.Add("" copy(searchrec.Name,1,length(searchrec.Name)-4) "" " 源代码网推荐 "); 源代码网推荐 found := FindNext(searchrec); 源代码网推荐 end; 源代码网推荐 found := FindFirst(dir "*.*", faAnyFile, searchrec); 源代码网推荐 while found = 0 do 源代码网推荐 begin 源代码网推荐 if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> ".") then 源代码网推荐 begin 源代码网推荐 str.add(" 源代码网推荐 "); 源代码网推荐 str.add(searchrec.name " 源代码网推荐 "); 源代码网推荐 str.AddStrings(GetIEFavourites(dir "" searchrec.Name)); 源代码网推荐 end; 源代码网推荐 found := FindNext(searchrec); 源代码网推荐 end; 源代码网推荐 FindClose(searchrec); 源代码网推荐 Result := str; 源代码网推荐 end; 源代码网推荐 源代码网推荐 procedure TForm1.Button1Click(Sender: TObject); 源代码网推荐 var 源代码网推荐 pidl: PItemIDList; 源代码网推荐 FavPath: array[0..MAX_PATH] of char; 源代码网推荐 begin 源代码网推荐 SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl); 源代码网推荐 SHGetPathFromIDList(pidl, favpath); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 memo1.Lines.Add("我的收藏夹"); 源代码网推荐 memo1.Lines.Add("--------------------------------------------------------------------------------"); 源代码网推荐 memo1.Lines.add(GetIEFavourites(StrPas(FavPath)).gettext); 源代码网推荐 memo1.Lines.Add(""); 源代码网推荐 button2.Enabled:=true; 源代码网推荐 showmessage("代码生成完成！"); 源代码网推荐 end; 源代码网推荐 源代码网推荐 procedure TForm1.Button2Click(Sender: TObject); 源代码网推荐 var 源代码网推荐 Reg: TRegistry; 源代码网推荐 deskpath:string; 源代码网推荐 begin 源代码网推荐 //取得桌面路径 源代码网推荐 Reg := TRegistry.Create; 源代码网推荐 try 源代码网推荐 Reg.RootKey := HKEY_CURRENT_USER; 源代码网推荐 if Reg.OpenKey("SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders", false) then 源代码网推荐 deskpath:=Reg.readString("Desktop"); 源代码网推荐 finally 源代码网推荐 Reg.CloseKey; 源代码网推荐 Reg.Free; 源代码网推荐 inherited; 源代码网推荐 end; 源代码网推荐 //设为首页 源代码网推荐 Reg := TRegistry.Create; 源代码网推荐 try 源代码网推荐 Reg.RootKey := HKEY_CURRENT_USER; 源代码网推荐 if Reg.OpenKey("SoftwareMicrosoftInternet ExplorerMain", false) then 源代码网推荐 Reg.writeString("Start Page",deskpath "我的收藏夹.htm"); 源代码网推荐 finally 源代码网推荐 Reg.CloseKey; 源代码网推荐 Reg.Free; 源代码网推荐 inherited; 源代码网推荐 end; 源代码网推荐 源代码网推荐 memo1.Lines.SaveToFile(deskpath "我的收藏夹.htm"); 源代码网推荐 showmessage("文件导出完成！"); 源代码网推荐 end; 源代码网推荐 源代码网推荐 end. 软件开发网 www.mscto.com 源代码网推荐 源代码网供稿. |
