程序设计Windows外壳扩展编程入门实例.pdf

《程序设计Windows外壳扩展编程入门实例.pdf》由会员分享，可在线阅读，更多相关《程序设计Windows外壳扩展编程入门实例.pdf（28页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、Windows外壳扩展编程入门实例 Delphi篇 weizhisheng 作者的话 关于 Windows 外壳扩展方面的文章私心以为最好的应当算是 Michael Dunn 的The Complete Idiots Guide to Writing Shell Extensions我也曾想过所谓眼前有景道不得崔颢题诗在上头既然已经有了这么好的文章我还来饶舌算什么不过转念再想文章虽好毕竟是为 Visual C+的用户看的对 Delphi的使用者来说似乎有点不公平我最初编写 Shell Extension的时候用的也是 Visual C+不过现在已经转而使用 Delphi觉得两者毕竟还是有所不同

2、因此就有了这篇文章算是将我的一些心得体会和大家分享 我最初的打算是将Michael Dunn 文章中涉及的全部内容全部转成 Delphi程序再加上我自己的一些发现做成一个完整的系列不过后来发现这个工程量实在相当的大而且似乎没有必要因为 Windows Shell Extension 的许多内容是相通的完全可以举一反三我再重复MSDN或者 Michael Dunn文章中的那些东西似乎是在浪费时间最终我决定只用一个例子说明 Shell Extension 编程的基本原理就好至于后面的东西那就修行在各人了 我是第一次写这样长的文章而且从文字程序到图片样样俱全加上 Acrobat 又不熟悉用 法所 以

3、 做 的 比 较 辛 苦如 果 有 什 么 意 见 或 是 发 现 问 题 的 话 欢 迎 来 信 告 诉 我(Hao.Y)不过我无法保证一定能够回信如果想要转载的话也无妨不过希望能够尊重我的劳动不要擅自修改文章内容也不要改头换面署上自己的名字 再次感谢您费心阅读本文 weizhisheng 2002 年 5 月 3 日 第一篇 概述 尽管 Windows 资源管理器的功能在每个新版本中都得到了不少增强 还是有许多人对它感到不满意有没有办法让资源管理器变得更好用更符合自己的需要呢一个办法就是自己重新打造一个全新的 Explorer 目前已经有了一些这方面的软件比如 PowerDesk Util

4、ities 和Turbo Browser 就堪称个中翘楚不过要完全实现资源管理器方方面面的功能其工作量可能超乎想象而且牵涉的知识面颇广对个人来说难度高了一些而另一个办法就是利用Microsoft 开放给我们的外壳扩展接口了虽然这种途径限制更多一些但是门槛比较低而且也能够满足绝大部分需要这方面一个最好的例子就是WinZip这个软件几乎把外壳扩展的功能发挥到了极致相信你已经很熟悉它了在本文中我就利用自己完成的一个实际的例子来说明如何编程扩展 Windows 外壳 为了完成这个例子我参考了一些资料主要是 Michael Dunn的The Complete Idiots Guide to Writin

5、g Shell Extensions可以从 http:/ Michael Dunn不过他的例子是用 Visual C+编写的我在阅读的时候就感到用Visual C+来编写这些东西显得太过繁琐而且将 MFC/ATL/STL 混合在一起的风格也让我觉得非常不爽因此后来我改用Delphi 重写了程序这样确实为我节省了不少工作量如果你常用的工具是 Visual C+那么建议你还是应该去阅读 Michael Dunn 的文档这些文档内容更完整得多我的这篇文章主要是面对 Delphi 的用户提供一个入门级的 Windows 外壳扩展编程指导 我用来编写这个程序的平台是Microsoft Windows 2

6、000 Professional 编程工具是 Borland Delphi 6.0+Update Pack 2 在编写外壳扩展程序的时候我推荐尽可能使用最新的开发平台因为 Windows Shell 的接口总是在持续的更新而比较老的开发平台例如 Delphi 5.0和更早的Visual C+6.0将无法识别许多新的结构接口和函数等等虽然我听到不少抱怨说 Delphi 6.0 不如早期版本来的稳定不过至少在开发这个程序的过程中它并没有给我造成什么麻烦至于操作系统无论如何要用 Windows 2000因为在 Windows 9X 下调试外壳扩展是一件非常麻烦的事情 在编写外壳扩展之前应该先做一些准

7、备工作首先必须在注册表中作一些改动因为任何外壳扩展都是作为 DLL 而加载到 Explorer的进程空间内的 所以如果不做些手脚 那么只要 Explorer还存在 你编写的外壳扩展就无法顺利编译 如果你愿意手动修改注册表的话 可以参考Michael Dunn的文章不过我建议你利用Windows 优化大师这个软件帮你做掉这项工作只要选中启动系统时为桌面和 Explorer 创建独立的进程即可这个选项会增加一些系统开销不过从理论上来讲倒是可以让操作系统更稳定一些如下图所示 另外一个问题就是在调试外壳扩展的时候你不能太依赖于集成调试器就拿 Context Menu 扩展来说你怎么能一方面激活集成调试

8、器另一方面又让资源管理器中的上下文菜单保持可见呢所以你首先应该养成在运行程序之前把程序先好好检查一遍的习惯不要急着按F9其次如果你需要一个脱离 IDE又能够显示调试信息的工具那么有一个很好的工具DebugView 可以满足你这个软件可以从 取得我发现这个工具至少能够解决 90%以上的调试需求它已经成为我的编程工具箱中最重要的工具之一 最后再罗索两句编写外壳扩展的时候一定要特别小心尽量处理任何可能发生的错误 因为外壳扩展是被 Explorer加载到进程空间内的 所以外壳扩展中的任何错误都可能让 Explorer崩溃掉特别是你的程序中如果用到任何VCL类或者 RTL 函数的话一定要处理掉可能发生的

9、异常因为操作系统并不知道如何处理 VCL/RTL 异常其后果如何是可想而知的考虑到Explorer在系统中的地位你应该有一种如临深渊如履薄冰的感觉了另外为了用户考虑外壳扩展所执行的任何任务都应该尽可能快的完成 决不要用外壳扩展执行那些需要很长时间的动作否则的话如果用户在资源管理器中点击鼠标后要好几秒钟才会看到菜单出现那么很快他们她们就会感到不耐烦进而对你的软件失去信心 准备好了吗我们出发吧 第二篇 建立程序框架 外壳扩展有好几种类型在这里我要实现的是一个Context Menu 扩展因为这是最常见最有用的扩展类型而且所有的外壳扩展都有许多相通的地方学会一种以后其他的也就非常容易掌握了 我计划让

10、这个扩展完成如下的一些功能 1 对任何文件都能够实现 Copy(Move)to AnywhereWindows 资源管理器并不直接支持这项功能不论是 Cut/Copy&Paste 或者是开两个文件夹窗口来Drag/Drop都要经历多个步骤才行毕竟麻烦我是在工具软件 Nuts&Bolt中第一次看到这个功能的当时就觉得它非常有用不过一直不知道是如何实现的现在好了我们也来 DIY 一回 2 对于 COM 组件库能够实现 Register/Unregister 的功能凡是编程的人都应该知道这个内容从而不必动用不讨人喜欢的 regsvr32 3 对于图片文件能够在 Context Menu 中预览用过

11、PicaView 吗对了就是它如果只是想知道图片的概貌又何必非 ACDSee 不可Windows 2000的缩略图模式处理图像太慢而且占用太多资源我也不喜欢 上述三种情况几乎涵盖了 Context Menu 扩展所能遇到的所有情况如何处理单一文件如何处理多个文件如何管理自绘式Owner-Draw菜单可以说只要能妥善处理这三种情况那么在 Context Menu 扩展中再没有什么困难的问题了 因为任何外壳扩展首先必须是一个 COM 组件所以我们就从这里开始 1 用 Delphi 新建一个ActiveX Library并保存我用的名称是 YHShellExt你当然可以猜到YH是我的名字的缩写你可以

12、把它换成自己的名字 2 再次用 Delphi新建一个 COM Object在 COM Object Wizard 中将对象命名为 YHContextMenuOptions 中的两个检查框都可以不必选中其他的保持默认即可 现在这个程序的框架已经建立起来了Delphi 为我们自动产生了 TYHContextMenu 类的骨架代码并且在单元的 initialization部分自动产生了一个 TComObjectFactory 对象这个对象可以完成 COM组件的注册工作不过对于外壳扩展来说除了注册 COM组件之外还必须 完 成 一 些 额 外 的 工 作这 个 组 件 才 具 备 了 外 壳 扩 展

13、的 身 份所 以 我 们 还 需 要 从TComObjectFactory 派生一个类才行对代码稍作修改完成后应该类似下面这样 unit YHCMImpl;interface uses Windows,Messages,ActiveX,Classes,SysUtils,ComObj,ShellAPI,ShlObj,Graphics,JPEG,Registry;type TYHContextMenu-Context Menu Extension 的实现类 TYHContextMenu=class(TComObject)private protected public end;TYHContext

14、MenuFactory-Context Menu Extension 的类工厂 TYHContextMenuFactory=class(TComObjectFactory)public procedure UpdateRegistry(Register:Boolean);override;end;const Class_YHContextMenu:TGUID=461BCDC0-5E20-11D6-9A8D-00E04C393F6F;implementation uses ComServ;/=/TYHContextMenu/=/=/TYHContextMenuFactory /=procedur

15、e TYHContextMenuFactory.UpdateRegistry(Register:Boolean);begin inherited;end;initialization TYHContextMenuFactory.Create(ComServer,TYHContextMenu,Class_YHContextMenu,YHContextMenu,ciMultiInstance,tmApartment);end.建立程序框架的工作到此完成从下一部分开始我们将陆续向程序中加入功能性的代码 第三篇 支持 I S h e l l E x t I n i t接口 绝大多数外壳扩展都需要支持I

16、ShellExtInit 接口除此之外每一种扩展分别还需要支持一至二个额外的接口对于 Context Menu 扩展来说必须支持的两个基本接口就是IShellExtInit 和 IContextMenu 另外 如果要处理自绘式菜单 还需要支持IContextMenu2或者 IContextMenu3由于 IShellExtInit 接口对每一个外壳扩展来说都是必需的而且相对简单我们首先来实现它 IShellExtInit 接口只有一个方法Initialize在 Context Menu 弹出之前系统会调用这个方法而我们所要做的工作就是在这个时候决定用户究竟选定了哪些文件再根据这些文件的类型做进

17、一步的处理不过这里有一个小小的麻烦在 Delphi中一切 COM 对象都是从TComObject 派生而来的而 TComObject 类中已经有了一个虚拟的Initialize方法这个方法会在 COM组件建立的时候被调用如果我们的程序还要实现 IShellExt:Initialize 的话那么命名冲突的问题就不可避免了 怎么办Object Pascal中有一种特殊的语法可以避开这个问题 TYHContextMenu=class(TComObject,IShellExtInit)private 数据成员 FFileList:TStringList;FGraphic:TGraphic;protec

18、ted IShellExtInit 接口 function IShellExtInit.Initialize=SEInitialize;function SEInitialize(pidlFolder:PItemIDList;lpdobj:IDataObject;hKeyProgID:HKEY):HResult;stdcall;public procedure Initialize;override;destructor Destroy;override;end;基本上 Object Pascal 语言采用的是单根继承的方法所以命名冲突的问题很少会出现不过一旦某个类需要实现多个接口 那么还是无

19、法确保这些接口不会有同名的方法不过你也看到了只要像上述那样为其中某个接口的方法另外起一个名字就不会有问题了 为了正确处理外壳扩展的构造/析构动作 我重载了 TComObject 的 Initialize 和 Destroy两个方法你或许会奇怪为什么不重载 Create而用了 Initialize这是因为TComObject 有好几种形式的构造函数但是不论如何构造 TComObjectInitialize方法是一定会被调用的所以这里是执行初始化动作的最好地方另外注意我添加了两个数据成员其中 FFileList 用于保存用户选中的文件列表FGraphic 用于执行图片预览的动作在后面我们会用到 I

20、nitialize 和 Destroy 方法的代码非常简单无非是数据的初始化和释放而已 procedure TYHContextMenu.Initialize;begin OutputDebugString(YHContextMenu:Initialize#13#10);inherited;FFileList:=TStringList.Create;FGraphic:=nil;end;destructor TYHContextMenu.Destroy;begin OutputDebugString(YHContextMenu:Destroy#13#10);FreeAndNil(FFileLis

21、t);FreeAndNil(FGraphic);inherited;end;上面两个 OutputDebugString 的作用是观察 Context Menu 扩展的生存周期用DebugView 可以看到Context Menu 扩展在资源管理器中点击右键弹出上下文菜单的时候才会建立而菜单消失的时候生命也就结束了如下图当然现在还无法看到这个结果因为这个扩展还没有实现 IContextMenu所以根本还不是一个合法的 Context Menu Extension但 是 从 中 你 可 以 看 到DebugView在 调 试 过 程 中 的 作 用 下一步是实现 IShellExtInit:In

22、itialize这个方法包括三个参数不过目前来说有用的只有一个就是系统传递给我们的 IDataObject 对象我们可以从中获得用户选择的文件列表因为对于所有的外壳扩展来说对此一方法的处理都相当一致 所以我设计了另外一个方法这个方法可以被任何实现 IShellExtInit 的类所调用/=/IShellExtInit:Initialize/=function TYHContextMenu.SEInitialize(pidlFolder:PItemIDList;lpdobj:IDataObject;hKeyProgID:HKEY):HResult;begin Result:=GetFileLis

23、tFromDataObject(lpdobj,FFileList);end;function GetFileListFromDataObject(lpdobj:IDataObject;sl:TStringList):HResult;var fe:FormatEtc;sm:StgMedium;i,iFileCount:integer;FileName:array0.MAX_PATH-1 of char;begin assert(lpdobjnil);assert(slnil);sl.Clear;with fe do begin cfFormat:=CF_HDROP;ptd:=nil;dwAspe

24、ct:=DVASPECT_CONTENT;lindex:=-1;tymed:=TYMED_HGLOBAL;end;with sm do begin tymed:=TYMED_HGLOBAL;end;Result:=lpdobj.GetData(fe,sm);if Failed(Result)then Exit;iFileCount:=DragQueryFile(sm.hGlobal,$ffffffff,nil,0);if iFileCount=0 then begin ReleaseStgMedium(sm);Result:=E_INVALIDARG;Exit;end;for i:=0 to

25、iFileCount-1 do begin DragQueryFile(sm.hGlobal,i,FileName,sizeof(FileName);sl.Add(FileName);end;ReleaseStgMedium(sm);Result:=S_OK;end;对 IDataObject 的处理涉及COM 中特别是 OLE拖放编程的一些高级概念所以上面的代码可能会让缺乏这方面知识的人看起来有点糊涂不过没关系你只需要知道调用这个方法以后用户选择的文件列表就会保存到 StringList 中就行了 在这一部分我们除了处理外壳扩展本身的初始化和清除之外还实现了 IShellExtInit 接口

26、在下一部分我们将进入 Context Menu 扩展的另外一个也是最核心的接口IContextMenu 第四篇 支持 I C o n t e x t M e n u接口 比起我们在上面讨论的IShellExtInit 接口来说IContextMenu是一个相对复杂的接口它有三个方法而且每个方法都是参数众多虽然 InvokeCommand 方法只有一个参数不过这个参数可是一个相当庞大的结构我们按顺序来首先是菜单弹出之前系统要调用的方法QueryContextMenu QueryContextMenu 方法声明如下 function QueryContextMenu(Menu:HMENU;inde

27、xMenu,idCmdFirst,idCmdLast,uFlags:UINT):HResult;stdcall;其中Menu 就是系统开放给你的上下文菜单的句柄你可以用 InsertMenu 或者InsertMenuItem之类的函数向里面增加菜单indexMenu 是系统预留给你的菜单项的位置你应该从这个位置开始加入菜单但是加入的菜单项个数不要超过 idCmdLast-idCmdFirst 这个范围uFlags 则是一些标志位函数的返回值则应该是你加入的菜单个数和其他一些标志的组合例如我们要加入一个 CopyAnywhere 的菜单项 const /菜单类型 mfString=MF_STRI

28、NG or MF_BYPOSITION;mfOwnerDraw=MF_OWNERDRAW or MF_BYPOSITION;mfSeparator=MF_SEPARATOR or MF_BYPOSITION;/菜单项 ID idCopyAnywhere=0;/复制移动 idRegister=5;/注册 ActiveX idUnregister=6;/取消注册 ActiveX idImagePreview=10;/预览图片文件 idMenuRange=90;function Make_HResult(sev,fac,code:Word):DWord;begin Result:=(sev shl

29、31)or(fac shl 16)or code;end;function TYHContextMenu.QueryContextMenu(Menu:HMENU;indexMenu,idCmdFirst,idCmdLast,uFlags:UINT):HResult;var Added:UINT;begin if(uFlags and CMF_DEFAULTONLY)=CMF_DEFAULTONLY then begin Result:=Make_HResult(SEVERITY_SUCCESS,FACILITY_NULL,0);Exit;end;Added:=0;/加入 CopyAnywher

30、e 蔡单项 InsertMenu(Menu,indexMenu,mfSeparator,0,nil);InsertMenu(Menu,indexMenu,mfString,idCmdFirst+idCopyAnywhere,PChar(sCopyAnywhere);InsertMenu(Menu,indexMenu,mfSeparator,0,nil);Inc(Added,3);Result:=Make_HResult(SEVERITY_SUCCESS,FACILITY_NULL,idMenuRange);end;你也许会感到吃惊我分明只加入了一个有效的菜单项即使算上另外两个 Separato

31、r 也不过 3 个而已为什么返回值却指定了 90 个之多这是因为我计划编写的是一个通用的Context Menu 扩展它对所有的文件都适用当然为某一种文件编写Context Menu 扩展也是完全可以的 不过这样做灵活性太差 比如.DLL或者.OCX 甚至还包括.EXE 都可能是COM组件都可以执行 Register/Unregister的操作难道为了实现同一个功能还要写23个基本上没有差别的扩展通用扩展就没有这样的问题不过编程的复杂性就大大增加因为就必须处理这样麻烦的情况如果是.TXT 文件的话需要加入这些菜单如果是.BMP 的话加入另外一些为了避免总是要动态计算菜单 ID 的麻烦保证扩展的

32、扩充性多保留几个 ID 没有坏处在 MSDN 中声明返回值应该是加入的菜单项个数+1严格来说这是不正确的我测试的结果证明返回的结果应该是系统为你的扩展保留的菜单 ID 范围也就是说如果idCmdFirst=20000而你返回了 90那么系统会保证2000020000+90-1这个范围内的菜单 ID 都是可用的如果系统中还有其他扩展的话那么它们会使用 20090 后面的菜单ID所 以 我 总 是 倾 向 于 保 留 尽 可 能 多 的ID留 给 以 后 使 用只 要 不 超 过idCmdLast-idCmdFirst这个限度即可从上面的常量定义你大概也可以发现我使用的规则那就是为每一种文件类型至

33、少保留 5 个菜单 ID 你还会注意到 Make_HResult 函数这在 SDK 中是作为MAKE_HRESULT 宏来实现的但是 Delphi 中并没有宏的概念为了让熟悉 SDK 的人更容易理解这个程序我把它拿出来做成了一个独立的函数 下面一个方法是IContextMenu:InvokeCommand这个函数会在用户点击菜单项的时候被调用也是执行真正动作的地方 function TYHContextMenu.InvokeCommand(var lpici:TCMInvokeCommandInfo):HResult;begin Result:=E_INVALIDARG;if HiWord(I

34、nteger(lpici.lpVerb)0 then Exit;case LoWord(Integer(lpici.lpVerb)of idCopyAnywhere:DoCopyAnywhere(lpici.hwnd,FFileList);Result:=NOERROR;end;procedure DoCopyAnywhere(Wnd:HWND;sl:TStringList);var frm:TfrmCopyAnywhere;begin frm:=TfrmCopyAnywhere.Create(Application);try frm.AddFiles(sl);frm.ShowModal;fi

35、nally frm.Free;end;end;frmCopyAnywhere 是额外设计来实现Copy(Move)to Anywhere 功能的用户界面因为有了 SHFileOperation 这样好用的函数所以我们要做的工作其实相当的少这个窗体的详细代码我也就不再列出了 相信有点经验的朋友都应该可以轻松完成才对 下图是这个窗体的显示界面我的界面设计实在算不上高明希望大家可以设计的比我更好 OK我们已经胜利在望了最后一个需要编写的方法是 GetCommandString当用户选择菜单项的时候 在资源管理器的状态栏上会显示相关的提示信息 这个方法也没有什么好说的唯一需要注意的就是 Unicode

36、/Ansi的区别让事情变得有点复杂不过比起 C+来说不管是烦 人 的 MultiByteToWideChar/WideCharToMultiByte 还 是 我 总 也 搞 不 清 楚 的ATL ConversionsDelphi 的处理过程还是相当简单而直观的/=/IContextMenu:GetCommandString/=function TYHContextMenu.GetCommandString(idCmd,uType:UINT;pwReserved:PUINT;pszName:LPSTR;cchMax:UINT):HResult;var strTip:string;wstrTip

37、:WideString;begin strTip:=;Result:=E_INVALIDARG;if(uType and GCS_HELPTEXT)GCS_HELPTEXT then Exit;case idCmd of idCopyanywhere:strTip:=sCopyAnywhereTip;end;if strTip then begin if(uType and GCS_UNICODE)=0 then begin /Ansi lstrcpynA(pszName,PChar(strTip),cchMax);end else begin /Unicode wstrTip:=strTip

38、;lstrcpynW(PWideChar(pszName),PWideChar(wstrTip),cchMax);end;Result:=S_OK;end;end;大功告成 不过 我们似乎还高兴的早了一点 别忘了还有一个TYHContextMenuFactory呢如果忘了它那么期待已久的 Context Menu Extension还是无法出现好在 Delphi 有几个非常好用的函数可以省掉处理注册表的许多麻烦 procedure TYHContextMenuFactory.UpdateRegistry(Register:Boolean);procedure DeleteRegValue(co

39、nst Path,ValueName:string;Root:DWord=HKEY_CLASSES_ROOT);var reg:TRegistry;begin reg:=TRegistry.Create;with reg do try RootKey:=Root;if OpenKey(Path,False)then begin if ValueExists(ValueName)then DeleteValue(ValueName);CloseKey;end;finally Free;end;end;const RegPath=*shellexContextMenuHandlersYHShell

40、Ext;ApprovedPath=SoftwareMicrosoftWindowsCurrentVersionShell ExtensionsApproved;var strGUID:string;begin inherited;strGUID:=GUIDToString(Class_YHContextMenu);if Register then begin CreateRegKey(RegPath,strGUID);CreateRegKey(ApprovedPath,strGUID,YH的外壳扩展,HKEY_LOCAL_MACHINE);end else begin DeleteRegKey

41、(RegPath);DeleteRegValue(ApprovedPath,strGUID,HKEY_LOCAL_MACHINE);end;end;现在我们面对的就是一个真真正正的可以执行的Context Menu 外壳扩展了只要在IDE 中执行一下 Run-Register ActiveX Server命令你就能够到资源管理器中检阅自己的劳动成果了 第五篇 加入注册/反注册 A c t i v e X L i b r a r y的功能 上面的内容都明白了吗如果你回答是那么这一部分的内容对你来说也应该是轻而易举的了为了简化起见我决定只支持单一文件的注册和反注册功能注册和反注册的原理也是非常简单

42、的用 LoadLibrary 载入 ActiveX 连接库并且查找是否存在 DllRegisterServer或者 DllUnregisterServer 这两个函数如果有则执行之所以代码没有什么好解释的唯一不同之处在于我为这两个菜单项加入了图像利用 SetMenuItemBitmaps 函数这两个图像是作为资源连接到最终的 DLL 中的如果你还不明白怎样在 Delphi 程序中加入资源那么我就简要说明一下 1 准 备 好 两 个14*14的 小 图 像如 果 不 嫌 麻 烦 的 话也 不 妨 用GetMenuCheckMarkDimensions 函数确认一下是否为这个大小 2 建立一个文本

43、文件修改它的内容如下 101 BITMAP reg.bmp 102 BITMAP unreg.bmp 然后把它保存为 ExtraRes.rc使用其他名称亦可但不要和项目重名 3 从 IDE 菜单中选择 Project-Add to Project将文件类型改为 Resource File(*.rc)选择刚才保存的.RC 文件即可 resourcestring /菜单标题和提示字符串资源 sCopyAnywhere=复制到.;sCopyAnywhereTip=将选定的文件复制到任何路径下;sRegister=注册.;sRegisterTip=注册 ActiveX 库;sUnregister=取消

44、注册.;sUnregisterTip=取消注册 ActiveX 库;sImagePreview=预览图片文件;sImagePreviewTip=预览图片文件;function TYHContextMenu.QueryContextMenu(Menu:HMENU;indexMenu,idCmdFirst,idCmdLast,uFlags:UINT):HResult;var Added:UINT;hbmReg,hbmUnreg:HBITMAP;begin if(uFlags and CMF_DEFAULTONLY)=CMF_DEFAULTONLY then begin Result:=Make_H

45、Result(SEVERITY_SUCCESS,FACILITY_NULL,0);Exit;end;Added:=0;/加入 CopyAnywhere 菜单项的代码略 if FFileList.Count=1 then begin /单一文件 if IsActiveLib(FFileList0)then begin /AcitveX Library InsertMenu(Menu,indexMenu+Added,mfSeparator,0,nil);InsertMenu(Menu,indexMenu+Added,mfString,idCmdFirst+idUnregister,PChar(sU

46、nregister);InsertMenu(Menu,indexMenu+Added,mfString,idCmdFirst+idRegister,PChar(sRegister);InsertMenu(Menu,indexMenu+Added,mfSeparator,0,nil);Inc(Added,4);hbmReg:=LoadImage(HInstance,MakeIntResource(101),IMAGE_BITMAP,0,0,LR_LOADMAP3DCOLORS);hbmUnreg:=LoadImage(HInstance,MakeIntResource(102),IMAGE_BI

47、TMAP,0,0,LR_LOADMAP3DCOLORS);SetMenuItemBitmaps(Menu,idCmdFirst+idRegister,MF_BYCOMMAND,hbmReg,hbmReg);SetMenuItemBitmaps(Menu,idCmdFirst+idUnregister,MF_BYCOMMAND,hbmUnreg,hbmUnreg);end;end else begin /多个文件 end;Result:=Make_HResult(SEVERITY_SUCCESS,FACILITY_NULL,idMenuRange);end;/=/IContextMenu:Inv

48、okeCommand/=function TYHContextMenu.InvokeCommand(var lpici:TCMInvokeCommandInfo):HResult;begin Result:=E_INVALIDARG;if HiWord(Integer(lpici.lpVerb)0 then Exit;case LoWord(Integer(lpici.lpVerb)of idCopyAnywhere:DoCopyAnywhere(lpici.hwnd,FFileList);idRegister:RegisterActiveLib(lpici.hwnd,FFileList0);

49、idUnregister:UnregisterActiveLib(lpici.hwnd,FFileList0);end;Result:=NOERROR;end;/=/IContextMenu:GetCommandString/=function TYHContextMenu.GetCommandString(idCmd,uType:UINT;pwReserved:PUINT;pszName:LPSTR;cchMax:UINT):HResult;var strTip:string;wstrTip:WideString;begin strTip:=;Result:=E_INVALIDARG;if(

50、uType and GCS_HELPTEXT)GCS_HELPTEXT then Exit;case idCmd of idCopyanywhere:strTip:=sCopyAnywhereTip;idRegister:strTip:=sRegisterTip;idUnregister:strTip:=sUnregisterTip;end;if strTip then begin if(uType and GCS_UNICODE)=0 then begin /Ansi lstrcpynA(pszName,PChar(strTip),cchMax);end else begin /Unicod