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

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



转载于:https://www.cnblogs.com/Lucky2011/archive/2011/04/13/2014638.html

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

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