怎样调取IE收藏夹?(10分)

  • 主题发起人 jericho3164
  • 开始时间
J

jericho3164

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样像IE浏览器一样在程序中读取IE收藏夹,和IE的一摸一样的?点收藏就弹出收藏夹的菜单?
 
呵呵,如果是读取收藏夹的话,其实就是WINDOWS目录下的收藏夹
程序实现可以这样,你在窗体上面放两个LISTBOX
然后下面是源代码
unit Umain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ComCtrls, StdCtrls,shellapi;

const
IMAGENUM_BOOKCLOSE = 0; //关闭的类型标志
IMAGENUM_BOOKOPEN = 1; //网络地址标志
IMAGENUM_URLPAGE = 2; //打开的类型标志

type
Tdlg_URLTree = class(TForm)
tv_FileName: TTreeView;
tv_URLName: TTreeView;
MainMenu1: TMainMenu;
mnup_Get: TMenuItem;
Button1: TButton;
//取得网址的函数
procedure mnup_GetClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure tv_URLNameDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

procedure FF_GetDirFileName(strPath: String;tvFile,tvURL: TTreeView); //存放URL名的TTreeView控件

end;

var
dlg_URLTree: Tdlg_URLTree;

implementation
uses IniFiles;
{$R *.dfm}


procedure Tdlg_URLTree.FF_GetDirFileName(strPath: String; tvFile,
tvURL: TTreeView);
var
intRet: Integer;
DirInfo: TSearchRec;
strIniFile: TIniFile;
buffer: String;
tnNew: TTreeNode;
begin
intRet := FindFirst(strPath + '/*.*', FaAnyfile, DirInfo);

while intRet = 0 do
begin
if (DirInfo.Name <> '.') and //滤掉 .目录
(DirInfo.Name <> '..') and //滤掉 ..目录
(Pos('.lnk', DirInfo.Name) = 0) and //滤掉 *.lnk文件
(Pos('.ini', DirInfo.Name) = 0) then //滤掉 *.ini文件
begin
if (DirInfo.Attr and FaDirectory = FaDirectory) then
begin
tnNew := tvFile.Items.AddChild(tvFile.Selected, DirInfo.Name);
tnNew.Selected := True;
tnNew.ImageIndex := IMAGENUM_BOOKCLOSE; //设定分类目录节点的图标
tnNew.SelectedIndex := IMAGENUM_BOOKOPEN;
(tvURL.Items.AddChild(tvURL.Selected, DirInfo.Name)).Selected := True;
FF_GetDirFileName(strPath + '/' + DirInfo.Name, tvFile, tvURL);
end else
begin
buffer := DirInfo.Name;
Delete(buffer, Pos('.url', buffer), 4); //滤掉文件名中的 .url
//添加名称到 tvFile中

tnNew := tvFile.Items.AddChild(tvFile.Selected, buffer);
tnNew.ImageIndex := IMAGENUM_URLPAGE; //设定Web页节点的图标
tnNew.SelectedIndex := tnNew.ImageIndex;
//得到URL,并加入到tvURL树中
strIniFile := TIniFile.Create(strPath + '/' + DirInfo.Name);
buffer := strIniFile.ReadString('InternetShortcut','URL','');
strIniFile.Destroy;
tvURL.Items.AddChild(tvURL.Selected, buffer);
end;
end;
intRet := FindNext(DirInfo);
end;

//重置文件名树tvFile的焦点
if tvFile.Selected <> nil then
if tvFile.Selected.Parent <> nil then
(tvFile.Selected.Parent).Selected := True
else (tvFile.Selected).Selected := False;

//重置Web地址树tvURL的焦点
if tvURL.Selected <> nil then
if tvURL.Selected.Parent <> nil then
(tvURL.Selected.Parent).Selected := True
else (tvURL.Selected).Selected := False;

SysUtils.FindClose(DirInfo);
end;

procedure Tdlg_URLTree.mnup_GetClick(Sender: TObject);
var
strURLFileName: TFileName;
pWinDir:pchar; //windows目录
begin
GetMem(pWinDir, 256);
GetWindowsDirectory(pWinDir,128);
strURLFileName := pWinDir + '/Favorites';
FreeMem(pWinDir);
//取得收藏夹的内容
FF_GetDirFileName(strURLFileName, tv_FileName, tv_URLName);
end;

procedure Tdlg_URLTree.Button1Click(Sender: TObject);
var
URLText:pchar;
begin
URLText:='mailto:lovefox@x263.net';
//激活OUTLOOK
Shellexecute(handle,nil,pchar(URLText),nil,nil,sw_shownormal);
end;

procedure Tdlg_URLTree.tv_URLNameDblClick(Sender: TObject);
var
URLText:string;
begin
URLText:=tv_URLName.Selected.Text;
//ShellExecute(Handle, 'open', 'IEXPLORE',URLText, nil, SW_SHOWNORMAL);
Shellexecute(handle,nil,pchar(URLText),nil,nil,sw_shownormal);
end;

end.
 
多人接受答案了。
 
顶部