用Delphi實現Windows文件夾管理樹 摘要：本文利用Windows名空間所提供的IShellFolder接口，用Delphi實現了文件夾管理樹的生成。 關鍵字：文件夾 接口 Delphi 一、概述 Windows95/98視覺感觀上區別Windows3.1的一個重要方面就是大量採用了樹形視圖控件，資源管理器左側的文件夾管理樹便是如此，它將本地和網絡上的文件夾和文件等資源以層次樹的方式羅列出來，為用戶集中管理計算機提供了極大便利，同時在外貌上也煥然一新。Delphi為我們提供了大量Windows標準控件，但遺憾的是在目錄瀏覽方面卻只提供了一個Windows3.1樣式的DirectoryListBox（Delphi5的測試版也是如此），因此，在Delphi中實現Windows文件夾管理樹對開發更「地道」的Windows程序有著重大意義。 二、實現原理 Windows文件夾管理樹的實現實質上是對Windows名空間（Namespace）的遍歷。名空間中每個文件夾都提供了一個IShellFolder接口，遍歷名空間的方法是： 1）調用SHGetDesktopFolder函數獲得桌面文件夾的IShellFolder接口，桌面文件夾是文件夾管理樹的根節點。 2）再調用所獲得的IShellFolder接口的EnumObjects成員函數列舉出子文件夾。 3）調用IShellFolder的BindToObject成員函數獲得子文件夾的IShellFolder接口。 4）重複步驟2）、3）列舉出某文件夾下的所有子文件夾，只至所獲得的IShellFolder接口為nil為止。 下面解釋將要用到的幾個主要函數，它們在ShlObj單元中定義： 1）function SHGetDesktopFolder(var ppshf: IShellFolder): HResult; 該函數通過ppshf獲得桌面文件夾的IShellFolder接口。 2）function IShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD; out EnumIDList: IEnumIDList): HResult; 該函數獲得一個IEnumIDList接口，通過調用該接口的Next等函數可以列舉出IShellFolder接口所對應的文件夾的內容，內容的類型由grfFlags來指定。我們需要列舉出子文件夾來，因此grfFlags的值指定為SHCONTF_FOLDERS。HwndOwner是屬主窗口的句柄。 3）function IShellFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvOut: Pointer): HResult; 該函數獲得某個子文件夾的IShellFolder接口，該接口由ppvOut返回。pidl是一個指向元素標識符列表的指針，Windows95/98中用元素標識符和元素標識符列表來標識名空間中的對象，它們分別類似於文件名和路徑。需要特別指出的是：pidl作為參數傳遞給Shell API函數時，必須是相對於桌面文件夾的絕對路徑，而傳遞給IShellFolder接口的成員函數時，則應是相對於該接口所對應文件夾的相對路徑。pbcReserved應指定為nil，riid則應指定為IID_IShellFolder。 其它函數可以查閱Delphi提供的《Win32 Programmer's Reference》。 三、程序清單 下面的源代碼在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.
風花雪月 e夢情緣
發表時間：2003-05-11 11:37:54
IP:61.155.xxx.xxx 未訂閱
