1.
准备工作
1.
对注册表做一些工作。因为任何外壳扩展都是作为DLL加载到Explorer的进程空间的,如果不做手脚,那么,只要Explorer存在,那么你就无法顺利编译shell程序。建议使用Windows优化大师,选中“启动系统时为桌面和Explorer创建独立的进程”
2.
下载DebugView来调试外壳扩展程序。
3.
一定要处理你能够处理的所有错误。因为,你知道,Explorer在Windows中的重要性,你稍不留神就崩掉的话,恐怕没人敢用你的外壳程序了
2.
需求
1.
对任何文件可以进行Copy(Move) to Anywhere。参考软件Nuts
& Bolt。
2.
对于COM组件库,能够实现Register/Unregister功能。
3.
对于图片文件,能在Context Menu中预览。参考软件PicaView。
3.
搭建框架
因为任何外壳扩展都是COM组件,所以,需要建立一个ActiveX
Library,以及一个COM Object。另外,外壳扩展需要对Delphi生成的代码进行额外处理才能成为一个外壳扩展COM组件,即从TComObjectFactory派生一个类才行。
4.
接口支持需求
绝大多数外壳程序需要支持基本的接口:IShellExtInit
另外,对于每一种扩展,我们还需要实现一到两个接口。
对于Context Menu,必须支持的两个接口是:IShellExtInit
和 IContextMenu
如果要支持自绘式菜单,还需要支持的接口:IContextMenu2
或者 IContextMenu3
5.
解决继承接口的命名冲突
示例代码:使用语法解决继承接口的命名冲突 |
TCCContextMenu = class(TComObject, IShellExtInit) private FFileList: TStringList; FGraphic: TGraphic; protected { IShellExtInit接口 function IShellExtInit.Initialize = SEInitialize; function SEInitialize(pidFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; public procedure Initialize; override; destructor Destroy; override; |
代码分析:
1)
为什么重载了TComObj的Initialize和Destroy而不是Create?
因为TComObj有多个构造函数,但是无论哪个,都会调用Initialize,所以,这里是初始化的最好地方。
6.
实现Initialize、Destroy和IShellExtInit.Initialize
Initialize和Destroy很简单,可以加入打印的调试信息,便于观察外壳扩展的生命周期;主要是实现IShellExtInit.Initialize。
IShellExtInit.Initialize的三个参数中,最重要的是系统传递给我们的IDataObject,我们可以从中获得用户选择的文件列表。
示例代码:IShellExtInit.Initialize.可以被任何实现IShellExtInit的类所调用 |
function TCCContextMenu.SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; begin Result := GetFileListFromDataObject(lpdobj, FFileList); end;
function GetFileListFromDataObject(lpdobj: IDataObject; sl: TStringList): HResult; var fe: FormatEtc; sm: StgMedium; i, iFileCount: Integer; FileName: array[0..MAX_PATH+1] of char; begin assert(lpdobj<>nil); sl.clear;
with fe do begin cfFormat := CF_HDROP; ptd := nil; dwAspect := 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 iFileCount-1 do begin DragQueryFile(sm.hGlobal, i, FileName, sizeof(FileName)); sl.Add(FileName); end;
ReleaseStgMedium(sm); Result := S_OK; end; |
7.
实现对IContextMenu的支持
IContextMenu有三个方法,首先讲菜单弹出前系统调用的方法:QueryContextMenu
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HRESULT; stdcall;
Ø
Menu:
就是系统开发给你的上下文菜单的句柄,可以用InsertMenu或者InsertMenuItem之类的函数向里面增加菜单
Ø
indexMenu:
系统预留给你的菜单项的位置,你应该从这个位置开始加入菜单,但是加入的菜单项个数不要超过idCmdLast-idCmdFirst这个范围
Ø
uFlags:
是一些标志位。
Ø
返回值:函数的返回值应该是你加入的菜单个数和其他一些标志的组合。
示例代码: |
const
// function Make_HResult(sev, fac, code: Word): DWord; begin end;
function TCCContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; var begin Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL, 0); Exit;
end;
|
接下来实现第二个函数:InvokeCommand
这是在用户点击菜单时调用,是真正执行动作的地方。
示例代码: |
function TCCContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; begin idCopyAnywhere: end; Result := NOERROR; end;
procedure DoCopyAnywhere(Wnd: HWND; sl: TStringList); var begin frm.AddFiles(sl); frm.ShowModal; frm.Free; end; |
TfrmCopyAnywhere是界面,使用SHFileOperation来执行Copies,
moves, renames, or deletes a file system object,据说好用。
OK,接下来实现第三个函数,也是这个接口的最后一个函数:GetCommandString
当用户选择菜单项时,在资源管理器的状态栏会显示一些提示信息,这里需要注意Unicode/Ansi的区别。
示例代码: |
function TCCContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): var begin idCopyAnywhere: strTip := sCopyAnywhereTip; if (uType and GCS_UNICODE)=0 then //Anse begin end else begin end; Result := S_OK; end; |
8.
实现Context Menu Extension的类工厂
如果没有实现Context Menu Extension的类工厂,那么期待已久的shell扩展还是没法实现
这里需要处理很多注册表,幸好Delphi有几个好函数,所以可以省很多功夫。
示例代码:实现Context Menu Extension的类工厂 |
procedure TCCContextMenuFactory.UpdateRegistry(Register: Boolean);
procedure DeleteRegValue(const Path, ValueName: String; Root: DWord=HKEY_CLASSES_ROOT); var begin try RootKey := Root; if OpenKey(Path, False) then begin end; finally end; end;
const RegPath = ‘*/shellex/ContextMenuHandlers/CCShellExt’; ApprovedPath = ‘Software/Microsoft/Windows/CurrentVersion/ShellExtensions/Approved’;
var strGUID: String; begin CreateRegKey(RegPath, ‘‘, strGUID); CreateRegKey(ApprovedPath, strGUID, ‘CC的外壳扩展’, DeleteRegKey(RegPath); DeleteRegValue(ApprovedPath, strGUID, HKEY_LOCAL_MACHINE); end; |
现在,在添加新的全局对象初始化:
示例代码: |
initialization |
然后,只要在IDE中执行Run->Register
ActiveX Server命令,就可以在资源管理器中检阅自己的劳动成果了
9.
实现ActiveX的注册/反注册功能
我们这里还实现了从菜单对选择的单一exe/ocx文件进行注册的功能。这主要就是载入ActiveX库,然后调用DllRegisterServer或者DllUnregisterServer。这样,需要修改原来实现的接口的代码。
同时,这里为注册和反注册菜单加入了两个图标,使用SetMenuItemBitmaps函数实现。
先讲一下,如何在Delphi中加入资源:
Ø
准备两个14*14的图像(如果不嫌麻烦的话,可以用GetMenuCheckMarkDimensions确认下是否为这个大小)
Ø
建立一个文本文件,写入:
101 BITMAP “reg.bmp”
102 BITMAP “unreg.bmp”
然后保存为ExtraRes.rc。(其他名称也行,但是不要和项目中的文件重复)
Ø
从IDE中选择菜单Add
to Project,选择即可。
主要代码如下:
示例代码: 实现注册/反注册功能。4个方法:IsActiveLib,RegisterActiveLib,UnregisterActiveLib,ReportWin32Error |
resourcestring
function IsActiveLib(const FileName: String): Boolean; var begin end;
procedure RegisterActiveLib(Wnd: HWND; const FileName: String); var begin ReportWin32Error(Wnd, ‘装载文件失败’, Exit; MessageBox(Wnd, ‘定位函数入口点DllRegisterServer失败’, FreeLibrary(hLib); Exit;
ReportWin32Error(Wnd, ‘注册动态库失败’, FreeLibrary(hLib); Exit;
FreeLibrary(hLib); end;
procedure UnregisterActiveLib(Wnd: HWND; const FileName: String); var begin ReportWin32Error(Wnd, ‘装载文件失败’, Exit;
MessageBox(Wnd, ‘定位函数入口点DllUnregisterServer’失败’, FreeLibrary(hLib); Exit;
ReportWin32Error(Wnd, ‘取消注册动态库失败’, FreeLibrary(hLib); Exit;
FreeLibrary(hLib); end;
prcedure var begin end; |
10.
加入图像预览功能
IContextMenu虽然能支持普通的菜单项,但是无法处理自绘制的菜单(Owner-Draw)。即使用MF_OWNERDRAW加入菜单也不行,因为自绘制菜单的处理,最终要由Exploer的窗口进行,而IContextMenu没有提供一条截获窗口过程对菜单的处理。微软然后加入了IContextMenu2和IContextMenu2,但是IContextMenu2好像还是没有起作用,所以,我们用IContextMenu3来实现。
主要代码如下:
示例代码:IContextMenu3.HandleMenuMsg2 |
function TCCContextMenu.HandleMenuMsg2(uMsg: UINT; wParam, lParam: Integer; var lpResult: Integer): HResult; var begin WM_MEASUREITEM: begin end; end; WM_DRAWITEM: begin pdis := PDrawItemStruct(lParam); end; end;
procedure DrawGraphic(adc: HDC; rc: TRect; State: Integer; Graphic: TGraphic); var begin Left := rc.Left + 10; Right := rc.Right – 10; Top := rc.Top + 10; Bottom := rc.Bottom – 30; with rcText do Left := rc.Left + 10; Right := rc.Right – 10; Top := rc.Top - 20; Bottom := rc.Bottom; nSaveDC := SaveDC(adc); Canvas.Handle := adc; with Canvas do begin end; finally Canvas.Handle :=0; Canvas.Free; RestoreDC(adc, nSaveDC); end; end;
function ImageInfoToStr(Graphic: TGraphic): String; begin begin pf15bit, pf16bit: Result := Result + ‘16位色; pf24bit: Result := Result + ‘24位色; pf32bit: Result := Result + ‘32位色; end; Result := Result + ‘位图’; end;
if Graphic is TMetaFile then begin end;
if Graphic is TJPEGImage then begin end; end; |