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