用Delphi實現Windows文件夾管理樹

　　摘要本文利用Windows名空間所提供的IShellFolder接口用Delphi實現了文件夾管理樹的生成

　　關鍵字文件夾接口 Delphi

　　一概述

　　Windows/視覺感觀上區別Windows的一個重要方面就是大量采用了樹形視圖控件資源管理器左側的文件夾管理樹便是如此它將本地和網絡上的文件夾和文件等資源以層次樹的方式羅列出來為用戶集中管理計算機提供了極大便利同時在外貌上也煥然一新Delphi為我們提供了大量Windows標准控件但遺憾的是在目錄浏覽方面卻只提供了一個Windows樣式的DirectoryListBox（Delphi的測試版也是如此）因此在Delphi中實現Windows文件夾管理樹對開發更地道的Windows程序有著重大意義

　　二實現原理

　　Windows文件夾管理樹的實現實質上是對Windows名空間（Namespace）的遍歷名空間中每個文件夾都提供了一個IShellFolder接口遍歷名空間的方法是

　　）調用SHGetDesktopFolder函數獲得桌面文件夾的IShellFolder接口桌面文件夾是文件夾管理樹的根節點

　　）再調用所獲得的IShellFolder接口的EnumObjects成員函數列舉出子文件夾

　　）調用IShellFolder的BindToObject成員函數獲得子文件夾的IShellFolder接口）重復步驟））列舉出某文件夾下的所有子文件夾只至所獲得的IShellFolder接口為nil為止

　　下面解釋將要用到的幾個主要函數它們在ShlObj單元中定義

　　）function SHGetDesktopFolder(var ppshf: IShellFolder): HResult;

　　該函數通過ppshf獲得桌面文件夾的IShellFolder接口

　　）function IShellFolderEnumObjects(hwndOwner: HWND; grfFlags: DWORD;out EnumIDList: IEnumIDList): HResult;

　　該函數獲得一個IEnumIDList接口通過調用該接口的Next等函數可以列舉出IShellFolder接口所對應的文件夾的內容內容的類型由grfFlags來指定我們需要列舉出子文件夾來因此grfFlags的值指定為SHCONTF_FOLDERSHwndOwner是屬主窗口的句柄

　　）function IShellFolderBindToObject(pidl: PItemIDList; pbcReserved: Pointer;const riid: TIID; out ppvOut: Pointer): HResult;

　　該函數獲得某個子文件夾的IShellFolder接口該接口由ppvOut返回pidl是一個指向元素標識符列表的指針Windows/中用元素標識符和元素標識符列表來標識名空間中的對象它們分別類似於文件名和路徑需要特別指出的是pidl作為參數傳遞給Shell API函數時必須是相對於桌面文件夾的絕對路徑而傳遞給IShellFolder接口的成員函數時則應是相對於該接口所對應文件夾的相對路徑pbcReserved應指定為nilriid則應指定為IID_IShellFolder

　　其它函數可以查閱Delphi提供的《Win Programmers Reference》

　　三程序清單

　　下面的源代碼在Windows中實現並在Windows測試版中測試無誤(程序運行結果如圖所示)有興趣的讀者可以將其改寫成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;

TForm = class(TForm)

TreeView: TTreeView;

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure TreeViewExpanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

private

FItemList: TList;

procedure SetTreeViewImageList;

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

end;

var

Form: TForm;

implementation

{$R *DFM}

uses

ActiveX ComObj ShellAPI CommCtrl;

// 以下是幾個對項目標識符進行操作的函數

procedure DisposePIDL(ID: PItemIDList);

var

Malloc: IMalloc;

begin

if ID = nil then Exit;

OLECheck(SHGetMalloc(Malloc));

MallocFree(ID);

end;

function CopyItemID(ID: PItemIDList): PItemIDList;

var

Malloc: IMalloc;

begin

Result := nil;

OLECheck(SHGetMalloc(Malloc));

if Assigned(ID) then

begin

Result := MallocAlloc(ID^mkidcb + sizeof(ID^mkidcb));

CopyMemory(Result ID ID^mkidcb + sizeof(ID^mkidcb));

end;

function NextPIDL(ID: PItemIDList): PItemIDList;

begin

Result := ID;

Inc(PChar(Result) ID^mkidcb);

end;

function GetPIDLSize(ID: PItemIDList): Integer;

begin

Result := ;

if Assigned(ID) then

begin

Result := sizeof(ID^mkidcb);

while ID^mkidcb <> do

begin

Inc(Result ID^mkidcb);

ID := NextPIDL(ID);

end;

function CreatePIDL(Size: Integer): PItemIDList;

var

Malloc: IMalloc;

HR: HResult;

begin

Result := nil;

HR := SHGetMalloc(Malloc);

if Failed(HR) then Exit;

try

Result := MallocAlloc(Size);

if Assigned(Result) then

FillChar(Result^ Size );

finally

end;

function ConcatPIDLs(ID ID: PItemIDList): PItemIDList;

var

cb cb: Integer;

begin

if Assigned(ID) then

cb := GetPIDLSize(ID) sizeof(ID^mkidcb)

else

cb := ;

cb := GetPIDLSize(ID);

Result := CreatePIDL(cb + cb);

if Assigned(Result) then

begin

if Assigned(ID) then

CopyMemory(Result ID cb);

CopyMemory(PChar(Result) + cb ID cb);

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;

FolderGetDisplayNameOf(PIDL Flags StrRet);

case StrRetuType of

STRRET_CSTR:

SetString(Result StrRetcStr lStrLen(StrRetcStr));

STRRET_OFFSET:

begin

P := @PIDLmkidabID[StrRetuOffset sizeof(PIDLmkidcb)];

SetString(Result P PIDLmkidcb StrRetuOffset);

end;

STRRET_WSTR:

Result := StrRetpOleStr;

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) FileInfo sizeof(TSHFileInfo) Flags);

Result := FileInfoiIcon;

end;

// 獲得每個文件夾在系統中的圖標

procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);

begin

with TreeNode do

begin

ImageIndex := GetIcon(FullPIDL False);

SelectedIndex := GetIcon(FullPIDL True);

end;

// 獲得系統的圖標列表

procedure TFormSetTreeViewImageList;

var

ImageList: THandle;

FileInfo: TSHFileInfo;

begin

ImageList := SHGetFileInfo(PChar(C:\) FileInfo

sizeof(TSHFileInfo) SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

if ImageList <> then

TreeView_SetImageList(TreeViewHandle ImageList );

end;

// 生成文件夾管理樹

procedure TFormFillTreeView(Folder: IShellFolder;

FullPIDL: PItemIDList; ParentNode: TTreeNode);

var

TreeViewItem: PTreeViewItem;

EnumIDList: IEnumIDList;

PIDLs FullItemPIDL: PItemIDList;

NumID: LongWord;

ChildNode: TTreeNode;

Attr: Cardinal;

begin

try

OLECheck(FolderEnumObjects(Handle SHCONTF_FOLDERS EnumIDList));

while EnumIDListNext( PIDLs NumID) = S_OK do

begin

FullItemPIDL := ConcatPIDLs(FullPIDL PIDLs);

TreeViewItem := New(PTreeViewItem);

TreeViewItemParentFolder := Folder;

TreeViewItemPidl := CopyItemID(PIDLs);

TreeViewItemFullPidl := FullItemPIDL;

TreeViewItemHasExpanded := False;

FItemListAdd(TreeViewItem);

ChildNode := TreeViewItemsAddChildObject(ParentNode

GetDisplayName(Folder PIDLs False) TreeViewItem);

GetItemIcons(FullItemPIDL ChildNode);

Attr := SFGAO_HASSUBFOLDER or SFGAO_FOLDER;

FolderGetAttributesOf( 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

ChildNodeHasChildren := True;

end;

except

// 你可在此處對異常進行處理

end;

procedure TFormFormDestroy(Sender: TObject);

var

I: Integer;

begin

try

for I := to FItemListCount do

begin

DisposePIDL(PTreeViewItem(FItemList[i])PIDL);

DisposePIDL(PTreeViewItem(FItemList[i])FullPIDL);

end;

FItemListClear;

FItemListFree;

except

end;

procedure TFormFormCreate(Sender: TObject);

var

Folder: IShellFolder;

begin

SetTreeViewImageList;

OLECheck(SHGetDesktopFolder(Folder));

FItemList := TListCreate;

FillTreeView(Folder nil nil);

end;

procedure TFormTreeViewExpanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

var

TVItem: PTreeViewItem;

SHFolder: IShellFolder;

begin

TVItem := PTreeViewItem(NodeData);

if TVItemHasExpanded then Exit;

OLECheck(TVItemParentFolderBindToObject(TVItem^Pidl

nil IID_IShellFolder Pointer(SHFolder)));

FillTreeView(SHFolder TVItem^FullPidl Node);

NodeAlphaSort;

TVItem^HasExpanded := True;

end;
end

From:http://tw.wingwit.com/Article/program/Delphi/201311/25086.html