[高分/在线]参考Windows外壳扩展编程入门实例写的程序，为什么TYHContextMenuFactory.UpdateRegistry不被调用不会被调用？

Question

就想在右键里面加一个按钮，但是每次都能注册上，每次都没有任何反应。所有函数我都输出到debugview，但是每次都没有反应。谢谢！

Answer 1

这是我简单修改了的代码：unit YHCMImpl;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
  Windows, ActiveX, Classes, ComObj, StdVcl,Messages,SysUtils, ShellAPI, ShlObj, Graphics, JPEG, Registry;type
  TYHContextMenu = class(TComObject,IShellExtInit)
  private
    FFileList : TStringList; //存放文件列表
    FGraphic : TGraphic; //用于执行图片预览的动作
  protected
    { IShellExtInit 接口 }
    function IShellExtInit.Initialize = SEInitialize;
    function SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;hKeyProgID: HKEY): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
  public
    procedure Initialize; override;
    destructor Destroy; override;
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;    
  end;    TYHContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;
const
  Class_YHContextMenu: TGUID = '{0C228FF2-015A-410B-8B67-DF489E9A53F9}';
  
  // 菜单类型
  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;implementationuses ComServ;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;function TYHContextMenu.SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
begin
  OutputDebugString('YHContextMenu::SEInitialize');//向调试器发送一个字符串，告知调试信息。
 //Result := GetFileListFromDataObject(lpdobj, FFileList);
 Result := S_OK ;
end;procedure TYHContextMenu.Initialize;
begin
  OutputDebugString('YHContextMenu::Initialize');//向调试器发送一个字符串，告知调试信息。
  inherited;
  FFileList := TStringList.Create;
  FGraphic := nil;
end;destructor TYHContextMenu.Destroy;
begin
  OutputDebugString('YHContextMenu::Destroy');
  FreeAndNil(FFileList);
  FreeAndNil(FGraphic);
  inherited;
end;// 在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 TYHContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
  Added: UINT;
begin
  OutputDebugString('YHContextMenu::QueryContextMenu');//向调试器发送一个字符串，告知调试信息。
  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, '你好！');
  InsertMenu(Menu, indexMenu, mfSeparator, 0, nil);
  Inc(Added, 3);  Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL, idMenuRange);
end;procedure DoCopyAnywhere(Wnd: HWND; sl: TStringList);
begin
    OutputDebugString('YHContextMenu::DoCopyAnywhere');//向调试器发送一个字符串，告知调试信息。
end;function TYHContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
  OutputDebugString('YHContextMenu::InvokeCommand');//向调试器发送一个字符串，告知调试信息。
  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;function TYHContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
var
  strTip: String;
  wstrTip: WideString;
begin
  OutputDebugString('YHContextMenu::GetCommandString');//向调试器发送一个字符串，告知调试信息。
  strTip := '';
  Result := E_INVALIDARG;
  if (uType and GCS_HELPTEXT)<> GCS_HELPTEXT then Exit;
  case idCmd of
  idCopyAnywhere: strTip := 'hehe';
  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;procedure DeleteRegValue(const Path, ValueName: String; Root: DWord=HKEY_CLASSES_ROOT);
var
  reg: TRegistry;
begin
  OutputDebugString('YHContextMenu::DeleteRegValue');//向调试器发送一个字符串，告知调试信息。
  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;procedure TYHContextMenuFactory.UpdateRegistry(Register: Boolean);
const
  RegPath = '*/shellex/ContextMenuHandlers/CCShellExt';
  ApprovedPath = 'Software/Microsoft/Windows/CurrentVersion/ShellExtensions/Approved';  
var
  strGUID: String;
begin
  OutputDebugString('YHContextMenu::UpdateRegistry');//向调试器发送一个字符串，告知调试信息。
  inherited UpdateRegistry(Register);
  strGUID := GUIDToString(Class_YHContextMenu);
  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
  TComObjectFactory.Create(ComServer, TYHContextMenu, Class_YHContextMenu,
    'YHContextMenu', '', ciMultiInstance, tmApartment);
end.

Answer 2

我使用过以下两种加载方式：1.run->Register Activex Server 2.regsvr32,结果都是一样的！