Your Ad Here
首页 | 编程语言 | 网站建设 | 游戏天堂 | 冲浪宝典 | 网络安全 | 操作系统 | 软件时空 | 硬件指南 | 病毒相关 | IT 认证
软讯网络 > 编程语言 > .NET > C#.NET > Delphi实现shell扩展
【标  题】：Delphi实现shell扩展
【关键字】：Delphi,shell
【来  源】：http://blog.csdn.net/xkdcc/archive/2006/12/09/1435951.aspx

Delphi实现shell扩展

Your Ad Here

        转贴自网上余昊 的pdf格式，经过自己的整理，放于此共享。本博客转贴文章无意侵犯版权，如有，请先通知，本博客会即刻处理

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; stdcall;

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);

  assert(sl<>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: 是一些标志位。

Ø         返回值：函数的返回值应该是你加入的菜单个数和其他一些标志的组合。

示例代码： QueryContextMenu

const

  // 菜单类型

  mfString = MF_STRING or MF_BYPOSITION;

  mfOwnerDraw = MF_OWNERDRAW or MF_BYPOSITION;

  mfSeparator = MF_SEPARATOR or MF_BYPOSITION;

 

  // 菜单项

  idCopyAnywhere = 0; // 复制（移动）

  idRegister = 5; //注册ActiveX

  idUnregister = 6; //取消注册ActiveX

  idImagePreview = 10; //预览图片文件

  idMenuRange = 90;

 

// 在SDK中是使用宏Make_HRESULT实现的，Delphi没有宏的概念，所以这里用函数

function Make_HResult(sev, fac, code: Word): DWord;

begin

  Result := (sev shl 31) or (fac shl 16) or code;

end;

 

function TCCContextMenu.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;

 

  // 加入CopyAnywhere菜单项

  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;

 

 

 

接下来实现第二个函数：InvokeCommand

这是在用户点击菜单时调用，是真正执行动作的地方。

示例代码： InvokeCommand

function TCCContextMenu.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);

end;

Result := NOERROR;

end;

 

procedure DoCopyAnywhere(Wnd: HWND; sl: TStringList);

var

  frm: TfrmCopyAnywhere;

begin

  frm := TfrmCopyAnywhere.Create(Application);

  try

frm.AddFiles(sl);

frm.ShowModal;

  finally

frm.Free;

  end;

end;

 

TfrmCopyAnywhere是界面，使用SHFileOperation来执行Copies, moves, renames, or deletes a file system object，据说好用。

 

OK，接下来实现第三个函数，也是这个接口的最后一个函数：GetCommandString

当用户选择菜单项时，在资源管理器的状态栏会显示一些提示信息，这里需要注意Unicode/Ansi的区别。

示例代码： GetCommandString

function TCCContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;

var

  strTip: String;

  wstrTip: 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 //Anse

begin

  lstrcpynA(pszName, PChar(strTip), cchMax);

end

else

begin

  wstrTip := strTip;

  lstrcpynW(PWideChar(pszName), PWideChar(wstrTip), cchMax);

end;

Result := S_OK;

  end;

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

    reg: TRegistry;

begin

    reg := TRegistry.Create;

    with reg do

    begin

try

RootKey := Root;

if OpenKey(Path, False) then

begin

      if ValueExists(ValueName) then DeleteValue(ValueName);

      CloseKey;

end;

finally

    Free;

end;

    end;

end;

 

const

RegPath = ‘*\shellex\ContextMenuHandlers\CCShellExt’;

ApprovedPath = ‘Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved’;

 

var

strGUID: String;

begin

  inherited;

  strGUID := GUIDToString(Class_CCContextMenu);

  if Register then

  begin

CreateRegKey(RegPath, ‘‘, strGUID);

CreateRegKey(ApprovedPath, strGUID, ‘CC的外壳扩展’, HKEY_LOCAL_MACHINE);

  end

  else

  begin

DeleteRegKey(RegPath);

DeleteRegValue(ApprovedPath, strGUID, HKEY_LOCAL_MACHINE);

  end;

end;

 

现在，在添加新的全局对象初始化：

示例代码：

initialization

  TCCContextMenuFactory.Create(ComServer, TCCContextMenu, Class_CCContextMenu,    '', '', ciMultiInstance, tmApartment);

  TTypedComObjectFactory.Create(ComServer, TCCContextMenu, Class_CCContextMenu,

    ciMultiInstance, tmApartment);

 

然后，只要在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

  sCopyAnywhere = ‘复制到... ‘;

  sCopyAnywhereTip = ‘将选定的文件复制到任何路径下’;

  sRegister = ‘注册...’;

  sRegisterTip = ‘注册ActiveX库’;

  sUnregister = ‘取消注册...’;

  sUnregisterTip = ‘取消注册ActiveX库’;

  sImagePreview = ‘预览图片文件’;

  sImagePreviewTip = ‘预览图片文件’;

 

function IsActiveLib(const FileName: String): Boolean;

var

  Ext: String;

  hLib: THandle;

begin

  Result := False;

  Ext := UpperCase(ExtractFileExt(FileName));

  if (Ext<>‘.EXE’) and (Ext<>‘.DLL’) and (Ext<>‘.OCX’) then Exit;

 

  hLib := LoadLibrary(PChar(FileName));

  if hLib=0 then Exit;

  if GetProcAddress(hLib, ‘DllRegisterServer’)<>nil then Result := True;

  FreeLibrary(hLib);

end;

 

procedure RegisterActiveLib(Wnd: HWND; const FileName: String);

var

  hLib: THandle;

  fn : TDllRegisterServer;

  hr: HResult;

begin

  hLib := LoadLibrary(PChar(FileName));

  if hLib=0 then

  begin

ReportWin32Error(Wnd, ‘装载文件失败’, GetLastError);

Exit;

  end;

 

  fn := TDllRegisterServer(GetProcAddress(hLib, ‘DllRegisterServer’));

  if not Assigned(fn) then

  begin

MessageBox(Wnd, ‘定位函数入口点DllRegisterServer失败’, ‘错误’, MB_ICONEXCLAMATION);

FreeLibrary(hLib);

Exit;

  end;

 

  hr := fn();

  if Failed(hr) then

  begin

ReportWin32Error(Wnd, ‘注册动态库失败’, hr);

FreeLibrary(hLib);

Exit;

  end;

 

  MessageBox(Wnd, ‘注册成功’, ‘成功, MB_ICONINFORMATION);

FreeLibrary(hLib);

end;

 

procedure UnregisterActiveLib(Wnd: HWND; const FileName: String);

var

  hLib: THandle;

  fn : TDllRegisterServer;

  hr: HResult;

begin

  hLib := LoadLibrary(PChar(FileName));

  if hLib=0 then

  begin

ReportWin32Error(Wnd, ‘装载文件失败’, GetLastError);