用Delphi将IE收藏夹导出为HTML文件

时间：2006/7/19 6:33:28

作者：佚名

人气：456

上网时间长了，总会保存一些好的网站地址，以备将来访问。但是，如果收藏机网址太多，选择的时候反而很费劲。这时候，将这些收藏夹导出为一个HTML文件，然后将它设置为浏览器默认首页就成为一个不错的选择。这里，我们用Delphi实现将这个功能。

一、程序功能分析

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('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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('Software\Microsoft\Internet Explorer\Main', 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_USER\Software\Microsoft\Internet Explorer\Main”中的键值“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('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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('Software\Microsoft\Internet Explorer\Main', false) then

Reg.writeString('Start Page',deskpath+'\我的收藏夹.htm');

finally

Reg.CloseKey;

Reg.Free;

inherited;

end;

memo1.Lines.SaveToFile(deskpath+'\我的收藏夹.htm');

showmessage('文件导出完成！');

end;

end.