Delphi编写windows外壳扩展

对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供了一个外壳（shell），以方便普通的用户使用操作系统提供的各种功能。 windows（在这里指的是windows 95\windows nt4.0以上版本的操作系统）的外壳不但提供了方便美观的gui图形界面，而且还提供了强大的外壳扩展功能，大家可能在很多软件中看到这些外壳扩展了。 例如在你的系统中安装了winzip的话，当你在windows explore中鼠标右键点击文件夹或者文件后，在弹出菜单中就会出现winzip的压缩菜单。又或者bullet ftp中在windows资源管理器中出现的ftp站点文件夹。

windows支持七种类型的外壳扩展（称为handler），它们相应的作用简述如下：

　　(1)context menu handlers：向特定类型的文件对象增添上下文相关菜单；

　　(2)drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的ole数据传输；

　　(3)icon handlers用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；

　　(4)property sheet handlers给文件对象增添属性页（就是右键点击文件对象或文件夹对象后，在弹出菜单中选属性

项后出现的对话框），属性页可以为同一类文件对象所共有，也可以给一个文件对象指定特有的属性页；

　　(5)copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，通过为windows

增加copy-hook handlers，可以允许或者禁止其中的某些操作；

　　(6)drop target handlers在一个对象被拖放到另一个对象上时，就会被系统被调用；

　　(7)data object handlers在文件被拖放、拷贝或者粘贴时，就会被系统被调用。

　　windows的所有外壳扩展都是基于com(component object model) 组件模型的，外壳是通过接口(interface)来访问对象的。 外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。因此，如果要对windows 的用户界面进行扩充的话，则具备写com对象的一些知识是十分必要的。 由于篇幅所限，在这里就不介绍com，读者可以参考微软的msdn库或者相关的帮助文档，一个接口可以看做是一个特殊的类，它包含一组函数合过程可以用来 操作一个对象。

　　写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在windows注册表的 hkey_classes_root\clsid键之下进行注册。在该键下面可以找到许多名字像{0000002f-0000-0000- c000-000000000046}的键，这类键就是全局唯一类标识符(guid)。每一个外壳扩展都必须有一个全局唯一类标识符，windows正是 通过此唯一类标识符来找到外壳扩展处理程序的。

在类标识符之下的inprocserver32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在

相 应类型的shellex主键下。如果所处的windows操作系统为windows nt，则外壳扩展还必须在注册表中的hkey_local_machine\software\microsoft\windows \currentversion\shellextensions\approved主键下登记。

编译完外壳扩展的dll程序后就可以用windows本身提供的regsvr32.exe来注册该dll服务器程序了。如果使用delphi，也可

以在run菜单中选择register activex server来注册。

　 　下面首先介绍一个比较常用的外壳扩展应用：上下文相关菜单，在windows中，用鼠标右键单击文件或者文件夹时弹出的那个菜单便称为上下文相关菜单。 要动态地在上下文相关菜单中增添菜单项，可以通过写context menu handler来实现。比如大家所熟悉的winzip和ultraedit等软件都是通过编写context menu handler来动态地向菜单中增添菜单项的。如果系统中安装了winzip，那么当用右键单击一个名为windows的文件（夹）时，其上下文相关菜单 就会有一个名为add to windows.zip的菜单项。

　　本文要实现的context menu handler与winzip提供的上下文菜单相似。它将在任意类型的文件对象的上下文相关菜单中添加一个文件操作菜单项，当点击该项后，接口程序就会弹出一个文件操作窗口，执行文件拷贝、移动等操作。

　 　编写context menu handler必须实现ishellextinit、icontextmenu和tcomobjectfactory三个接口。 ishellextinit实现接口的初始化，icontextmenu接口对象实现上下文相关菜单，icomobjectfactory接口实现对象的 创建。

　　下面来介绍具体的程序实现。首先在delphi中点击菜单的 file|new 项，在new item窗口中选择dll建立一个dll工程文件。

然后点击菜单的 file|new 项，在new item窗口中选择unit建立一个unit文件，点击点击菜单的 file|new 项，在new item窗口中选择form建立一个新的窗口。将将工程文件保存为contextmenu.dpr ，将unit1保存为contextmenuhandle.pas，将form保存为 opwindow.pas。

contextmenu.dpr的程序清单如下：

1. library contextmenu;
2. uses
3. comserv,
4. contextmenuhandle in 'contextmenuhandle.pas',
5. opwindow in 'opwindow.pas' {form2};
6. exports
7. dllgetclassobject,
8. dllcanunloadnow,
9. dllregisterserver,
10. dllunregisterserver;
11. {$r *.tlb}
12. {$r *.res}
13. begin
14. end.
15. contextmenuhandle的程序清单如下：
16. unit contextmenuhandle;
17. interface
18. uses windows,activex,comobj,shlobj,classes;
19. type
20. tcontextmenu = class(tcomobject,ishellextinit,icontextmenu)
21. private
22. ffilename: array[0..max_path] of char;
23. protected
24. function ishellextinit.initialize = seiinitialize; // avoid compiler warning
25. function seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
26. hkeyprogid: hkey): hresult; stdcall;
27. function querycontextmenu(menu: hmenu; indexmenu, idcmdfirst, idcmdlast,
28. uflags: uint): hresult; stdcall;
29. function invokecommand(var lpici: tcminvokecommandinfo): hresult; stdcall;
30. function getcommandstring(idcmd, utype: uint; pwreserved: puint;
31. pszname: lpstr; cchmax: uint): hresult; stdcall;
32. end;
33. const
34. class_contextmenu: tguid = '{19741013-c829-11d1-8233-0020af3e97a0}';
35. {全局唯一标识符(guid)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}
36. var
37. filelist:tstringlist;
38. implementation
39. uses comserv, sysutils, shellapi, registry,unitform;
40. function tcontextmenu.seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
41. hkeyprogid: hkey): hresult;
42. var
43. stgmedium: tstgmedium;
44. formatetc: tformatetc;
45. filenumber,i:integer;
46. begin
47. file://如果lpdobj等于nil，则本调用失败
48. if (lpdobj = nil) then begin
49. result := e_invalidarg;
50. exit;
51. end;
52. file://首先初始化并清空filelist以添加文件
53. filelist:=tstringlist.create;
54. filelist.clear;
55. file://初始化剪贴版格式文件
56. with formatetc do begin
57. cfformat := cf_hdrop;
58. ptd := nil;
59. dwaspect := dvaspect_content;
60. lindex := -1;
61. tymed := tymed_hglobal;
62. end;
63. result := lpdobj.getdata(formatetc, stgmedium);
64. if failed(result) then exit;
65. file://首先查询用户选中的文件的个数
66. filenumber := dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);
67. file://循环读取，将所有用户选中的文件保存到filelist中
68. for i:=0 to filenumber-1 do begin
69. dragqueryfile(stgmedium.hglobal, i, ffilename, sizeof(ffilename));
70. filelist.add(ffilename);
71. result := noerror;
72. end;
73. releasestgmedium(stgmedium);
74. end;
75. function tcontextmenu.querycontextmenu(menu: hmenu; indexmenu, idcmdfirst,
76. idcmdlast, uflags: uint): hresult;
77. begin
78. result := 0;
79. if ((uflags and $0000000f) = cmf_normal) or
80. ((uflags and cmf_explore) <> 0) then begin
81. // 往context menu中加入一个菜单项 ,菜单项的标题为察看位图文件
82. insertmenu(menu, indexmenu, mf_string or mf_byposition, idcmdfirst,
83. pchar('文件操作'));
84. // 返回增加菜单项的个数
85. result := 1;
86. end;
87. end;
88. function tcontextmenu.invokecommand(var lpici: tcminvokecommandinfo): hresult;
89. var
90. frmop:tform1;
91. begin
92. // 首先确定该过程是被系统而不是被一个程序所调用
93. if (hiword(integer(lpici.lpverb)) <> 0) then
94. begin
95. result := e_fail;
96. exit;
97. end;
98. // 确定传递的参数的有效性
99. if (loword(lpici.lpverb) <> 0) then begin
100. result := e_invalidarg;
101. exit;
102. end;
103. file://建立文件操作窗口
104. frmop:=tform1.create(nil);
105. file://将所有的文件列表添加到文件操作窗口的列表中
106. frmop.listbox1.items := filelist;
107. result := noerror;
108. end;
109. function tcontextmenu.getcommandstring(idcmd, utype: uint; pwreserved: puint;
110. pszname: lpstr; cchmax: uint): hresult;
111. begin
112. if (idcmd = 0) then begin
113. if (utype = gcs_helptext) then
114. {返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
115. 移动到该菜单项时出现在状态条上。}
116. strcopy(pszname, pchar('点击该菜单项将执行文件操作'));
117. result := noerror;
118. end
119. else
120. result := e_invalidarg;
121. end;
122. type
123. tcontextmenufactory = class(tcomobjectfactory)
124. public
125. procedure updateregistry(register: boolean); override;
126. end;
127. procedure tcontextmenufactory.updateregistry(register: boolean);
128. var
129. classid: string;
130. begin
131. if register then begin
132. inherited updateregistry(register);
133. classid := guidtostring(class_contextmenu);
134. file://当注册扩展库文件时，添加库到注册表中
135. createregkey('*\shellex', '', '');
136. createregkey('*\shellex\contextmenuhandlers', '', '');
137. createregkey('*\shellex\contextmenuhandlers\fileopreation', '', classid);
138. file://如果操作系统为windows nt的话
139. if (win32platform = ver_platform_win32_nt) then
140. with tregistry.create do
141. try
142. rootkey := hkey_local_machine;
143. openkey('software\microsoft\windows\currentversion\shell extensions', true);
144. openkey('approved', true);
145. writestring(classid, 'context menu shell extension');
146. finally
147. free;
148. end;
149. end
150. else begin
151. deleteregkey('*\shellex\contextmenuhandlers\fileopreation');
152. inherited updateregistry(register);
153. end;
154. end;
155. initialization
156. tcontextmenufactory.create(comserver, tcontextmenu, class_contextmenu,
157. '', 'context menu shell extension', cimultiinstance,tmapartment);
158. end.
159. 在opwindow窗口中加入一个tlistbox控件和两个tbutton控件，opwindows.pas的程序清单如下：
160. unit opwindow;
161. interface
162. uses
163. windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
164. extctrls, stdctrls,shlobj,shellapi,activex;
165. type
166. tform1 = class(tform)
167. listbox1: tlistbox;
168. button1: tbutton;
169. button2: tbutton;
170. procedure formcreate(sender: tobject);
171. procedure formclose(sender: tobject; var action: tcloseaction);
172. procedure button1click(sender: tobject);
173. procedure button2click(sender: tobject);
174. private
175. { private declarations }
176. public
177. filelist:tstringlist;
178. { public declarations }
179. end;
180. var
181. form1: tform1;
182. implementation
183. {$r *.dfm}
184. procedure tform1.formcreate(sender: tobject);
185. begin
186. filelist:=tstringlist.create;
187. button1.caption :='复制文件';
188. button2.caption :='移动文件';
189. self.show;
190. end;
191. procedure tform1.formclose(sender: tobject; var action: tcloseaction);
192. begin
193. filelist.free;
194. end;
195. procedure tform1.button1click(sender: tobject);
196. var
197. spath:string;
198. fstemp:shfileopstruct;
199. i:integer;
200. begin
201. spath:=inputbox('文件操作','输入复制路径','c:\windows');
202. if spath<>''then begin
203. fstemp.wnd := self.handle;
204. file://设置文件操作类型
205. fstemp.wfunc :=fo_copy;
206. file://允许执行撤消操作
207. fstemp.fflags :=fof_allowundo;
208. for i:=0 to listbox1.items.count-1 do begin
209. file://源文件全路径名
210. fstemp.pfrom := pchar(listbox1.items.strings[i]);
211. file://要复制到的路径
212. fstemp.pto := pchar(spath);
213. fstemp.lpszprogresstitle:='拷贝文件';
214. if shfileoperation(fstemp)<>0 then
215. showmessage('文件复制失败');
216. end;
217. end;
218. end;
219. procedure tform1.button2click(sender: tobject);
220. var
221. spath:string;
222. fstemp:shfileopstruct;
223. i:integer;
224. begin
225. spath:=inputbox('文件操作','输入移动路径','c:\windows');
226. if spath<>''then begin
227. fstemp.wnd := self.handle;
228. fstemp.wfunc :=fo_move;
229. fstemp.fflags :=fof_allowundo;
230. for i:=0 to listbox1.items.count-1 do begin
231. fstemp.pfrom := pchar(listbox1.items.strings[i]);
232. fstemp.pto := pchar(spath);
233. fstemp.lpszprogresstitle:='移动文件';
234. if shfileoperation(fstemp)<>0 then
235. showmessage('文件复制失败');
236. end;
237. end;
238. end;
239. end.

点击菜单的 project | build contextmenu 项，delphi就会建立contextmenu.dll文件，这个就是上下文相关菜单程序了。

使用，regsvr32.exe 注册程序，然后在windows的explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会 多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者移动文件按钮执行文件操作。