摘要:本文利用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组件,以备常用。
1 unit BrowseTreeView; 2 3 interface 4 5 uses 6 7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 8 9 ShlObj, ComCtrls; 10 11 type 12 13 PTreeViewItem = ^TTreeViewItem; 14 15 TTreeViewItem = record 16 17 ParentFolder: IShellFolder; // 接点对应的文件夹的父文件夹的IShellFolder接口 18 19 Pidl, FullPidl: PItemIDList; // 接点对应的文件夹的相对和绝对项目标识符列表 20 21 HasExpanded: Boolean; // 接点是否展开 22 23 end;
图1 程序运行结果
1 TForm1 = class(TForm) 2 3 TreeView1: TTreeView; 4 5 procedure FormDestroy(Sender: TObject); 6 7 procedure FormCreate(Sender: TObject); 8 9 procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode; 10 11 var AllowExpansion: Boolean); 12 13 private 14 15 FItemList: TList; 16 17 procedure SetTreeViewImageList; 18 19 procedure FillTreeView(Folder: IShellFolder; FullPIDL: PItemIDList; ParentNode: TTreeNode); 20 21 end; 22 23 var 24 25 Form1: TForm1; 26 27 implementation 28 29 {$R *.DFM} 30 31 uses 32 33 ActiveX, ComObj, ShellAPI, CommCtrl; 34 35 // 以下是几个对项目标识符进行操作的函数 36 37 procedure DisposePIDL(ID: PItemIDList); 38 39 var 40 41 Malloc: IMalloc; 42 43 begin 44 45 if ID = nil then Exit; 46 47 OLECheck(SHGetMalloc(Malloc)); 48 49 Malloc.Free(ID); 50 51 end; 52 53 function CopyItemID(ID: PItemIDList): PItemIDList; 54 55 var 56 57 Malloc: IMalloc; 58 59 begin 60 61 Result := nil; 62 63 OLECheck(SHGetMalloc(Malloc)); 64 65 if Assigned(ID) then 66 67 begin 68 69 Result := Malloc.Alloc(ID^.mkid.cb + sizeof(ID^.mkid.cb)); 70 71 CopyMemory(Result, ID, ID^.mkid.cb + sizeof(ID^.mkid.cb)); 72 73 end; 74 75 end; 76 77 function NextPIDL(ID: PItemIDList): PItemIDList; 78 79 begin 80 81 Result := ID; 82 83 Inc(PChar(Result), ID^.mkid.cb); 84 85 end; 86 87 function GetPIDLSize(ID: PItemIDList): Integer; 88 89 begin 90 91 Result := 0; 92 93 if Assigned(ID) then 94 95 begin 96 97 Result := sizeof(ID^.mkid.cb); 98 99 while ID^.mkid.cb <> 0 do 100 101 begin 102 103 Inc(Result, ID^.mkid.cb); 104 105 ID := NextPIDL(ID); 106 107 end; 108 109 end; 110 111 end; 112 113 function CreatePIDL(Size: Integer): PItemIDList; 114 115 var 116 117 Malloc: IMalloc; 118 119 HR: HResult; 120 121 begin 122 123 Result := nil; 124 125 HR := SHGetMalloc(Malloc); 126 127 if Failed(HR) then Exit; 128 129 try 130 131 Result := Malloc.Alloc(Size); 132 133 if Assigned(Result) then 134 135 FillChar(Result^, Size, 0); 136 137 finally 138 139 end; 140 141 end; 142 143 function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList; 144 145 var 146 147 cb1, cb2: Integer; 148 149 begin 150 151 if Assigned(ID1) then 152 153 cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb) 154 155 else 156 157 cb1 := 0; 158 159 cb2 := GetPIDLSize(ID2); 160 161 Result := CreatePIDL(cb1 + cb2); 162 163 if Assigned(Result) then 164 165 begin 166 167 if Assigned(ID1) then 168 169 CopyMemory(Result, ID1, cb1); 170 171 172 173 CopyMemory(PChar(Result) + cb1, ID2, cb2); 174 175 end; 176 177 end; 178 179 // 将二进制表示的项目标识符列表转换成有可识的项目名 180 181 function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList; 182 183 ForParsing: Boolean): String; 184 185 var 186 187 StrRet: TStrRet; 188 189 P: PChar; 190 191 Flags: Integer; 192 193 begin 194 195 Result := ''; 196 197 if ForParsing then 198 199 Flags := SHGDN_FORPARSING 200 201 else 202 203 Flags := SHGDN_NORMAL; 204 205 Folder.GetDisplayNameOf(PIDL, Flags, StrRet); 206 207 case StrRet.uType of 208 209 STRRET_CSTR: 210 211 SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); 212 213 STRRET_OFFSET: 214 215 begin 216 217 P := @PIDL.mkid.abID[StrRet.uOffset - sizeof(PIDL.mkid.cb)]; 218 219 SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); 220 221 end; 222 223 STRRET_WSTR: 224 225 Result := StrRet.pOleStr; 226 227 end; 228 229 end; 230 231 function GetIcon(PIDL: PItemIDList; Open: Boolean): Integer; 232 233 const 234 235 IconFlag = SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON; 236 237 var 238 239 FileInfo: TSHFileInfo; 240 241 Flags: Integer; 242 243 begin 244 245 if Open then 246 247 Flags := IconFlag or SHGFI_OPENICON 248 249 else 250 251 Flags := IconFlag; 252 253 254 255 SHGetFileInfo(PChar(PIDL), 0, FileInfo, sizeof(TSHFileInfo), Flags); 256 257 Result := FileInfo.iIcon; 258 259 end; 260 261 // 获得每个文件夹在系统中的图标 262 263 procedure GetItemIcons(FullPIDL: PItemIDList; TreeNode: TTreeNode); 264 265 begin 266 267 with TreeNode do 268 269 begin 270 271 ImageIndex := GetIcon(FullPIDL, False); 272 273 SelectedIndex := GetIcon(FullPIDL, True); 274 275 end; 276 277 end; 278 279 // 获得系统的图标列表 280 281 procedure TForm1.SetTreeViewImageList; 282 283 var 284 285 ImageList: THandle; 286 287 FileInfo: TSHFileInfo; 288 289 begin 290 291 ImageList := SHGetFileInfo(PChar('C:\'), 0, FileInfo, 292 293 sizeof(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); 294 295 if ImageList <> 0 then 296 297 TreeView_SetImageList(TreeView1.Handle, ImageList, 0); 298 299 end; 300 301 // 生成文件夹管理树 302 303 procedure TForm1.FillTreeView(Folder: IShellFolder; 304 305 FullPIDL: PItemIDList; ParentNode: TTreeNode); 306 307 var 308 309 TreeViewItem: PTreeViewItem; 310 311 EnumIDList: IEnumIDList; 312 313 PIDLs, FullItemPIDL: PItemIDList; 314 315 NumID: LongWord; 316 317 ChildNode: TTreeNode; 318 319 Attr: Cardinal; 320 321 begin 322 323 try 324 325 OLECheck(Folder.EnumObjects(Handle, SHCONTF_FOLDERS, EnumIDList)); 326 327 while EnumIDList.Next(1, PIDLs, NumID) = S_OK do 328 329 begin 330 331 FullItemPIDL := ConcatPIDLs(FullPIDL, PIDLs); 332 333 TreeViewItem := New(PTreeViewItem); 334 335 TreeViewItem.ParentFolder := Folder; 336 337 TreeViewItem.Pidl := CopyItemID(PIDLs); 338 339 TreeViewItem.FullPidl := FullItemPIDL; 340 341 TreeViewItem.HasExpanded := False; 342 343 FItemList.Add(TreeViewItem); 344 345 ChildNode := TreeView1.Items.AddChildObject(ParentNode, 346 347 GetDisplayName(Folder, PIDLs, False), TreeViewItem); 348 349 GetItemIcons(FullItemPIDL, ChildNode); 350 351 Attr := SFGAO_HASSUBFOLDER or SFGAO_FOLDER; 352 353 Folder.GetAttributesOf(1, PIDLs, Attr); 354 355 if Bool(Attr and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) then 356 357 if Bool(Attr and SFGAO_FOLDER) then 358 359 if Bool(Attr and SFGAO_HASSUBFOLDER) then 360
-
六六分期app的软件客服如何联系?不知道吗?加qq群【895510560】即可!标题:六六分期
阅读:18275|2023-10-27
-
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题,可能很多用户都不知
阅读:9677|2022-11-06
-
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置,可能很多用户都不知道
阅读:8179|2022-11-06
-
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法,想必大家都遇到过需要
阅读:8549|2022-11-06
-
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置,可能很多
阅读:8457|2022-11-06
-
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题,可能很多用户都不
阅读:9393|2022-11-06
-
电脑对日常生活的重要性小编就不多说了,可是一旦碰到win7系统设置cf烟雾头的问题,很
阅读:8430|2022-11-06
-
我们在日常使用电脑的时候,有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
阅读:7865|2022-11-06
-
今天小编告诉大家如何对win7系统打开vcf文件进行设置,可能很多用户都不知道怎么对win
阅读:8415|2022-11-06
-
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置,可能很多用户都不知道怎
阅读:7394|2022-11-06
|
请发表评论