• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

用Delphi实现Windows文件夹管理树

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

摘要：本文利用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  
                       
                    
                    
 
                      





鲜花




握手




雷人




路过




鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
Matlab各种拟合发布时间：2022-07-18
下一篇：
MATLAB 画直线 - 1130136248发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap