|
摘要：本文利用Windows名空間所提供的IShellFolder接口，用Delphi實(shí)現(xiàn)了文件夾管理樹(shù)的生成。
關(guān)鍵字：文件夾 接口 Delphi
一、概述
Windows95/98視覺(jué)感觀上區(qū)別Windows3.1的一個(gè)重要方面就是大量采用了樹(shù)形視圖控件，資源管理器左側(cè)的文件夾管理樹(shù)便是如此，它將本地和網(wǎng)絡(luò)上的文件夾和文件等資源以層次樹(shù)的方式羅列出來(lái)，為用戶(hù)集中管理計(jì)算機(jī)提供了極大便利，同時(shí)在外貌上也煥然一新。Delphi為我們提供了大量Windows標(biāo)準(zhǔn)控件，但遺憾的是在目錄瀏覽方面卻只提供了一個(gè)Windows3.1樣式的DirectoryListBox（Delphi5的測(cè)試版也是如此），因此，在Delphi中實(shí)現(xiàn)Windows文件夾管理樹(shù)對(duì)開(kāi)發(fā)更“地道”的Windows程序有著重大意義。
二、實(shí)現(xiàn)原理
Windows文件夾管理樹(shù)的實(shí)現(xiàn)實(shí)質(zhì)上是對(duì)Windows名空間（Namespace）的遍歷。名空間中每個(gè)文件夾都提供了一個(gè)IShellFolder接口，遍歷名空間的方法是：
1）調(diào)用SHGetDesktopFolder函數(shù)獲得桌面文件夾的IShellFolder接口，桌面文件夾是文件夾管理樹(shù)的根節(jié)點(diǎn)。
2）再調(diào)用所獲得的IShellFolder接口的EnumObjects成員函數(shù)列舉出子文件夾。
3）調(diào)用IShellFolder的BindToObject成員函數(shù)獲得子文件夾的IShellFolder接口。 4）重復(fù)步驟2）、3）列舉出某文件夾下的所有子文件夾，只至所獲得的IShellFolder接口為nil為止。
下面解釋將要用到的幾個(gè)主要函數(shù)，它們?cè)赟hlObj單元中定義：
1）function SHGetDesktopFolder(var ppshf: IShellFolder): HResult;
該函數(shù)通過(guò)ppshf獲得桌面文件夾的IShellFolder接口。
2）function IShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD;
out EnumIDList: IEnumIDList): HResult;
該函數(shù)獲得一個(gè)IEnumIDList接口，通過(guò)調(diào)用該接口的Next等函數(shù)可以列舉出IShellFolder接口所對(duì)應(yīng)的文件夾的內(nèi)容，內(nèi)容的類(lèi)型由grfFlags來(lái)指定。我們需要列舉出子文件夾來(lái)，因此grfFlags的值指定為SHCONTF_FOLDERS。HwndOwner是屬主窗口的句柄。
3）function IShellFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer;
const riid: TIID; out ppvOut: Pointer): HResult;
該函數(shù)獲得某個(gè)子文件夾的IShellFolder接口，該接口由ppvOut返回。pidl是一個(gè)指向元素標(biāo)識(shí)符列表的指針，Windows95/98中用元素標(biāo)識(shí)符和元素標(biāo)識(shí)符列表來(lái)標(biāo)識(shí)名空間中的對(duì)象，它們分別類(lèi)似于文件名和路徑。需要特別指出的是：pidl作為參數(shù)傳遞給Shell API函數(shù)時(shí)，必須是相對(duì)于桌面文件夾的絕對(duì)路徑，而傳遞給IShellFolder接口的成員函數(shù)時(shí)，則應(yīng)是相對(duì)于該接口所對(duì)應(yīng)文件夾的相對(duì)路徑。pbcReserved應(yīng)指定為nil，riid則應(yīng)指定為IID_IShellFolder。
其它函數(shù)可以查閱Delphi提供的《Win32 Programmer's Reference》。
三、程序清單
下面的源代碼在Windows98中實(shí)現(xiàn)，并在Windows2000測(cè)試版中測(cè)試無(wú)誤(程序運(yùn)行結(jié)果如圖1所示)，有興趣的讀者可以將其改寫(xiě)成Delphi組件，以備常用。
unit BrowseTreeView;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShlObj, ComCtrls;
type
PTreeViewItem = ^TTreeViewItem;
TTreeViewItem = record
ParentFolder: IShellFolder; // 接點(diǎn)對(duì)應(yīng)的文件夾的父文件夾的IShellFolder接口
Pidl, FullPidl: PItemIDList; // 接點(diǎn)對(duì)應(yīng)的文件夾的相對(duì)和絕對(duì)項(xiàng)目標(biāo)識(shí)符列表
HasExpanded: Boolean; // 接點(diǎn)是否展開(kāi)
end;
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;
// 以下是幾個(gè)對(duì)項(xiàng)目標(biāo)識(shí)符進(jìn)行操作的函數(shù)
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;
// 將二進(jìn)制表示的項(xiàng)目標(biāo)識(shí)符列表轉(zhuǎn)換成有可識(shí)的項(xiàng)目名
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;
// 獲得每個(gè)文件夾在系統(tǒng)中的圖標(biāo)
procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode);
begin
with TreeNode do
begin
ImageIndex := GetIcon(FullPIDL, False);
SelectedIndex := GetIcon(FullPIDL, True);
end;
end;
// 獲得系統(tǒng)的圖標(biāo)列表
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;
// 生成文件夾管理樹(shù)
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
// 你可在此處對(duì)異常進(jìn)行處理
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.
|
