老兄，陈省的书《DELPHI深入探索》还是看看吧，
不是是晓不起人家：）
我这里有一点东西，如下
利用delphi编写windows外壳扩展： 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的程序清单如下：
library contextmenu;
uses
comserv,
contextmenuhandle in 'contextmenuhandle.pas',
opwindow in 'opwindow.pas' {form2};exports
dllgetclassobject,
dllcanunloadnow,
dllregisterserver,
dllunregisterserver;{$r *.tlb}{$r *.res}beginend. contextmenuhandle的程序清单如下：
unit contextmenuhandle;interface
uses windows,activex,comobj,shlobj,classes;type
tcontextmenu = class(tcomobject,ishellextinit,icontextmenu)
private
ffilename: array[0..max_path] of char;
protected
function ishellextinit.initialize = seiinitialize; // avoid compiler warning
function seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult; stdcall;
function querycontextmenu(menu: hmenu; indexmenu, idcmdfirst, idcmdlast,
uflags: uint): hresult; stdcall;
function invokecommand(var lpici: tcminvokecommandinfo): hresult; stdcall;
function getcommandstring(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;
implementationuses comserv, sysutils, shellapi, registry,unitform;function tcontextmenu.seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult;
var
stgmedium: tstgmedium;
formatetc: tformatetc;
filenumber,i:integer;
begin
file://如果lpdobj等于nil，则本调用失败
if (lpdobj = nil) then begin
result := e_invalidarg;
exit;
end; file://首先初始化并清空filelist以添加文件
filelist:=tstringlist.create;
filelist.clear;
file://初始化剪贴版格式文件
with formatetc do begin
cfformat := cf_hdrop;
ptd := nil;
dwaspect := dvaspect_content;
lindex := -1;
tymed := tymed_hglobal;
end;
result := lpdobj.getdata(formatetc, stgmedium); if failed(result) then exit; file://首先查询用户选中的文件的个数
filenumber := dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);
file://循环读取，将所有用户选中的文件保存到filelist中
for i:=0 to filenumber-1 do begin
dragqueryfile(stgmedium.hglobal, i, ffilename, sizeof(ffilename));
filelist.add(ffilename);
result := noerror;
end; releasestgmedium(stgmedium);
end;function tcontextmenu.querycontextmenu(menu: hmenu; indexmenu, idcmdfirst,
idcmdlast, uflags: uint): hresult;
begin
result := 0;
if ((uflags and $0000000f) = cmf_normal) or
((uflags and cmf_explore) <> 0) then begin
// 往context menu中加入一个菜单项 ,菜单项的标题为察看位图文件
insertmenu(menu, indexmenu, mf_string or mf_byposition, idcmdfirst,
pchar('文件操作'));
// 返回增加菜单项的个数
result := 1;
end;
end;
不是是晓不起人家：）
我这里有一点东西，如下
利用delphi编写windows外壳扩展： 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的程序清单如下：
library contextmenu;
uses
comserv,
contextmenuhandle in 'contextmenuhandle.pas',
opwindow in 'opwindow.pas' {form2};exports
dllgetclassobject,
dllcanunloadnow,
dllregisterserver,
dllunregisterserver;{$r *.tlb}{$r *.res}beginend. contextmenuhandle的程序清单如下：
unit contextmenuhandle;interface
uses windows,activex,comobj,shlobj,classes;type
tcontextmenu = class(tcomobject,ishellextinit,icontextmenu)
private
ffilename: array[0..max_path] of char;
protected
function ishellextinit.initialize = seiinitialize; // avoid compiler warning
function seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult; stdcall;
function querycontextmenu(menu: hmenu; indexmenu, idcmdfirst, idcmdlast,
uflags: uint): hresult; stdcall;
function invokecommand(var lpici: tcminvokecommandinfo): hresult; stdcall;
function getcommandstring(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;
implementationuses comserv, sysutils, shellapi, registry,unitform;function tcontextmenu.seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult;
var
stgmedium: tstgmedium;
formatetc: tformatetc;
filenumber,i:integer;
begin
file://如果lpdobj等于nil，则本调用失败
if (lpdobj = nil) then begin
result := e_invalidarg;
exit;
end; file://首先初始化并清空filelist以添加文件
filelist:=tstringlist.create;
filelist.clear;
file://初始化剪贴版格式文件
with formatetc do begin
cfformat := cf_hdrop;
ptd := nil;
dwaspect := dvaspect_content;
lindex := -1;
tymed := tymed_hglobal;
end;
result := lpdobj.getdata(formatetc, stgmedium); if failed(result) then exit; file://首先查询用户选中的文件的个数
filenumber := dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);
file://循环读取，将所有用户选中的文件保存到filelist中
for i:=0 to filenumber-1 do begin
dragqueryfile(stgmedium.hglobal, i, ffilename, sizeof(ffilename));
filelist.add(ffilename);
result := noerror;
end; releasestgmedium(stgmedium);
end;function tcontextmenu.querycontextmenu(menu: hmenu; indexmenu, idcmdfirst,
idcmdlast, uflags: uint): hresult;
begin
result := 0;
if ((uflags and $0000000f) = cmf_normal) or
((uflags and cmf_explore) <> 0) then begin
// 往context menu中加入一个菜单项 ,菜单项的标题为察看位图文件
insertmenu(menu, indexmenu, mf_string or mf_byposition, idcmdfirst,
pchar('文件操作'));
// 返回增加菜单项的个数
result := 1;
end;
end;
var
frmop:tform1;
begin
// 首先确定该过程是被系统而不是被一个程序所调用
if (hiword(integer(lpici.lpverb)) <> 0) then
begin
result := e_fail;
exit;
end;
// 确定传递的参数的有效性
if (loword(lpici.lpverb) <> 0) then begin
result := e_invalidarg;
exit;
end; file://建立文件操作窗口
frmop:=tform1.create(nil);
file://将所有的文件列表添加到文件操作窗口的列表中
frmop.listbox1.items := filelist;
result := noerror;
end;
function tcontextmenu.getcommandstring(idcmd, utype: uint; pwreserved: puint;
pszname: lpstr; cchmax: uint): hresult;
begin
if (idcmd = 0) then begin
if (utype = gcs_helptext) then
{返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
移动到该菜单项时出现在状态条上。}
strcopy(pszname, pchar('点击该菜单项将执行文件操作'));
result := noerror;
end
else
result := e_invalidarg;
end;type
tcontextmenufactory = class(tcomobjectfactory)
public
procedure updateregistry(register: boolean); override;
end;procedure tcontextmenufactory.updateregistry(register: boolean);
var
classid: string;
begin
if register then begin
inherited updateregistry(register);
classid := guidtostring(class_contextmenu);
file://当注册扩展库文件时，添加库到注册表中
createregkey('*\shellex', '', '');
createregkey('*\shellex\contextmenuhandlers', '', '');
createregkey('*\shellex\contextmenuhandlers\fileopreation', '', classid); file://如果操作系统为windows nt的话
if (win32platform = ver_platform_win32_nt) then
with tregistry.create do
try
rootkey := hkey_local_machine;
openkey('software\microsoft\windows\currentversion\shell extensions', true);
openkey('approved', true);
writestring(classid, 'context menu shell extension');
finally
free;
end;
end
else begin
deleteregkey('*\shellex\contextmenuhandlers\fileopreation');
inherited updateregistry(register);
end;
end; initialization
tcontextmenufactory.create(comserver, tcontextmenu, class_contextmenu,
'', 'context menu shell extension', cimultiinstance,tmapartment);end.
在opwindow窗口中加入一个tlistbox控件和两个tbutton控件，opwindows.pas的程序清单如下：
unit opwindow;interfaceuses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
extctrls, stdctrls,shlobj,shellapi,activex;type
tform1 = class(tform)
listbox1: tlistbox;
button1: tbutton;
button2: tbutton;
procedure formcreate(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure button1click(sender: tobject);
procedure button2click(sender: tobject);
private
{ private declarations }
public
filelist:tstringlist;
{ public declarations }
end;var
form1: tform1;implementation{$r *.dfm}procedure tform1.formcreate(sender: tobject);
begin
filelist:=tstringlist.create;
button1.caption :='复制文件';
button2.caption :='移动文件';
self.show;
end;procedure tform1.formclose(sender: tobject; var action: tcloseaction);
begin
filelist.free;
end;procedure tform1.button1click(sender: tobject);
var
spath:string;
fstemp:shfileopstruct;
i:integer;
begin
spath:=inputbox('文件操作','输入复制路径','c:\windows');
if spath<>''then begin
fstemp.wnd := self.handle;
file://设置文件操作类型
fstemp.wfunc :=fo_copy;
file://允许执行撤消操作
fstemp.fflags :=fof_allowundo;
for i:=0 to listbox1.items.count-1 do begin
file://源文件全路径名
fstemp.pfrom := pchar(listbox1.items.strings[i]);
file://要复制到的路径
fstemp.pto := pchar(spath);
fstemp.lpszprogresstitle:='拷贝文件';
if shfileoperation(fstemp)<>0 then
showmessage('文件复制失败');
end;
end;
end;procedure tform1.button2click(sender: tobject);
var
spath:string;
fstemp:shfileopstruct;
i:integer;
begin
spath:=inputbox('文件操作','输入移动路径','c:\windows');
if spath<>''then begin
fstemp.wnd := self.handle;
fstemp.wfunc :=fo_move;
fstemp.fflags :=fof_allowundo;
for i:=0 to listbox1.items.count-1 do begin
fstemp.pfrom := pchar(listbox1.items.strings[i]);
fstemp.pto := pchar(spath);
fstemp.lpszprogresstitle:='移动文件';
if shfileoperation(fstemp)<>0 then
showmessage('文件复制失败');
end;
end;
end;end. 点击菜单的 project | build contextmenu 项，delphi就会建立contextmenu.dll文件，这个就是上下文相关菜单程序了。
使用，regsvr32.exe 注册程序，然后在windows的explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会
多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者移动文件按钮执行文件操作。
在Win32操作系统（包括Win9X、Windows NT、Windows 2000）不但有方便的图形用户（GUI）界面，微软还为windows用户界面保留了强大的可扩充性。其中对于Windows界面的操作环境（这里称为外壳Shell），微软提供了一种称为外壳扩展（Shell Extensions）的功能来实现文件系统操作的可编程性。如果你的机器中安装了Word 7.0以上的版本，当你鼠标右键单击一个DOC文件，在弹出菜单中选“属性”项，在属性页中不仅显示显示文件的大小、建立日期等信息，同时还增加了Doc文档的摘要、统计等信息；又例如安装了winZip 6.0以上版本后，当选中一个或多个文件或文件夹后在单击鼠标右键，在弹出的右键菜单中就增加了“Add To Zip”等一个zip文件压缩选项。上面的这些功能都是通过Windows外壳扩展来实现的。
Windows外壳扩展是这样实现的。首先要编写外壳扩展程序，一个外壳扩展程序是基于COM(Component Object Model)组件模型的。外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。
写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{ACDE002F-0000-0000-C000-000000000046}的键，这类键就是全局唯一类标识符。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。Windows系统支持以下7类的外壳扩展功能：
(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在文件被拖放、拷贝或者粘贴时，就会被系统被调用。
本文介绍的文件夹保护功能就是通过上面的第5类，既Copy-hook handlers来实现的。一个支持Copy-hook handlers的程序除了上面提到的要在注册表的HKEY_CLASSES_ROOT\CLSID下注册之外，还需要在HKEY_CLASSES_ROOT\Directory\shellex\CopyHookHandlers\下注册服务器程序的类。
由于Windows外壳服务器程序是基于COM组件模型的，所以编写外壳程序就是构造一个COM对象的过程，由于Delphi4.0以上的版本支持Windows外壳扩展和COM组件模型，所以可以利用Delphi来编写外壳扩展程序。
利用Delphi编写Copy-hook handle需要实现ICopyHook接口。ICopyHook是一个十分简单的接口，要实现的只有CopyCallBack方法。ICopyHook的CopyCallBack方法的定义如下：
UINT CopyCallback(
HWND hwnd, file://Handle of the parent window for displaying UI objects
UINT wFunc, file://Operation to perform.
UINT wFlags, file://Flags that control the operation
LPCSTR pszSrcFile, file://Pointer to the source file
DWORD dwSrcAttribs, file://Source file attributes
LPCSTR pszDestFile, file://Pointer to the destination file
DWORD dwDestAttribs file://Destination file attributes
);
其中的参数hwnd是一个窗口句柄，Copy-hook handle以此为父窗口。参数wFunc指定要被执行的操作，其取值为下表中所列之一：
常量 取值 含义
FO_COPY $2 复制由pszSrcFile指定的文件到由pszDestFile指定的位置。
FO_DELETE $3 删除由pszSrcFile指定的文件。
FO_MOVE $1 移动由pszSrcFile指定的文件到由pszDestFile指定的位置。
FO_RENAME $4 重命名由pszSrcFile指定的文件到由pszDestFile指定的文件名。
PO_DELETE $13 删除pszSrcFile指定的打印机。
PO_PORTCHANGE $20 改变打印机端口。PszSrcFile和pszDestFile为两个以Null结尾的字符串，分别指定当前和新的打印机端口名。
PO_RENAME $14 重命名由pszSrcFile指定的打印机端口。
PO_REN_PORT $34 PO_RENAME和PO_PORTCHANGE的组合。 参数wFlags指定操作的标志；参数pszSrcFile和pszDestFile指定源文件夹和目标文件夹。参数dwSrcAttribs和dwDesAttribs指定源文件夹和目标文件夹的属性。函数返回值可以为IDYES、IDNO和IDCANCEL。分别指示Windows外壳允许操作、阻止操作，但是其他操作继续、阻止当前操作，取消为执行的操作。
下面是具体的程序实现：
首先在Delphi的菜单中选 File|New选项，选择其中的DLL图标，按Ok键建立一个DLL工程文件，在其中添加以下代码：
library CopyHook;uses
ComServ,
CopyMain in 'CopyMain.pas';exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.
将文件保存为 CopyHook.dpr。再在Delphi菜单中选File|New选项，选择其中的Unit图标，按Ok键建立一个Pas文件，在其中加入以下代码：
unit CopyMain;interfaceuses Windows, ComObj, ShlObj;type
TCopyHook = class(TComObject, ICopyHook)
protected
function CopyCallback(Wnd: HWND; wFunc, wFlags: UINT; pszSrcFile: PAnsiChar;
dwSrcAttribs: DWORD; pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; stdcall;
end; TCopyHookFactory = class(TComObjectFactory)
protected
function GetProgID: string; override;
procedure ApproveShellExtension(Register: Boolean; const ClsID: string);
virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;implementationuses ComServ, SysUtils, Registry;{ TCopyHook }file://当Windows外壳程序执行文件夹或者打印机端口操作时，CopyCallBack
file://方法就会被调用。
function TCopyHook.CopyCallback(Wnd: HWND; wFunc, wFlags: UINT;
pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar;
dwDestAttribs: DWORD): UINT;
const
FO_COPY = 2;
FO_DELETE = 3;
FO_MOVE = 1;
FO_RENAME = 4;
var
sOp:string;
begin
Case wFunc of
FO_COPY: sOp:=format('你确定要将 %s 拷贝到 %s 吗？',[pszSrcFile,pszDestFile]);
FO_DELETE: sOp:=format('你确定要将 %s 删除吗？',[pszSrcFile]);
FO_MOVE: sOp:=format('你确定要将 %s 转移到 %s 吗？',[pszSrcFile,pszDestFile]);
FO_RENAME: sOp:=format('你确定要将 %s 重命名为 %s 吗？',[pszSrcFile,pszDestFile]);
else
sOp:=format('无法识别的操作代码 %d',[wFlags]);
end;
// 提示，让用户决定是否执行操作
Result := MessageBox(Wnd, PChar(sOp),
'文件挂钩演示', MB_YESNOCANCEL);
end;{ TCopyHookFactory }function TCopyHookFactory.GetProgID: string;
begin
Result := '';
end;procedure TCopyHookFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited UpdateRegistry(Register);
ApproveShellExtension(Register, ClsID);
if Register then
file://将clsid 加入到注册表的CopyHookHandlers中
CreateRegKey('directory\shellex\CopyHookHandlers\' + ClassName, '',
ClsID)
else
DeleteRegKey('directory\shellex\CopyHookHandlers\' + ClassName);
end;procedure TCopyHookFactory.ApproveShellExtension(Register: Boolean;
const ClsID: string);
const
SApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved';
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey, True) then Exit;
if Register then WriteString(ClsID, Description)
else DeleteValue(ClsID);
finally
Free;
end;
end;const
CLSID_CopyHook: TGUID = '{66CD5F60-A044-11D0-A9BF-00A024E3867F}';
LIBID_CopyHook: TGUID = '{D2F531A0-0861-11D2-AE5C-74640BC10000}';initialization
TCopyHookFactory.Create(ComServer, TCopyHook, CLSID_CopyHook,
'CR_CopyHook', '文件操作挂钩演示',ciMultiInstance, tmApartment);
end.
将文件保存为CopyMain.Pas文件，然后编译程序为CopyHook.Dll文件，然后注册CopyHook.Dll文件，你可以使用Windows提供的RegSvr32.exe来注册，注册的方法是在Dos窗口中进入Windows的System子目录，然后在其中输入Regsvr32 x:\xxx\xxx\copyhook.dll ，其中x:\xxx\xxx\是编译的CopyHook.dll所在的全路径名。也可以在Run菜单中选择Register ActiveX Server来注册。
当文件注册成功之后，在Windows的Explore中任意改变一个文件夹的名字或者移动一个目录，就会有一个提示框弹出，提示用户是否确定执行操作。如图所示： 按“是”将执行文件夹操作，按“否”或者“取消”将取消相应的文件夹操作。
上面介绍的只是Delphi实现Windows外壳扩展的一种，参照上面的程序和Delphi关于Windows的COM组件模型的编程
对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供了一个外壳（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的程序清单如下：
library contextmenu;
uses
comserv,
contextmenuhandle in 'contextmenuhandle.pas',
opwindow in 'opwindow.pas' {form2};exports
dllgetclassobject,
dllcanunloadnow,
dllregisterserver,
dllunregisterserver;{$r *.tlb}{$r *.res}beginend. contextmenuhandle的程序清单如下：
unit contextmenuhandle;interface
uses windows,activex,comobj,shlobj,classes;type
tcontextmenu = class(tcomobject,ishellextinit,icontextmenu)
private
ffilename: array[0..max_path] of char;
protected
function ishellextinit.initialize = seiinitialize; // avoid compiler warning
function seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult; stdcall;
function querycontextmenu(menu: hmenu; indexmenu, idcmdfirst, idcmdlast,
uflags: uint): hresult; stdcall;
function invokecommand(var lpici: tcminvokecommandinfo): hresult; stdcall;
function getcommandstring(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;
implementationuses comserv, sysutils, shellapi, registry,unitform;function tcontextmenu.seiinitialize(pidlfolder: pitemidlist; lpdobj: idataobject;
hkeyprogid: hkey): hresult;
var
stgmedium: tstgmedium;
formatetc: tformatetc;
filenumber,i:integer;
begin
file://如果lpdobj等于nil，则本调用失败
if (lpdobj = nil) then begin
result := e_invalidarg;
exit;
end; file://首先初始化并清空filelist以添加文件
filelist:=tstringlist.create;
filelist.clear;
file://初始化剪贴版格式文件
with formatetc do begin
cfformat := cf_hdrop;
ptd := nil;
dwaspect := dvaspect_content;
lindex := -1;
tymed := tymed_hglobal;
end;
result := lpdobj.getdata(formatetc, stgmedium); if failed(result) then exit; file://首先查询用户选中的文件的个数
filenumber := dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);
file://循环读取，将所有用户选中的文件保存到filelist中
for i:=0 to filenumber-1 do begin
dragqueryfile(stgmedium.hglobal, i, ffilename, sizeof(ffilename));
filelist.add(ffilename);
result := noerror;
end; releasestgmedium(stgmedium);
end;function tcontextmenu.querycontextmenu(menu: hmenu; indexmenu, idcmdfirst,
idcmdlast, uflags: uint): hresult;
begin
result := 0;
if ((uflags and $0000000f) = cmf_normal) or
((uflags and cmf_explore) <> 0) then begin
// 往context menu中加入一个菜单项 ,菜单项的标题为察看位图文件
insertmenu(menu, indexmenu, mf_string or mf_byposition, idcmdfirst,
pchar('文件操作'));
// 返回增加菜单项的个数
result := 1;
end;
end;function tcontextmenu.invokecommand(var lpici: tcminvokecommandinfo): hresult;
var
frmop:tform1;
begin
// 首先确定该过程是被系统而不是被一个程序所调用
if (hiword(integer(lpici.lpverb)) <> 0) then
begin
result := e_fail;
exit;
end;
// 确定传递的参数的有效性
if (loword(lpici.lpverb) <> 0) then begin
result := e_invalidarg;
exit;
end; file://建立文件操作窗口
frmop:=tform1.create(nil);
file://将所有的文件列表添加到文件操作窗口的列表中
frmop.listbox1.items := filelist;
result := noerror;
end;
中的定义如下：
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;
其中参数hWnd定义了监视系统操作的窗口得句柄，参数uFlags dwEventID定义监视操作参数，参数uMsg定义操作消息，参数cItems
定义附加参数，参数lpps指定一个PIDLSTRUCT结构，该结构指定监视的目录。
当函数调用成功之后，函数会返回一个监视操作句柄，同时系统就会将hWnd指定的窗口加入到操作监视链中，当有文件操作发生
时，系统会向hWnd发送uMsg指定的消息，我们只要在程序中加入该消息的处理函数就可以实现对系统操作的监视了。
如果要退出程序监视，就要调用另外一个未公开得函数SHChangeNotifyDeregister来取消程序监视。
下面是使用Delphi编写的具体程序实现范例，首先建立一个新的工程文件，然后在Form1中加入一个Button控件和一个Memo控件，
程序的代码如下：unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,shlobj,Activex;const
SHCNE_RENAMEITEM = $1;
SHCNE_CREATE = $2;
SHCNE_DELETE = $4;
SHCNE_MKDIR = $8;
SHCNE_RMDIR = $10;
SHCNE_MEDIAINSERTED = $20;
SHCNE_MEDIAREMOVED = $40;
SHCNE_DRIVEREMOVED = $80;
SHCNE_DRIVEADD = $100;
SHCNE_NETSHARE = $200;
SHCNE_NETUNSHARE = $400;
SHCNE_ATTRIBUTES = $800;
SHCNE_UPDATEDIR = $1000;
SHCNE_UPDATEITEM = $2000;
SHCNE_SERVERDISCONNECT = $4000;
SHCNE_UPDATEIMAGE = $8000;
SHCNE_DRIVEADDGUI = $10000;
SHCNE_RENAMEFOLDER = $20000;
SHCNE_FREESPACE = $40000;
SHCNE_ASSOCCHANGED = $8000000;
SHCNE_DISKEVENTS = $2381F;
SHCNE_GLOBALEVENTS = $C0581E0;
SHCNE_ALLEVENTS = $7FFFFFFF;
SHCNE_INTERRUPT = $80000000; SHCNF_IDLIST = 0; // LPITEMIDLIST
SHCNF_PATHA = $1; // path name
SHCNF_PRINTERA = $2; // printer friendly name
SHCNF_DWORD = $3; // DWORD
SHCNF_PATHW = $5; // path name
SHCNF_PRINTERW = $6; // printer friendly name
SHCNF_TYPE = $FF; SHCNF_FLUSH = $1000; SHCNF_FLUSHNOWAIT = $2000;
SHCNF_PATH = SHCNF_PATHW;
SHCNF_PRINTER = SHCNF_PRINTERW; WM_SHNOTIFY = $401;
NOERROR = 0;type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY;
public
{ Public declarations }
end;type PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = record
dwItem1 : PItemIDList;
dwItem2 : PItemIDList;
end;Type PSHFileInfoByte=^SHFileInfoByte;
_SHFileInfoByte = record
hIcon :Integer;
iIcon :Integer;
dwAttributes : Integer;
szDisplayName : array [0..259] of char;
szTypeName : array [0..79] of char;
end;
SHFileInfoByte=_SHFileInfoByte;Type PIDLSTRUCT = ^IDLSTRUCT;
_IDLSTRUCT = record
pidl : PItemIDList;
bWatchSubFolders : Integer;
end;
IDLSTRUCT =_IDLSTRUCT;
function SHNotify_Register(hWnd : Integer) : Bool;
function SHNotify_UnRegister:Bool;
function SHEventName(strPath1,strPath2:string;lParam:Integer):string;Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;
external 'Shell32.dll' index 4;
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;
Function SHGetFileInfoPidl(pidl : PItemIDList;
dwFileAttributes : Integer;
psfib : PSHFILEINFOBYTE;
cbFileInfo : Integer;
uFlags : Integer):Integer;stdcall;
external 'Shell32.dll' name 'SHGetFileInfoA';var
Form1: TForm1;
m_hSHNotify:Integer;
m_pidlDesktop : PItemIDList;implementation{$R *.DFM}function SHEventName(strPath1,strPath2:string;lParam:Integer):string;
var
sEvent:String;
begin
case lParam of file://根据参数设置提示消息
SHCNE_RENAMEITEM: sEvent := '重命名文件'+strPath1+'为'+strpath2;
SHCNE_CREATE: sEvent := '建立文件 文件名：'+strPath1;
SHCNE_DELETE: sEvent := '删除文件 文件名：'+strPath1;
SHCNE_MKDIR: sEvent := '新建目录 目录名：'+strPath1;
SHCNE_RMDIR: sEvent := '删除目录 目录名：'+strPath1;
SHCNE_MEDIAINSERTED: sEvent := strPath1+'中插入可移动存储介质';
SHCNE_MEDIAREMOVED: sEvent := strPath1+'中移去可移动存储介质'+strPath1+' '+strpath2;
SHCNE_DRIVEREMOVED: sEvent := '移去驱动器'+strPath1;
SHCNE_DRIVEADD: sEvent := '添加驱动器'+strPath1;
SHCNE_NETSHARE: sEvent := '改变目录'+strPath1+'的共享属性'; SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名'+strPath1;
SHCNE_UPDATEDIR: sEvent := '更新目录'+strPath1;
SHCNE_UPDATEITEM: sEvent := '更新文件 文件名：'+strPath1;
SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接'+strPath1+' '+strpath2;
SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';
SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';
SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹'+strPath1+'为'+strpath2;
SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';
SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';
else
sEvent:='未知操作'+IntToStr(lParam);
end;
Result:=sEvent;
end;function SHNotify_Register(hWnd : Integer) : Bool;
var
ps:PIDLSTRUCT;
begin
{$R-}
Result:=False;
If m_hSHNotify = 0 then begin
file://获取桌面文件夹的Pidl
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop)<> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop; // 利用SHChangeNotifyRegister函数注册系统消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),
(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),
WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
Else
// 如果出现错误就使用 CoTaskMemFree函数来释放句柄
CoTaskMemFree(m_pidlDesktop);
End;
{$R+}
end;function SHNotify_UnRegister:Bool;
begin
Result:=False;
If Boolean(m_hSHNotify) Then
file://取消系统消息监视，同时释放桌面的Pidl
If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin
{$R-}
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
{$R-}
End;
end;procedure TForm1.WMShellReg(var Message:TMessage); file://系统消息处理函数
var
strPath1,strPath2:String;
charPath:array[0..259]of char;
pidlItem:PSHNOTIFYSTRUCT;
begin
pidlItem:=PSHNOTIFYSTRUCT(Message.wParam);
file://获得系统消息相关得路径
SHGetPathFromIDList(pidlItem.dwItem1,charPath);
strPath1:=charPath;
SHGetPathFromIDList(pidlItem.dwItem2,charPath);
strPath2:=charPath; Memo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam)+chr(13)+chr(10));
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
file://在程序退出的同时删除监视
if Boolean(m_pidlDesktop) then
SHNotify_Unregister;
end;procedure TForm1.Button1Click(Sender: TObject); file://Button1的Click消息
begin
m_hSHNotify:=0;
if SHNotify_Register(Form1.Handle) then begin file://注册Shell监视
ShowMessage('Shell监视程序成功注册');
Button1.Enabled := False;
end
else
ShowMessage('Shell监视程序注册失败');
end;procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption := '打开监视';
end;end. 运行程序，点击“打开监视”按钮，如果出现一个显示“Shell监视程序成功注册”的对话框，说明Form1已经加入到系统操作监视链中了，
你可以试着在资源管理器中建立、删除文件夹，移动文件等操作，你可以发现这些操作都被纪录下来并显示在文
pszname: lpstr; cchmax: uint): hresult;
begin
if (idcmd = 0) then begin
if (utype = gcs_helptext) then
{返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
移动到该菜单项时出现在状态条上。}
strcopy(pszname, pchar('点击该菜单项将执行文件操作'));
result := noerror;
end
else
result := e_invalidarg;
end;type
tcontextmenufactory = class(tcomobjectfactory)
public
procedure updateregistry(register: boolean); override;
end;procedure tcontextmenufactory.updateregistry(register: boolean);
var
classid: string;
begin
if register then begin
inherited updateregistry(register);
classid := guidtostring(class_contextmenu);
file://当注册扩展库文件时，添加库到注册表中
createregkey('*\shellex', '', '');
createregkey('*\shellex\contextmenuhandlers', '', '');
createregkey('*\shellex\contextmenuhandlers\fileopreation', '', classid); file://如果操作系统为windows nt的话
if (win32platform = ver_platform_win32_nt) then
with tregistry.create do
try
rootkey := hkey_local_machine;
openkey('software\microsoft\windows\currentversion\shell extensions', true);
openkey('approved', true);
writestring(classid, 'context menu shell extension');
finally
free;
end;
end
else begin
deleteregkey('*\shellex\contextmenuhandlers\fileopreation');
inherited updateregistry(register);
end;
end; initialization
tcontextmenufactory.create(comserver, tcontextmenu, class_contextmenu,
'', 'context menu shell extension', cimultiinstance,tmapartment);end.
在opwindow窗口中加入一个tlistbox控件和两个tbutton控件，opwindows.pas的程序清单如下：
unit opwindow;interfaceuses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
extctrls, stdctrls,shlobj,shellapi,activex;type
tform1 = class(tform)
listbox1: tlistbox;
button1: tbutton;
button2: tbutton;
procedure formcreate(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure button1click(sender: tobject);
procedure button2click(sender: tobject);
private
{ private declarations }
public
filelist:tstringlist;
{ public declarations }
end;var
form1: tform1;implementation{$r *.dfm}procedure tform1.formcreate(sender: tobject);
begin
filelist:=tstringlist.create;
button1.caption :='复制文件';
button2.caption :='移动文件';
self.show;
end;procedure tform1.formclose(sender: tobject; var action: tcloseaction);
begin
filelist.free;
end;procedure tform1.button1click(sender: tobject);
var
spath:string;
fstemp:shfileopstruct;
i:integer;
begin
spath:=inputbox('文件操作','输入复制路径','c:\windows');
if spath<>''then begin
fstemp.wnd := self.handle;
file://设置文件操作类型
fstemp.wfunc :=fo_copy;
file://允许执行撤消操作
fstemp.fflags :=fof_allowundo;
for i:=0 to listbox1.items.count-1 do begin
file://源文件全路径名
fstemp.pfrom := pchar(listbox1.items.strings[i]);
file://要复制到的路径
fstemp.pto := pchar(spath);
fstemp.lpszprogresstitle:='拷贝文件';
if shfileoperation(fstemp)<>0 then
showmessage('文件复制失败');
end;
end;
end;procedure tform1.button2click(sender: tobject);
var
spath:string;
fstemp:shfileopstruct;
i:integer;
begin
spath:=inputbox('文件操作','输入移动路径','c:\windows');
if spath<>''then begin
fstemp.wnd := self.handle;
fstemp.wfunc :=fo_move;
fstemp.fflags :=fof_allowundo;
for i:=0 to listbox1.items.count-1 do begin
fstemp.pfrom := pchar(listbox1.items.strings[i]);
fstemp.pto := pchar(spath);
fstemp.lpszprogresstitle:='移动文件';
if shfileoperation(fstemp)<>0 then
showmessage('文件复制失败');
end;
end;
end;end. 点击菜单的 project | build contextmenu 项，delphi就会建立contextmenu.dll文件，这个就是上下文相关菜单程序了。
使用，regsvr32.exe 注册程序，然后在windows的explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会
多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者
移动文件按钮执行文件操作。
http://www.csdn.net/Develop/Read_Article.asp?Id=3545
Windows外壳扩展编程之添加右键菜单
http://www.csdn.net/Develop/Read_Article.asp?Id=3544
利用Windows外壳扩展保护文件夹
http://www.csdn.net/Develop/Read_Article.asp?Id=3487