日本国产亚洲-日本国产一区-日本国产一区二区三区-日本韩国欧美一区-日本韩国欧美在线-日本韩国欧美在线观看

當前位置:雨林木風下載站 > 技術開發教程 > 詳細頁面

用Delphi將IE收藏夾備份為HTML文件

用Delphi將IE收藏夾備份為HTML文件

更新時間:2022-04-28 文章作者:未知 信息來源:網絡 閱讀次數:

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

溫馨提示:喜歡本站的話,請收藏一下本站!

本類教程下載

系統下載排行

主站蜘蛛池模板: 国产欧美在线观看精品一区二区 | 日产一区二区三区精品视频 | 欧美国产一区二区 | 国产日韩第一页 | 国产精品香蕉成人网在线观看 | 欧美精品在线一区 | 狠狠操综合网 | 99久久久国产精品免费播放器 | 日本高清在线精品一区二区三区 | 狠狠色噜噜狠狠狠狠色吗综合 | 国产精品久久久久一区二区三区 | 亚洲日本va中文字幕婷婷 | 亚洲综合色丁香婷婷六月图片 | 国产在线丝袜 | 国产1区在线观看 | 精品福利在线视频 | 成年人视频免费在线观看 | 欧美艹逼视频 | 国产91专区 | 99久久精品费精品国产一区二区 | 免费看一区二区三区 | 一本一本久久a久久精品综合麻豆 | 一级爱爱片 | 美欧人性做爰 | 国产片一区二区三区 | 精品视频一区二区三区四区 | 精品国产美女福利到在线不卡 | 大尺度做爰啪啪床戏男人小说 | 欧美日本综合一区二区三区 | 国产日韩在线观看视频网站 | 精品国产免费一区二区三区五区 | 九九九热在线精品免费全部 | 欧美亚洲免费 | 亚洲欧美日韩中文字幕在线一区 | 成年男女免费视频网站 | 亚洲三级小视频 | 久久久久久国产精品免费免 | 亚洲免费在线播放 | 91视频看 | 在线播放a | 欧美日韩亚洲一区二区三区在线观看 |