|
摘要：本文利用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】即可！标题：六六分期
阅读：19112|2023-10-27
-
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
阅读：9967|2022-11-06
-
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
阅读：8315|2022-11-06
-
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
阅读：8684|2022-11-06
-
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
阅读：8625|2022-11-06
-
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
阅读：9641|2022-11-06
-
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
阅读：8609|2022-11-06
-
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
阅读：7989|2022-11-06
-
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
阅读：8637|2022-11-06
-
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
阅读：7526|2022-11-06
| 
客服电话
APP下载
官方微信
请发表评论