我创建了一个需要提升的本地 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:结果是相同的。
服务器注册后,AccessPermission
和 LaunchPermission
值出现在指定位置。
还尝试过:
- 在 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()
需要一个 HWND
。 HINSTANCE
句柄不是有效的 HWND
句柄。您需要使用实际的 HWND
,例如 TForm
的 Handle
属性,或者指定 0
让海拔名字为您选择合适的窗口。
至于ERROR_ELEVATION_REQUIRED
返回值,我只能说你的COM注册可能在某个地方不完整。请显示实际存储在注册表中的完整注册详细信息(不是您的代码认为它存储的内容 - 注册表实际存储的内容)。
CoInitializeSecurity()
应在服务器进程开始运行时调用。
关于delphi - COM Elevation Moniker 在 Vista/Windows 7 下无法提升服务器,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9289527/