|
上網時間長了，總會保存一些好的網站地址，以備將來訪問。但是，如果收藏機網址太多，選擇的時候反而很費勁。這時候，將這些收藏夾導出為一個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.
|
