自己改一下吧procedure TMainForm.FavItemClick(Sender: TObject); var i:Integer; WorkDir:String; begin for i:=TMenuItem(Sender).Count-1 downto 3 do TMenuItem(Sender).Delete(i); WorkDir:=GetFavDir; CreateFavMenu(WorkDir,FavItem); end;function TMainForm.GetFavDir: String; //获得收藏夹的目录 var Reg: TRegistry; begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False) then Result :=Reg.ReadString('Favorites'); finally Reg.CloseKey; Reg.Free; End; end; procedure TMainForm.CreateFavMenu(Const WorkDir:String;Var MenuItem:TMenuItem); var SearchRec:TSearchRec; FWorkDir:String; SubMenuItem:TMenuItem; begin FWorkDir :=WorkDir; if (FindFirst(FWorkDir +'\*.*', faDirectory,SearchRec)=0) then begin repeat if (SearchRec.Attr and faDirectory = faDirectory) then Begin if (SearchRec.Name <>'.')and (SearchRec.Name <>'..') then begin SubMenuItem:=TMenuItem.Create(Application); SubMenuItem.Caption :=SearchRec.Name; SubMenuItem.ImageIndex:=21; MenuItem.Add(SubMenuItem); CreateFavMenu(FWorkDir+'\'+SearchRec.Name,SubMenuItem); end; end; until FindNext(SearchRec) <> 0; end; FindClose(SearchRec); if (FindFirst(FWorkDir +'\*.*', faDirectory,SearchRec)=0) then begin repeat if (SearchRec.Attr and faDirectory <> faDirectory) then begin SubMenuItem:=TMenuItem.Create(MenuItem); SubMenuItem.Caption :=Copy(SearchRec.Name,1,Length(SearchRec.Name)-4); SubMenuItem.ImageIndex:=22; if Length(SubMenuItem.Caption) >25 then SubMenuItem.Caption :=Copy(SubMenuItem.Caption,1,25)+'...'; SubMenuItem.Hint :=GetUrlFileURL(FWorkDir,SearchRec.Name); SubMenuItem.OnClick :=MenuItem_FaClick; MenuItem.Add(SubMenuItem); end; until FindNext(SearchRec) <> 0; End; FindClose(SearchRec); end;
1、IE的收藏夹内容保存在C:\Documents and Settings\XXXX\Favorites目录中 2、每个收藏都是文本格式的文件 3、你可以使用FindFirst,FindNext遍历目录树,将你需要的内容加入到LitBox或ListView中。 4、选择编辑实际上就是编辑文本文件。
2. 显示相关内容?url里面有网址的文本信息,读出来用TWebBrowser上网显示就行了。
2、用ShellExecute打开该文件,就可以显示相应网页。—————————————————————————————————
宠辱不惊,看庭前花开花落,去留无意;毁誉由人,望天上云卷云舒,聚散任风。
—————————————————————————————————
var
i:Integer;
WorkDir:String;
begin
for i:=TMenuItem(Sender).Count-1 downto 3 do
TMenuItem(Sender).Delete(i);
WorkDir:=GetFavDir;
CreateFavMenu(WorkDir,FavItem);
end;function TMainForm.GetFavDir: String;
//获得收藏夹的目录
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False) then
Result :=Reg.ReadString('Favorites');
finally
Reg.CloseKey;
Reg.Free;
End;
end;
procedure TMainForm.CreateFavMenu(Const WorkDir:String;Var MenuItem:TMenuItem);
var
SearchRec:TSearchRec;
FWorkDir:String;
SubMenuItem:TMenuItem;
begin
FWorkDir :=WorkDir;
if (FindFirst(FWorkDir +'\*.*', faDirectory,SearchRec)=0) then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) then
Begin
if (SearchRec.Name <>'.')and (SearchRec.Name <>'..') then
begin
SubMenuItem:=TMenuItem.Create(Application);
SubMenuItem.Caption :=SearchRec.Name;
SubMenuItem.ImageIndex:=21;
MenuItem.Add(SubMenuItem);
CreateFavMenu(FWorkDir+'\'+SearchRec.Name,SubMenuItem);
end;
end;
until FindNext(SearchRec) <> 0;
end;
FindClose(SearchRec); if (FindFirst(FWorkDir +'\*.*', faDirectory,SearchRec)=0) then
begin
repeat
if (SearchRec.Attr and faDirectory <> faDirectory) then
begin
SubMenuItem:=TMenuItem.Create(MenuItem);
SubMenuItem.Caption :=Copy(SearchRec.Name,1,Length(SearchRec.Name)-4);
SubMenuItem.ImageIndex:=22;
if Length(SubMenuItem.Caption) >25 then
SubMenuItem.Caption :=Copy(SubMenuItem.Caption,1,25)+'...';
SubMenuItem.Hint :=GetUrlFileURL(FWorkDir,SearchRec.Name);
SubMenuItem.OnClick :=MenuItem_FaClick;
MenuItem.Add(SubMenuItem);
end;
until FindNext(SearchRec) <> 0;
End;
FindClose(SearchRec);
end;
2、每个收藏都是文本格式的文件
3、你可以使用FindFirst,FindNext遍历目录树,将你需要的内容加入到LitBox或ListView中。
4、选择编辑实际上就是编辑文本文件。