delphi - COM Elevation Moniker 在 Vista/Windows 7 下无法提升服务器

标签 delphi winapi windows-7 com windows-vista

我创建了一个需要提升的本地 COM 服务器,并且应该从非提升的进程内部实例化。

使用MSDN's article on the COM elevation moniker ,我已经按照指定的要求配置了服务器类。服务器已在 HKLM 配置单元中成功注册。

代码示例:

procedure CoCreateInstanceAsAdmin(const Handle: HWND;
      const ClassID, IID: TGuid; PInterface: PPointer);
var
  rBindOpts: TBindOpts3;
  sMonikerName: WideString;
  iRes: HRESULT;
begin
  ZeroMemory(@rBindOpts, Sizeof(TBindOpts3));
  rBindOpts.cbStruct := Sizeof(TBindOpts3);
  rBindOpts.hwnd := Handle;
  rBindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;  
  sMonikerName := 'Elevation:Administrator!new:' + GUIDToString(ClassID);
  iRes := CoGetObject(PWideChar(sMonikerName), @rBindOpts, IID, PInterface);
  OleCheck(iRes);
end;

class function CoIMyServer.Create: IMyServer;
begin
  CoCreateInstanceAsAdmin(HInstance, CLASS_IMyServer, IMyServer, @Result);
end;

当涉及到CoGetObject(PWideChar(sMonikerName), @rBindOpts, IID, PInterface)时,我得到UAC屏幕并确认以管理员身份运行服务器。但是,OleCheck(iRes) 返回:“请求的操作需要提升”错误。

来自that article我读过有关“过肩(OTS)抬高”的内容。

这是让我的服务器实例可用于非提升进程的唯一方法吗?如果是这样,什么时候应该在服务器上调用CoInitializeSecurity

<小时/>

完整的注册详细信息

HKLM\SOFTWARE\Wow6432Node\Classes\CLSID
    {MyServer CLSID}
        (Default) = IMyServer Object  
        LocalizedString = @C:\Program Files (x86)\MyServer\MyServer.exe,-15500  
    Elevation
        Enabled = 0x000001 (1)  
    LocalServer32
        (Default) = C:\PROGRA~2\MyServer\MYSERVER.EXE  
    ProgID
        (Default) = uMyServer.IMyServer  
    TypeLib
        (Default) = {TypeLib GUID}  
    Version
        (Default) = 1.0  

HKLM\SOFTWARE\Wow6432Node\Classes\Interface
    {GUID of IID_IMyServer}
        (Default) = IMyServer  
    ProxyStubClsid32
        (Default) = {Some GUID}  
    TypeLib
        (Default) = {TypeLib GUID}  
        Version = 1.0

以上是注册服务器后存在于我的注册表中的唯一条目。

<小时/>

其他详细信息

尝试隐式调用CoInitializeSecurity()但没有成功+使用以下代码按照建议设置午餐权限:

function GetSecurityDescriptor(const lpszSDDL: LPWSTR; out pSD: PSecurityDescriptor): Boolean;
begin
  Result := ConvertStringSecurityDescriptorToSecurityDescriptorW(lpszSDDL, SDDL_REVISION_1,
    pSD, nil);
end;

function GetLaunchActPermissionsWithIL(out pSD: PSecurityDescriptor): Boolean;
var
  lpszSDDL: LPWSTR;
begin
  // Allow World Local Launch/Activation permissions. Label the SD for LOW IL Execute UP
  lpszSDDL := 'O:BAG:BAD:(A;;0xb;;;WD)S:(ML;;NX;;;LW)';
  Result := GetSecurityDescriptor(lpszSDDL, pSD);
end;

function GetAccessPermissionsForLUAServer(out pSD: PSecurityDescriptor): Boolean;
var
  lpszSDDL: LPWSTR;
begin
  // Local call permissions to IU, SY
  lpszSDDL := 'O:BAG:BAD:(A;;0x3;;;IU)(A;;0x3;;;SY)';
  Result := GetSecurityDescriptor(lpszSDDL, pSD);
end;

function SetAccessPermissions(hAppKey: HKEY; pSD: PSECURITY_DESCRIPTOR): Boolean;
var
  dwLen: DWORD;
  iRes: LONG;
begin
  dwLen := GetSecurityDescriptorLength(pSD);
  iRes := RegSetValueExA(hAppKey, 'AccessPermission', 0, REG_BINARY, pSD, dwLen);
  Result := iRes = ERROR_SUCCESS;
end;

function SetLaunchActPermissions(hAppKey: HKEY; pSD: PSECURITY_DESCRIPTOR): Boolean;
var
  dwLen: DWORD;
  iRes: LONG;
begin
  dwLen := GetSecurityDescriptorLength(pSD);
  iRes := RegSetValueExA(hAppKey, 'LaunchPermission', 0, REG_BINARY, pSD, dwLen);
  Result := iRes = ERROR_SUCCESS;
end;

procedure Initialize;
var
  pSD: PSecurityDescriptor;
  sSubKey: WideString;
  hAppKey: HKEY;
begin
  sSubKey := 'AppID\{GUID}';
  RegOpenKeyW(HKEY_CLASSES_ROOT, PWideChar(sSubKey), hAppKey);
  if GetAccessPermissionsForLUAServer(pSD) then
    if not SetAccessPermissions(hAppKey, pSD) then
      raise Exception.Create(Format('Access permissions aren''t set. System error: %d',
        [GetLastError()]));

  pSD := nil;
  if GetLaunchActPermissionsWithIL(pSD) then
    if not SetLaunchActPermissions(hAppKey, pSD) then
      raise Exception.Create(Format('Launch permissions aren''t set. System error: %d',
        [GetLastError()]));
end;

initialization
  TAutoObjectFactory.Create(ComServer, TMyServer, Class_IMyServer,
    ciMultiInstance, tmApartment);
  Initialize;  

作为 AppID GUID,我尝试使用服务器接口(interface)的相同 CLSID GUID 和新生成的 GUID:结果是相同的。 服务器注册后,AccessPermissionLaunchPermission 值出现在指定位置。

还尝试过:

  • 在 AppId 键中指定 ROTFlags = 1
  • 将服务器构建为 64 位应用程序

我手动创建的其他注册表项/值:

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AppID\MyServer.exe]
@="MyServer"
"AppID"="{My GUID}"
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\AppID\{My GUID}]
@="MyServer"
"ROTFlags"=dword:00000001
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{My GUID}]
@="MyServer Object"
"AppID"="{My GUID}"

最佳答案

您犯的一个错误是您传递了 RTL 的全局 HInstance 变量,而 CoGetObject() 需要一个 HWNDHINSTANCE 句柄不是有效的 HWND 句柄。您需要使用实际的 HWND,例如 TFormHandle 属性,或者指定 0 让海拔名字为您选择合适的窗口。

至于ERROR_ELEVATION_REQUIRED返回值,我只能说你的COM注册可能在某个地方不完整。请显示实际存储在注册表中的完整注册详细信息(不是您的代码认为它存储的内容 - 注册表实际存储的内容)。

CoInitializeSecurity() 应在服务器进程开始运行时调用。

关于delphi - COM Elevation Moniker 在 Vista/Windows 7 下无法提升服务器,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9289527/

相关文章:

delphi - 如何从TActionManager获取所有TAction?

Delphi SVN 集成可以与 SVN 1.7 一起使用吗?

winapi - FindFirstFile(Ex)通配符

c++ - FindAtom 和 MAKEINTATOM 没用?

c# - 在哪里可以找到 Visual C# Express 2010 中的“查看选项卡顺序”?

delphi - Delphi 中的 Vista 语音识别

delphi - 为什么我不能在接收数组参数的函数中使用 SetLength?

c++ - 我想在系统重新启动时重新启动我的应用程序

windows-7 - 无法在端口 25 上连接 smtp 服务器

windows - windows下有没有类似VI的编辑器?