用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组件，以备常用。

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
361 ChildNode.HasChildren := True;
362
363 end;
364
365 except
366
367 // 你可在此处对异常进行处理
368
369 end;
370
371 end;
372
373 procedure TForm1.FormDestroy(Sender: TObject);
374
375 var
376
377 I: Integer;
378
379 begin
380
381 try
382
383 for I := 0 to FItemList.Count-1 do
384
385 begin
386
387 DisposePIDL(PTreeViewItem(FItemList[i]).PIDL);
388
389 DisposePIDL(PTreeViewItem(FItemList[i]).FullPIDL);
390
391 end;
392
393 FItemList.Clear;
394
395 FItemList.Free;
396
397 except
398
399 end;
400
401 end;
402
403 procedure TForm1.FormCreate(Sender: TObject);
404
405 var
406
407 Folder: IShellFolder;
408
409 begin
410
411 SetTreeViewImageList;
412
413 OLECheck(SHGetDesktopFolder(Folder));
414
415 FItemList := TList.Create;
416
417 FillTreeView(Folder, nil, nil);
418
419 end;
420
421 procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
422
423 var AllowExpansion: Boolean);
424
425 var
426
427 TVItem: PTreeViewItem;
428
429 SHFolder: IShellFolder;
430
431 begin
432
433 TVItem := PTreeViewItem(Node.Data);
434
435 if TVItem.HasExpanded then Exit;
436
437 OLECheck(TVItem.ParentFolder.BindToObject(TVItem^.Pidl,
438
439 nil, IID_IShellFolder, Pointer(SHFolder)));
440
441 FillTreeView(SHFolder, TVItem^.FullPidl, Node);
442
443 Node.AlphaSort;
444
445 TVItem^.HasExpanded := True;
446
447 end;
448
449 end.
450 

转载于:https://www.cnblogs.com/Lucky2011/archive/2011/04/12/2013277.html

• 点赞
• 收藏
• 分享
• 文章举报

dinaoza6674 发布了0 篇原创文章 · 获赞 0 · 访问量 73 私信 关注