转贴自网上余昊 的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);

Exit;

  end;

 

  fn := TDllUnregisterServer(GetProcAddress(hLib, ‘DllUnregisterServer’));

  if not Assigned(fn) then

  begin

MessageBox(Wnd, ‘定位函数入口点DllUnregisterServer’失败’, ‘错误’, 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;

 

prcedure  ReportWin32Error(Wnd: HWND; const Prefix: String; dwError: DWord);

var

  szError: array[0..399] of char;

  str: String;

begin

  FormatMessage(FROMAT_MESSAGE_FROM_SYSTEM, nil, dwError, Make_LangID(LANG_NEUTRAL, SUBLANG_DEFAULT), szError, sizeof(szError), nil);

  str := Format(‘%s:%s’, [Prefix, StrPas(szError)]);

  MessageBox(Wnd, PChar(str), ‘ 错误’, MB_ICONEXCLAMATION);

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

  pmis: PMeasureItemStruct;

  pdis: PDrawItemStruct;

begin

  Result := S_OK;

  case uMsg of

WM_MEASUREITEM:

begin

  pmis := PMeasureItemStruct(lParam);

  if not Assigned(FGraphic) then

  begin

    pmis.itemWidth := 120;

    pmis.itemHeight := 120;

    Exit;

  end;

  // 如果图片小于120*120，那么按照实际的显示，否则缩放到120*120

  if (FGraphic.Width<=120) and (FGraphic.Height<=120) then

  begin

    pmis.itemWidth := 140;

    pmis.itemHeight := FGraphic.Height + 40;

  end

  else

  begin

    pmis.itemWidth := 140;

    pmis.itemHeight := 160;

end;

end;

WM_DRAWITEM:

begin

pdis := PDrawItemStruct(lParam);

  DrawGraphic(pdis.hDC, pdis,rcItem, pdis.itemState, FGraphic);

end;

  end;

end;

 

procedure DrawGraphic(adc: HDC; rc: TRect; State: Integer; Graphic: TGraphic);

var

  rcImage, rcText, rcStretch: TRect;

  Canvas: TCanvas;

  nSaveDC: Integer;

  x, y: Integer;

  xScale, yScale, Scale: Double;

  xStretch, yStretch: Integer;

begin

  with rcImage do

  begin

Left := rc.Left + 10;

Right := rc.Right – 10;

Top := rc.Top + 10;

Bottom := rc.Bottom – 30;

  end;

　with rcText do

  begin

Left := rc.Left + 10;

Right := rc.Right – 10;

Top := rc.Top - 20;

Bottom := rc.Bottom;

  end;

 

  Canvas := TCanvas.Create;

  nSaveDC := 0;

  try

nSaveDC := SaveDC(adc);

Canvas.Handle := adc;

with Canvas do

begin

  if not Assigned(Graphic) then

  begin

    Rectangle(rcImage);

    MoveTo(rcImage.Left, rcImage.Top);

    LineTo(rcImage.Right, rcImage.Bottom);

    MoveTo(rcImage. Right, rcImage.Top);

    LineTo(rcImage. Left, rcImage.Bottom);

    DrawText(Canvas.Handle, ‘ 未知图像’, -1, rcImage, DT_SINGLELINE or DT_CENTER or DT_VECNTER);

  end

  else

  begin

    if (Graphic.Width<rcImage.Right-rcImage.Left) and (Graphic.Height<rcImage.Bottom-rcImage.Top) then

    begin

      x := rcImage.Left + (rcImage.Right - rcImage.Left - Graphic.Width) div 2;

      y := rcImage. Top + (rcImage. Bottom - rcImage. Top - Graphic. Height) div 2;

      Canvas.Draw(x, y, Graphic);

    end

    else

    begin

      xScale := Graphic.Width / (rcImage.Right - rcImage.Left);

      yScale := Graphic.Height / (rcImage.Bottom - rcImage.Top);

      Scale := Max(xScale, yScale);

      xStretch := Trunc(Graphic.Width / Scale);

      yStretch := Trunc(Graphic. Height / Scale);

      x := rcImage.Left + (rcImage.Right - rcImage.Left - xStretch) div 2;

      y := rcImage. Top + (rcImage. Bottom - rcImage. Top - yStretch) div 2;

      rcStretch := Rect(x, y, x+xStretch, y+yStretch);

      Canvas.StretchDraw(rcStretch, Graphic);

    end;

    Windows.FillRect(Canvas.Handle, GetSysColor(COLOR_MENUTEXT));

    SetBkColor(Canvas. Handle, PChar(ImageInfoToStr(Graphic)), -1, rcText, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

  end;

end;

finally

Canvas.Handle :=0;

Canvas.Free;

RestoreDC(adc, nSaveDC);

end;

end;

 

function ImageInfoToStr(Graphic: TGraphic): String;

begin

  Result := Format(‘%d * %d’, [Graphic.Width, Graphic.Height]);

  if Graphic is TIcon then Result := Result + ‘ 图标’;

  if Graphic is TBitmap then

begin

  case TBitmap(Graphic).PixelFormat of

    pfDevice: Result := Result + ‘DDB’;

    pf1bit: Result := Result + ‘2色;

    pf4bit: Result := Result + ‘16色;

    pf8bit: Result := Result + ‘256色;

pf15bit, pf16bit: Result := Result + ‘16位色;

pf24bit: Result := Result + ‘24位色;

pf32bit: Result := Result + ‘32位色;

  pfCustom: Result := Result + ‘ 自定义’;

end;

Result := Result + ‘位图’;

end;

 

if Graphic is TMetaFile then

begin

  Result := Result + Format(‘(%d*%d) 元文件’, [TMetaFile(Graphic),MMWidth div 100, TMetaFile(Graphic).MMHeight div 100])

end;

 

if Graphic is TJPEGImage then

begin

  case TJPEGImage(Graphic).PixelFormat of

    jf24Bit: Result := Result + ‘24 位色JPEG’;

    jf8Bit: Result := Result + ‘8 位色JPEG’;

  end;

end;

end;