Delphi编写windows外壳扩展

======================================================
注：本文源代码点此下载
======================================================

对于操作系统原理比较了解的朋友都会知道,一个完备的操作系统都会提供了一个外壳(shell),以方便普通的用户使用操作系统提供的各种功能。

windows(在这里指的是windows95\windows

nt4.0以上版本的操作系统)的外壳不但提供了方便美观的gui图形界面,而且还提供了强大的外壳扩展功能,大家可能在很多软件中看到这些外壳扩展了。

例如在你的系统中安装了winzip的话,当你在windows

explore中鼠标右键点击文件夹或者文件后,在弹出菜单中就会出现winzip的压缩菜单。又或者bullet

ftp中在windows资源管理器中出现的ftp站点文件夹。

windows支持七种类型的外壳扩展(称为handler),它们相应的作用简述如下:

(1)contextmenuhandlers:向特定类型的文件对象增添上下文相关菜单;

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

(3)iconhandlers用来向某个文件对象提供一个特有的图标,也可以给某一类文件对象指定图标;

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

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

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

增加copy-hookhandlers,可以允许或者禁止其中的某些操作;

(6)droptargethandlers在一个对象被拖放到另一个对象上时,就会被系统被调用;

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

windows的所有外壳扩展都是基于com(componentobjectmodel)

组件模型的,外壳是通过接口(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菜单中选择registeractivexserver来注册。

下面首先介绍一个比较常用的外壳扩展应用:上下文相关菜单,在windows中,用鼠标右键单击文件或者文件夹时弹出的那个菜单便称为上下文相关菜单。

要动态地在上下文相关菜单中增添菜单项,可以通过写contextmenu

handler来实现。比如大家所熟悉的winzip和ultraedit等软件都是通过编写contextmenu

handler来动态地向菜单中增添菜单项的。如果系统中安装了winzip,那么当用右键单击一个名为windows的文件(夹)时,其上下文相关菜单

就会有一个名为addtowindows.zip的菜单项。

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

编写contextmenu

handler必须实现ishellextinit、icontextmenu和tcomobjectfactory三个接口。

ishellextinit实现接口的初始化,icontextmenu接口对象实现上下文相关菜单,icomobjectfactory接口实现对象的

创建。

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

然后点击菜单的file|new项,在newitem窗口中选择unit建立一个unit文件,点击点击菜单的

file|new项,在newitem窗口中选择form建立一个新的窗口。将将工程文件保存为contextmenu.dpr

,将unit1保存为contextmenuhandle.pas,将form保存为opwindow.pas。

contextmenu.dpr的程序清单如下:

librarycontextmenu;

uses

comserv,

contextmenuhandlein'contextmenuhandle.pas',

opwindowin'opwindow.pas'{form2};

exports

dllgetclassobject,

dllcanunloadnow,

dllregisterserver,

dllunregisterserver;

{$r*.tlb}

{$r*.res}

begin

end.

contextmenuhandle的程序清单如下:

unitcontextmenuhandle;

interface

useswindows,activex,comobj,shlobj,classes;

type

tcontextmenu=class(tcomobject,ishellextinit,icontextmenu)

private

ffilename:array[0..max_path]ofchar;

protected

functionishellextinit.initialize=seiinitialize;//avoidcompilerwarning

functionseiinitialize(pidlfolder:pitemidlist;lpdobj:idataobject;

hkeyprogid:hkey):hresult;stdcall;

functionquerycontextmenu(menu:hmenu;indexmenu,idcmdfirst,idcmdlast,

uflags:uint):hresult;stdcall;

functioninvokecommand(varlpici:tcminvokecommandinfo):hresult;stdcall;

functiongetcommandstring(idcmd,utype:uint;pwreserved:puint;

pszname:lpstr;cchmax:uint):hresult;stdcall;

end;

const

class_contextmenu:tguid='{19741013-c829-11d1-8233-0020af3e97a0}';

{全局唯一标识符(guid)是一个16字节(128为)的值,它唯一地标识一个接口(interface)}

var

filelist:tstringlist;

implementation

usescomserv,sysutils,shellapi,registry,unitform;

functiontcontextmenu.seiinitialize(pidlfolder:pitemidlist;lpdobj:idataobject;

hkeyprogid:hkey):hresult;

var

stgmedium:tstgmedium;

formatetc:tformatetc;

filenumber,i:integer;

begin

file://如果lpdobj等于nil,则本调用失败

if(lpdobj=nil)thenbegin

result:=e_invalidarg;

exit;

end;

file://首先初始化并清空filelist以添加文件

filelist:=tstringlist.create;

filelist.clear;

file://初始化剪贴版格式文件

withformatetcdobegin

cfformat:=cf_hdrop;

ptd:=nil;

dwaspect:=dvaspect_content;

lindex:=-1;

tymed:=tymed_hglobal;

end;

result:=lpdobj.getdata(formatetc,stgmedium);

iffailed(result)thenexit;

file://首先查询用户选中的文件的个数

filenumber:=dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);

file://循环读取,将所有用户选中的文件保存到filelist中

fori:=0tofilenumber-1dobegin

dragqueryfile(stgmedium.hglobal,i,ffilename,sizeof(ffilename));

filelist.add(ffilename);

result:=noerror;

end;

releasestgmedium(stgmedium);

end;

functiontcontextmenu.querycontextmenu(menu:hmenu;indexmenu,idcmdfirst,

idcmdlast,uflags:uint):hresult;

begin

result:=0;

if((uflagsand$0000000f)=cmf_normal)or

((uflagsandcmf_explore)0)thenbegin

//往contextmenu中加入一个菜单项,菜单项的标题为察看位图文件

insertmenu(menu,indexmenu,mf_stringormf_byposition,idcmdfirst,

pchar('文件操作'));

//返回增加菜单项的个数

result:=1;

end;

end;

functiontcontextmenu.invokecommand(varlpici:tcminvokecommandinfo):hresult;

var

frmop:tform1;

begin

//首先确定该过程是被系统而不是被一个程序所调用

if(hiword(integer(lpici.lpverb))0)then

begin

result:=e_fail;

exit;

end;

//确定传递的参数的有效性

if(loword(lpici.lpverb)0)thenbegin

result:=e_invalidarg;

exit;

end;

file://建立文件操作窗口

frmop:=tform1.create(nil);

file://将所有的文件列表添加到文件操作窗口的列表中

frmop.listbox1.items:=filelist;

result:=noerror;

end;

functiontcontextmenu.getcommandstring(idcmd,utype:uint;pwreserved:puint;

pszname:lpstr;cchmax:uint):hresult;

begin

if(idcmd=0)thenbegin

if(utype=gcs_helptext)then

{返回该菜单项的帮助信息,此帮助信息将在用户把鼠标

移动到该菜单项时出现在状态条上。}

strcopy(pszname,pchar('点击该菜单项将执行文件操作'));

result:=noerror;

end

else

result:=e_invalidarg;

end;

type

tcontextmenufactory=class(tcomobjectfactory)

public

procedureupdateregistry(register:boolean);override;

end;

proceduretcontextmenufactory.updateregistry(register:boolean);

var

classid:string;

begin

ifregisterthenbegin

inheritedupdateregistry(register);

classid:=guidtostring(class_contextmenu);

file://当注册扩展库文件时,添加库到注册表中

createregkey('*\shellex','','');

createregkey('*\shellex\contextmenuhandlers','','');

createregkey('*\shellex\contextmenuhandlers\fileopreation','',classid);

file://如果操作系统为windowsnt的话

if(win32platform=ver_platform_win32_nt)then

withtregistry.createdo

try

rootkey:=hkey_local_machine;

openkey('software\microsoft\windows\currentversion\shellextensions',true);

openkey('approved',true);

writestring(classid,'contextmenushellextension');

finally

free;

end;

end

elsebegin

deleteregkey('*\shellex\contextmenuhandlers\fileopreation');

inheritedupdateregistry(register);

end;

end;

initialization

tcontextmenufactory.create(comserver,tcontextmenu,class_contextmenu,

'','contextmenushellextension',cimultiinstance,tmapartment);

end.

在opwindow窗口中加入一个tlistbox控件和两个tbutton控件,opwindows.pas的程序清单如下:

unitopwindow;

interface

uses

windows,messages,sysutils,classes,graphics,controls,forms,dialogs,

extctrls,stdctrls,shlobj,shellapi,activex;

type

tform1=class(tform)

listbox1:tlistbox;

button1:tbutton;

button2:tbutton;

procedureformcreate(sender:tobject);

procedureformclose(sender:tobject;varaction:tcloseaction);

procedurebutton1click(sender:tobject);

procedurebutton2click(sender:tobject);

private

{privatedeclarations}

public

filelist:tstringlist;

{publicdeclarations}

end;

var

form1:tform1;

implementation

{$r*.dfm}

proceduretform1.formcreate(sender:tobject);

begin

filelist:=tstringlist.create;

button1.caption:='复制文件';

button2.caption:='移动文件';

self.show;

end;

proceduretform1.formclose(sender:tobject;varaction:tcloseaction);

begin

filelist.free;

end;

proceduretform1.button1click(sender:tobject);

var

spath:string;

fstemp:shfileopstruct;

i:integer;

begin

spath:=inputbox('文件操作','输入复制路径','c:\windows');

ifspath''thenbegin

fstemp.wnd:=self.handle;

file://设置文件操作类型

fstemp.wfunc:=fo_copy;

file://允许执行撤消操作

fstemp.fflags:=fof_allowundo;

fori:=0tolistbox1.items.count-1dobegin

file://源文件全路径名

fstemp.pfrom:=pchar(listbox1.items.strings[i]);

file://要复制到的路径

fstemp.pto:=pchar(spath);

fstemp.lpszprogresstitle:='拷贝文件';

ifshfileoperation(fstemp)0then

showmessage('文件复制失败');

end;

end;

end;

proceduretform1.button2click(sender:tobject);

var

spath:string;

fstemp:shfileopstruct;

i:integer;

begin

spath:=inputbox('文件操作','输入移动路径','c:\windows');

ifspath''thenbegin

fstemp.wnd:=self.handle;

fstemp.wfunc:=fo_move;

fstemp.fflags:=fof_allowundo;

fori:=0tolistbox1.items.count-1dobegin

fstemp.pfrom:=pchar(listbox1.items.strings[i]);

fstemp.pto:=pchar(spath);

fstemp.lpszprogresstitle:='移动文件';

ifshfileoperation(fstemp)0then

showmessage('文件复制失败');

end;

end;

end;

end.

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

使用,regsvr32.exe注册程序,然后在windows的explore

中在任意的一个或者几个文件中点击鼠标右键,在上下文菜单中就会

多一个文件操作的菜单项,点击该项,在弹出窗口的列表中会列出你所选择的所有文件的文件名,你可以选择拷贝文件按钮或者移动文件按钮执行文件操作。

======================================================
在最后，我邀请大家参加新浪APP，就是新浪免费送大家的一个空间，支持PHP+MySql，免费二级域名，免费域名绑定 这个是我邀请的地址，您通过这个链接注册即为我的好友，并获赠云豆500个，价值5元哦！短网址是http://t.cn/SXOiLh我创建的小站每天访客已经达到2000+了，每天挂广告赚50+元哦，呵呵，饭钱不愁了，\(^o^)/