关于遍历文件夹在treeView中生成目录树!!!

时间:2021-11-29 13:39:36
功能:指定文件夹路径,指定文件类型,在treeView中生成目录树,需要按文件夹分级。
请高手帮忙!!!

4 个解决方案

#1


//显示任意一个目录的文件到TReeview中
unit uTreeViewDemo;

interface

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

const
  SELDIRHELP = 1000;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
                         IncludeFiles: Boolean);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
                                IncludeFiles: Boolean);
var
  SearchRec: TSearchRec;
  ItemTemp: TTreeNode;
begin
  TreeView1.Items.BeginUpdate;
  if Directory[Length(Directory)] <> '\' then
    Directory := Directory + '\';
  if FindFirst(Directory + '*.*' , faDirectory, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
      begin
        if (SearchRec.Attr and faDirectory > 0) then
        Item := Tree.Items.AddChild(Item, SearchRec.Name);
        ItemTemp := Item.Parent;
        GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
        Item := ItemTemp;
      end
      else
      if IncludeFiles then
      if SearchRec.Name[1] <> '.' then
        Tree.Items.AddChild(Item, SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
    TreeView1.Items.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  strOpenDir: string;
begin

  if SelectDirectory(strOpenDir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
  try
    GetDirectories(TreeView1, strOpenDir, nil, True);
  except
    ShowMessage('错误信息');
  end;
end;

end.

#2


用Delphi实现Windows文件夹管理树 

* 薛志东 

程序清单

下面的源代码在Windows98中实现,并在Windows2000测试版中测试无误(程序运行结果如图1所示),有兴趣的读者可以将其改写成Delphi组件,以备常用。

unit BrowseTreeView; 

interface 

uses 

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 

ShlObj, ComCtrls; 

type 

PTreeViewItem = ^TTreeViewItem; 

TTreeViewItem = record 

ParentFolder: IShellFolder; // 接点对应的文件夹的父文件夹的IShellFolder接口 

Pidl, FullPidl: PItemIDList; // 接点对应的文件夹的相对和绝对项目标识符列表 

HasExpanded: Boolean; // 接点是否展开 

end; 



图1 程序运行结果 

TForm1 = class(TForm) 

TreeView1: TTreeView; 

procedure FormDestroy(Sender: TObject); 

procedure FormCreate(Sender: TObject); 

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode; 

var AllowExpansion: Boolean); 

private 

FItemList: TList; 

procedure SetTreeViewImageList; 

procedure FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode); 

end; 

var 

Form1: TForm1; 

implementation 

{$R *.DFM} 

uses 

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: 

Result := StrRet.pOleStr; 

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; 

// 获得系统的图标列表 

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)); 

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); 

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; 

begin 

SetTreeViewImageList; 

OLECheck(SHGetDesktopFolder(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); 

Node.AlphaSort; 

TVItem^.HasExpanded := True; 

end; 

end.

#3


怎样用Treeview对满足条件的文件进行遍历(非数据库) 
主要解答者: zswang 提交人: qxj 
感谢: zswang、zswang 
审核者: qxj 社区对应贴子: 查看 
     A :  

  uses  ShellApi,  FileCtrl;
{$R *.dfm}
function  GetSystemImageList(mImageList:  TImageList):  Boolean;
{  返回系统图标到图形列表中是否成功  }
var
   vHandle:  THandle;
   vSHFileInfo:  TSHFileInfo;
begin
   FillChar(vSHFileInfo,  SizeOf(vSHFileInfo),  0);  
   vHandle  :=  SHGetFileInfo('',  0,  vSHFileInfo,  SizeOf(vSHFileInfo),
       SHGFI_SYSICONINDEX  or  SHGFI_SMALLICON);
   Result  :=  vHandle  <>  0;
   mImageList.Handle  :=  vHandle;
   mImageList.ShareImages  :=  True;  
end;  {  GetSystemImageList  }

function  GetIconIndex(mPath:  string):  Integer;
{  返回文件或路径所对应的图标序号  }  
var
   vSHFileInfo:  TSHFileInfo;  
begin  
   FillChar(vSHFileInfo,  SizeOf(vSHFileInfo),  0);  
   SHGetFileInfo(PChar(mPath),  0,  vSHFileInfo,  SizeOf(vSHFileInfo),  
       SHGFI_SYSICONINDEX);
   Result  :=  vSHFileInfo.iIcon;
end;  {  GetIconIndex  }  

procedure  PathToTreeNode(mDirName:  string;  mTreeView:  TTreeView;
   mTreeNode:  TTreeNode);  
{  返回目录转换成菜单项是否成功  }  
var
   vSearchRec:  TSearchRec;  
   vPathName:  string;  
   K:  Integer;  
   vTreeNode:  TTreeNode;
begin  
   if  not  Assigned(mTreeView)  then  Exit;  
   vPathName  :=  mDirName  +  '\*.*';  
   K  :=  FindFirst(vPathName,  faAnyFile,  vSearchRec);
   while  K  =  0  do  begin  
       if  (vSearchRec.Attr  and  faDirectory  <>  0)  and  
           (Pos(vSearchRec.Name,  '..')  =  0)  then  begin  
           vTreeNode  :=  mTreeView.Items.AddChild(mTreeNode,  vSearchRec.Name);
           vTreeNode.ImageIndex  :=  GetIconIndex(mDirName  +  '\'  +  vSearchRec.Name);
           PathToTreeNode(mDirName  +  '\'  +  vSearchRec.Name,  mTreeView,  vTreeNode)
       end  else  if  (Pos(vSearchRec.Name,  '..')  =  0)  then  begin  
           vTreeNode  :=  mTreeView.Items.AddChild(mTreeNode,  '['  +  vSearchRec.Name  +  ']');  
           vTreeNode.ImageIndex  :=  GetIconIndex(mDirName  +  '\'  +  vSearchRec.Name);
       end;  
       K  :=  FindNext(vSearchRec);
   end;
   FindClose(vSearchRec);
end;  {  PathToTreeNode  }

procedure  TForm1.FormCreate(Sender:  TObject);
begin
   GetSystemImageList(ImageList1);
   treeview1.Images:=imagelist1;
end;

procedure  TForm1.Button1Click(Sender:  TObject);  
var  
   vDirectory:  string;
begin
   if  not  SelectDirectory('Select  Directory',  '',  vDirectory)  then  Exit;
   TreeView1.Items.BeginUpdate;
   try
       TreeView1.Items.Clear;
       PathToTreeNode(vDirectory,  TreeView1,  TreeView1.TopItem);
   finally
       TreeView1.Items.EndUpdate;  
   end;
end;

#4


更简单的
下面的这个函数就可以了:
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode; IncludeFiles:
  Boolean);
var
  SearchRec         : TSearchRec;
  ItemTemp          : TTreeNode;
begin
  with Tree.Items do
  try
    BeginUpdate;
    if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
    if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
        begin
          if (SearchRec.Attr and faDirectory > 0) then
            Root := AddChild(Root, SearchRec.Name);
          ItemTemp := Root.Parent;
          DirToTreeView(Tree, Directory + SearchRec.Name, Root, IncludeFiles);
          Root := ItemTemp;
        end
        else if IncludeFiles then
          if SearchRec.Name[1] <> '.' then
            AddChild(Root, SearchRec.Name);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
  finally
    EndUpdate;
  end;
end;

#1


//显示任意一个目录的文件到TReeview中
unit uTreeViewDemo;

interface

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

const
  SELDIRHELP = 1000;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
                         IncludeFiles: Boolean);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
                                IncludeFiles: Boolean);
var
  SearchRec: TSearchRec;
  ItemTemp: TTreeNode;
begin
  TreeView1.Items.BeginUpdate;
  if Directory[Length(Directory)] <> '\' then
    Directory := Directory + '\';
  if FindFirst(Directory + '*.*' , faDirectory, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
      begin
        if (SearchRec.Attr and faDirectory > 0) then
        Item := Tree.Items.AddChild(Item, SearchRec.Name);
        ItemTemp := Item.Parent;
        GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
        Item := ItemTemp;
      end
      else
      if IncludeFiles then
      if SearchRec.Name[1] <> '.' then
        Tree.Items.AddChild(Item, SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
    TreeView1.Items.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  strOpenDir: string;
begin

  if SelectDirectory(strOpenDir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
  try
    GetDirectories(TreeView1, strOpenDir, nil, True);
  except
    ShowMessage('错误信息');
  end;
end;

end.

#2


用Delphi实现Windows文件夹管理树 

* 薛志东 

程序清单

下面的源代码在Windows98中实现,并在Windows2000测试版中测试无误(程序运行结果如图1所示),有兴趣的读者可以将其改写成Delphi组件,以备常用。

unit BrowseTreeView; 

interface 

uses 

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 

ShlObj, ComCtrls; 

type 

PTreeViewItem = ^TTreeViewItem; 

TTreeViewItem = record 

ParentFolder: IShellFolder; // 接点对应的文件夹的父文件夹的IShellFolder接口 

Pidl, FullPidl: PItemIDList; // 接点对应的文件夹的相对和绝对项目标识符列表 

HasExpanded: Boolean; // 接点是否展开 

end; 



图1 程序运行结果 

TForm1 = class(TForm) 

TreeView1: TTreeView; 

procedure FormDestroy(Sender: TObject); 

procedure FormCreate(Sender: TObject); 

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode; 

var AllowExpansion: Boolean); 

private 

FItemList: TList; 

procedure SetTreeViewImageList; 

procedure FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode); 

end; 

var 

Form1: TForm1; 

implementation 

{$R *.DFM} 

uses 

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: 

Result := StrRet.pOleStr; 

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; 

// 获得系统的图标列表 

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)); 

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); 

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; 

begin 

SetTreeViewImageList; 

OLECheck(SHGetDesktopFolder(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); 

Node.AlphaSort; 

TVItem^.HasExpanded := True; 

end; 

end.

#3


怎样用Treeview对满足条件的文件进行遍历(非数据库) 
主要解答者: zswang 提交人: qxj 
感谢: zswang、zswang 
审核者: qxj 社区对应贴子: 查看 
     A :  

  uses  ShellApi,  FileCtrl;
{$R *.dfm}
function  GetSystemImageList(mImageList:  TImageList):  Boolean;
{  返回系统图标到图形列表中是否成功  }
var
   vHandle:  THandle;
   vSHFileInfo:  TSHFileInfo;
begin
   FillChar(vSHFileInfo,  SizeOf(vSHFileInfo),  0);  
   vHandle  :=  SHGetFileInfo('',  0,  vSHFileInfo,  SizeOf(vSHFileInfo),
       SHGFI_SYSICONINDEX  or  SHGFI_SMALLICON);
   Result  :=  vHandle  <>  0;
   mImageList.Handle  :=  vHandle;
   mImageList.ShareImages  :=  True;  
end;  {  GetSystemImageList  }

function  GetIconIndex(mPath:  string):  Integer;
{  返回文件或路径所对应的图标序号  }  
var
   vSHFileInfo:  TSHFileInfo;  
begin  
   FillChar(vSHFileInfo,  SizeOf(vSHFileInfo),  0);  
   SHGetFileInfo(PChar(mPath),  0,  vSHFileInfo,  SizeOf(vSHFileInfo),  
       SHGFI_SYSICONINDEX);
   Result  :=  vSHFileInfo.iIcon;
end;  {  GetIconIndex  }  

procedure  PathToTreeNode(mDirName:  string;  mTreeView:  TTreeView;
   mTreeNode:  TTreeNode);  
{  返回目录转换成菜单项是否成功  }  
var
   vSearchRec:  TSearchRec;  
   vPathName:  string;  
   K:  Integer;  
   vTreeNode:  TTreeNode;
begin  
   if  not  Assigned(mTreeView)  then  Exit;  
   vPathName  :=  mDirName  +  '\*.*';  
   K  :=  FindFirst(vPathName,  faAnyFile,  vSearchRec);
   while  K  =  0  do  begin  
       if  (vSearchRec.Attr  and  faDirectory  <>  0)  and  
           (Pos(vSearchRec.Name,  '..')  =  0)  then  begin  
           vTreeNode  :=  mTreeView.Items.AddChild(mTreeNode,  vSearchRec.Name);
           vTreeNode.ImageIndex  :=  GetIconIndex(mDirName  +  '\'  +  vSearchRec.Name);
           PathToTreeNode(mDirName  +  '\'  +  vSearchRec.Name,  mTreeView,  vTreeNode)
       end  else  if  (Pos(vSearchRec.Name,  '..')  =  0)  then  begin  
           vTreeNode  :=  mTreeView.Items.AddChild(mTreeNode,  '['  +  vSearchRec.Name  +  ']');  
           vTreeNode.ImageIndex  :=  GetIconIndex(mDirName  +  '\'  +  vSearchRec.Name);
       end;  
       K  :=  FindNext(vSearchRec);
   end;
   FindClose(vSearchRec);
end;  {  PathToTreeNode  }

procedure  TForm1.FormCreate(Sender:  TObject);
begin
   GetSystemImageList(ImageList1);
   treeview1.Images:=imagelist1;
end;

procedure  TForm1.Button1Click(Sender:  TObject);  
var  
   vDirectory:  string;
begin
   if  not  SelectDirectory('Select  Directory',  '',  vDirectory)  then  Exit;
   TreeView1.Items.BeginUpdate;
   try
       TreeView1.Items.Clear;
       PathToTreeNode(vDirectory,  TreeView1,  TreeView1.TopItem);
   finally
       TreeView1.Items.EndUpdate;  
   end;
end;

#4


更简单的
下面的这个函数就可以了:
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode; IncludeFiles:
  Boolean);
var
  SearchRec         : TSearchRec;
  ItemTemp          : TTreeNode;
begin
  with Tree.Items do
  try
    BeginUpdate;
    if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
    if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
        begin
          if (SearchRec.Attr and faDirectory > 0) then
            Root := AddChild(Root, SearchRec.Name);
          ItemTemp := Root.Parent;
          DirToTreeView(Tree, Directory + SearchRec.Name, Root, IncludeFiles);
          Root := ItemTemp;
        end
        else if IncludeFiles then
          if SearchRec.Name[1] <> '.' then
            AddChild(Root, SearchRec.Name);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
  finally
    EndUpdate;
  end;
end;