高分寻求象金山毒霸那样的目录树,请各位大侠不吝赐教？

Question

1stClass 3000 注册码Name:any 
Serial:any Password:1ST3000824725RK http://www.woll2woll.com

Answer 1

以前好像有个这种想法。下面这一段也许能够实现你的需要。使用了shell编程。
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls,
  ShlObj, clipbrd, StdCtrls;type
TForm1 = class(TForm)
TreeView1: TTreeView;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
FItemList: TList;
procedure SetTreeViewImageList;
procedure FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode);
end;var
  Form1: TForm1;implementation
uses
ActiveX, ComObj, ShellAPI, CommCtrl, BrowseTreeView;{$R *.dfm}
// 获得系统的图标列表
procedure TForm1.SetTreeViewImageList;
var
ImageList: THandle;
FileInfo: TSHFileInfo;
begin
ImageList := SHGetFileInfo(PChar('C:\'), 0, FileInfo, sizeof(TSHFileInfo),
        SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
        
if ImageList <> 0 then
TreeView_SetImageList(TreeView1.Handle, ImageList, 0);
end;// 生成文件夹管理树
procedure TForm1.FillTreeView(Folder: IShellFolder;
  FullPIDL: PItemIDList; ParentNode: TTreeNode);
var
  TreeViewItem: PTreeViewItem;
  EnumIDList: IEnumIDList;
  PIDLs, FullItemPIDL: PItemIDList;
  NumID: LongWord;
  ChildNode: TTreeNode;
  Attr: Cardinal;
begin
  try
  OLECheck(Folder.EnumObjects(Handle, SHCONTF_FOLDERS, EnumIDList));
      //if EnumIDList.Next(1, PIDLs, NumID) = S_OK then
  while EnumIDList.Next(1, PIDLs, NumID) = S_OK do
  begin
  FullItemPIDL := ConcatPIDLs(FullPIDL, PIDLs);
  TreeViewItem := New(PTreeViewItem);
  TreeViewItem.ParentFolder := Folder;
  TreeViewItem.Pidl := CopyItemID(PIDLs);
  TreeViewItem.FullPidl := FullItemPIDL;
  TreeViewItem.HasExpanded := False;
  FItemList.Add(TreeViewItem);
  ChildNode := TreeView1.Items.AddChildObject(ParentNode, GetDisplayName(Folder, PIDLs, False), TreeViewItem);
  //GetItemIcons(FullItemPIDL, ChildNode);
          TreeView1.Images := nil;
  Attr := SFGAO_HASSUBFOLDER or SFGAO_FOLDER;
  Folder.GetAttributesOf(1, PIDLs, Attr);
  if Bool(Attr and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) then
  if Bool(Attr and SFGAO_FOLDER) then
  if Bool(Attr and SFGAO_HASSUBFOLDER) then
  ChildNode.HasChildren := True;
  end;
  except
  // 你可在此处对异常进行处理
  end;
end;procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  try
  for I := 0 to FItemList.Count-1 do
  begin
  DisposePIDL(PTreeViewItem(FItemList[i]).PIDL);
  DisposePIDL(PTreeViewItem(FItemList[i]).FullPIDL);
  end;
  FItemList.Clear;
  FItemList.Free;
  except
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  Folder: IShellFolder;
  FullItemPIDL: PItemIDList;
begin
SetTreeViewImageList;
OLECheck(SHGetDesktopFolder(Folder));
    OLECheck(SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES ,FullItemPIDL));
    OLECheck(Folder.BindToObject(FullItemPIDL, nil, IID_IShellFolder, Pointer(Folder)));
FItemList := TList.Create;
FillTreeView(Folder, nil, nil);
end;procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  TVItem: PTreeViewItem;
  SHFolder: IShellFolder;
begin
  TVItem := PTreeViewItem(Node.Data);
  if TVItem.HasExpanded then Exit;
  OLECheck(TVItem.ParentFolder.BindToObject(TVItem^.Pidl, nil, IID_IShellFolder, Pointer(SHFolder)));
  FillTreeView(SHFolder, TVItem^.FullPidl, Node);
  if Node.Level = 2 then Node.AlphaSort;
  TVItem^.HasExpanded := True;
end;function CopyFileToClp(sFile:string;bCopy:boolean):integer;
var
  hf:DROPFILES;
  xs:string;
  hGbl:UInt;
  pGet:Pointer;
begin
  xs:=sFile + chr(0);  openclipboard(0);
  EmptyClipboard;  try
    hf.pt := Point(0,0);
    hf.fNC := false;
    //hf.fWide := false;
    hf.fWide := True;
    hf.pFiles := sizeof(hf);    hGbl:=GlobalAlloc(GHND{GMEM_ZEROINIT or GMEM_MOVEABLE},
        (sizeof(hf)+Length(xs)));
    pGet:=Globallock(hGbl);    if assigned(pGet)then
    begin
      copymemory(Pointer(Integer(pGet)),@hf,sizeof(hf));            //sizeof(DROPFILES)
      copymemory(Pointer(integer(pGet)+sizeof(hf)),Pointer(xs),length(xs));
      GlobalUnlock(hGbl);
      SetClipboardData(CF_HDROP,hGbl);
    end;
  finally
    closeClipboard;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
    name : string;
begin
    if OpenDialog1.Execute then name := Opendialog1.FileName;
    CopyFileToClp(name, True);
end;procedure TForm1.Button2Click(Sender: TObject);
var
    FullItemPIDL: PItemIDList;
    lpsi : BROWSEINFO;
    str  : string;
begin
  with lpsi do begin
    hwndOwner := Handle;
    pidlRoot := nil;
    pszDisplayName := Pchar('选择');
    lpszTitle := Pchar('请选择一个文件夹');
    ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
    //lpfn := @BrowseCallback;
    lpfn := nil;
    lParam := 0;
  end;
  FullItemPIDL := SHBrowseForFolder(lpsi);
  if FullItemPIDL<>nil then begin
     SetLength(str, MAX_PATH);
     SHGetPathFromIDList(FullItemPIDL, PChar(str));
     str := PChar(str);
     Caption := str;
     CoTaskMemFree(FullItemPIDL);
  end;end;end.

Answer 2

gaoys1979(虫洞) :
编译是找不到Variants.dcu,BrowseTreeView.dcu 请gaoys1979(虫洞)进一步指点小弟

Answer 3

Variants是delphi系统带有的。下面是BrowseTreeView的代码不好意思忘记了unit BrowseTreeView;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShlObj, ComCtrls;type
PTreeViewItem = ^TTreeViewItem;
TTreeViewItem = record
     ParentFolder: IShellFolder; // 接点对应的文件夹的父文件夹的IShellFolder接口
     Pidl, FullPidl: PItemIDList; // 接点对应的文件夹的相对和绝对项目标识符列表
     HasExpanded: Boolean; // 接点是否展开
end;    function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList;
    procedure DisposePIDL(ID: PItemIDList);
    function CopyItemID(ID: PItemIDList): PItemIDList;
    function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): String;
    function CreatePIDL(Size: Integer): PItemIDList;
    procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
    
implementationuses
ActiveX, ComObj, ShellAPI, CommCtrl;// 以下是几个对项目标识符进行操作的函数
procedure DisposePIDL(ID: PItemIDList);
var
Malloc: IMalloc;
begin
if ID = nil then Exit;
OLECheck(SHGetMalloc(Malloc));
Malloc.Free(ID);
end;function CopyItemID(ID: PItemIDList): PItemIDList;
var
Malloc: IMalloc;
begin
Result := nil;
OLECheck(SHGetMalloc(Malloc));
if Assigned(ID) then
begin
Result := Malloc.Alloc(ID^.mkid.cb + sizeof(ID^.mkid.cb));
CopyMemory(Result, ID, ID^.mkid.cb + sizeof(ID^.mkid.cb));
end;
end;function NextPIDL(ID: PItemIDList): PItemIDList;
begin
Result := ID;
Inc(PChar(Result), ID^.mkid.cb);
end;function GetPIDLSize(ID: PItemIDList): Integer;
begin
Result := 0;
if Assigned(ID) then
begin
Result := sizeof(ID^.mkid.cb);
while ID^.mkid.cb <> 0 do
begin
Inc(Result, ID^.mkid.cb);
ID := NextPIDL(ID);
end;
end;
end;function CreatePIDL(Size: Integer): PItemIDList;
var
Malloc: IMalloc;
HR: HResult;
begin
Result := nil;
HR := SHGetMalloc(Malloc);
if Failed(HR) then Exit;
try
Result := Malloc.Alloc(Size);
if Assigned(Result) then
FillChar(Result^, Size, 0);
finally
end;
end;function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList;
var
cb1, cb2: Integer;
begin
if Assigned(ID1) then cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb)
else cb1 := 0; cb2 := GetPIDLSize(ID2);
Result := CreatePIDL(cb1 + cb2);
if Assigned(Result) then
begin
if Assigned(ID1) then
CopyMemory(Result, ID1, cb1);
CopyMemory(PChar(Result) + cb1, ID2, cb2);
end;
end;// 将二进制表示的项目标识符列表转换成有可识的项目名
function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): String;
var
StrRet: TStrRet;
P: PChar;
Flags: Integer;
begin
Result := '';
if ForParsing then  Flags := SHGDN_FORPARSING else Flags := SHGDN_NORMAL;
Folder.GetDisplayNameOf(PIDL, Flags, StrRet);
case StrRet.uType of
STRRET_CSTR: SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
STRRET_OFFSET:
begin
P := @PIDL.mkid.abID[StrRet.uOffset - sizeof(PIDL.mkid.cb)];
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
end;
STRRET_WSTR:
            begin
             Result := StrRet.pOleStr;
                if Result = '控制面板' then Result := '';
            end;
end;
end;function GetIcon(PIDL: PItemIDList; Open: Boolean): Integer;
const
IconFlag = SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
var
FileInfo: TSHFileInfo;
Flags: Integer;
begin
if Open then
Flags := IconFlag or SHGFI_OPENICON
else
Flags := IconFlag;
SHGetFileInfo(PChar(PIDL), 0, FileInfo, sizeof(TSHFileInfo), Flags);
Result := FileInfo.iIcon;
end;// 获得每个文件夹在系统中的图标
procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
begin
with TreeNode do
begin
ImageIndex := GetIcon(FullPIDL, False);
SelectedIndex := GetIcon(FullPIDL, True);
end;
end;end.

Answer 4

需要说明的是，这段源代码编译以后得到的只是一个及其普通的界面。其中button1点击的是出现普通的选择文件窗口，而button2点击出现的是一个shell函数的选择路径窗口。只有在treeview里面才是一个文件树。已经去掉标准系统图标，把 TreeView.ImageList := nil 去掉应该就有了。很久以前也是网上找到的东西，不记得了。:(

Answer 5

再致gaoys1979(虫洞):
  能把你的程序运行过程是什么样的？我看你的程序好象先要打开一个文件的操作，我不太明白？所以在此希望gaoys1979(虫洞)兄，能把程序运行过程告诉小弟，小弟不胜感激！

Answer 6

重新看了一下，应该是在Formcreate里面进行的setimage，也就是得到文件的系统图标操作（不过我现在试验得不到图标:( ）然后就是一个一般的Tree的填充。也就是得到根节点。在Treeview的panding事件中进行下一级node的判断。大概就是如此。我给你的代码中有很多是另外的代码。这是我以前进行一个方法评估时集中了几种打开方法的代码。所以你可能要自己整理一下。

Answer 7

windows的shell编程好像资料很少，以前收集的时候都找不到。在csdn里面如果注册了什么鬼用户以后能够进入会员区以后好像可以看到一些资料。但是我没有注册过，所以!@#!#$%%^#。
如果你还需要其它的资料最好进入http://www.google.com/ 自己定义关键字进行查找。如果愿意看MSDN的英文资料也可以。：）好运！

Answer 8

我做过这样的东西
http://www.csdn.net/cnshare/soft/12/12436.shtm只要稍加改动，就可以列出目录结构，并且可在任意节点加checkbox只是当下取不到源码