我们有一个服务应用程序,它在控制台会话 (WTSGetActiveConsoleSessionId) 中生成一个进程,以允许以桌面控件样式访问机器。这在大多数情况下都很有效,但是就 CreateProcessAsUser 的结果而言,有些 VM 似乎成功地创建了进程,但是没有创建进程。
该服务在 LocalSystem 帐户下运行。正在启动的进程尚未运行。没有病毒防护程序正在运行。我们只在 Windows Server 2008 R2 上看到过这种行为(但这并不是说它是唯一的)。
我们使用的代码如下:
function StartProcessInSession(strProcess: String; bLocalSystem: Boolean = True; iSessionID: Integer = -1): Boolean;
procedure SPISLog(strLog: String; bError: Boolean = False);
begin
Log(strLog);
if bError then Abort;
end;
var pi: PROCESS_INFORMATION;
si: STARTUPINFO;
winlogonPid, dwSessionId: DWord;
hUserToken, hUserTokenDup, hPToken, hProcess: THANDLE;
dwCreationFlags: DWORD;
tp: TOKEN_PRIVILEGES;
lpenv: Pointer;
bError: Boolean;
strClone: String;
begin
if GetProcessID(strProcess, iSessionID) > 0 then
begin
Result := True;
Exit;
end;
Result := False;
bError := False;
if not InitProcLibs then Exit;
if bLocalSystem then strClone := 'winlogon.exe' else strClone := 'explorer.exe';
winlogonPid := GetProcessID(strClone, iSessionID);
try
dwSessionId := WTSGetActiveConsoleSessionId();
dwCreationFlags := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE;
ZeroMemory(@si, sizeof(STARTUPINFO));
si.cb := sizeof(STARTUPINFO);
si.lpDesktop := PChar('Winsta0\Default');
ZeroMemory(@pi, sizeof(pi));
hProcess := OpenProcess(MAXIMUM_ALLOWED, FALSE, winlogonPid);
if (not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY or TOKEN_DUPLICATE or
TOKEN_ASSIGN_PRIMARY or TOKEN_ADJUST_SESSIONID or TOKEN_READ or TOKEN_WRITE, hPToken)) then
bError := True;
if bError then SPISLog('SPIS - OpenProcessToken failed (' + SysErrorMessage(GetLastError) + ').', True);
if (not LookupPrivilegeValue(nil, SE_DEBUG_NAME, tp.Privileges[0].Luid)) then bError := True;
if bError then SPISLog('SPIS - LookupPrivilegeValue failed (' + SysErrorMessage(GetLastError) + ').', True);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
DuplicateTokenEx(hPToken, MAXIMUM_ALLOWED, nil, SecurityIdentification, TokenPrimary, hUserTokenDup);
SetTokenInformation(hUserTokenDup, TokenSessionId, Pointer(dwSessionId), SizeOf(DWORD));
if (not AdjustTokenPrivileges(hUserTokenDup, FALSE, @tp, SizeOf(TOKEN_PRIVILEGES), nil, nil)) then bError := True;
if bError then SPISLog('SPIS - AdjustTokenPrivileges failed (' + SysErrorMessage(GetLastError) + ').', True);
if (GetLastError() = ERROR_NOT_ALL_ASSIGNED) then bError := True;
if bError then SPISLog('SPIS - AdjustTokenPrivileges: ERROR_NOT_ALL_ASSIGNED (' + SysErrorMessage(GetLastError) + ').', True);
lpEnv := nil;
if (CreateEnvironmentBlock(lpEnv, hUserTokenDup, TRUE)) then
dwCreationFlags := dwCreationFlags or CREATE_UNICODE_ENVIRONMENT
else
lpEnv := nil;
if not Assigned(lpEnv) then SPISLog('SPIS - CreateEnvironmentBlock failed (' + SysErrorMessage(GetLastError) + ').', True);
try
UniqueString(strProcess);
if not CreateProcessAsUser(hUserTokenDup, nil, PChar(strProcess), nil, nil, FALSE,
dwCreationFlags, lpEnv, PChar(ExtractFilePath(strProcess)), si, pi) then bError := True;
if bError then
SPISLog('SPIS - CreateProcessAsUser failed (' + SysErrorMessage(GetLastError) + ').', True)
else
SPISLog('Started process in ' + IntToStr(dwSessionId) + ' using token from ' + IntToStr(winlogonPid) + '.');
try
try CloseHandle(hProcess); except {} end;
try CloseHandle(hUserToken); except {} end;
try CloseHandle(hUserTokenDup); except {} end;
try CloseHandle(hPToken); except {} end;
except
{}
end;
finally
DestroyEnvironmentBlock(lpEnv);
end;
except
on E: Exception do
begin
bError := True;
if not (E is EAbort) then
SPISLog('SPIS - ' + E.Message + ' (' + SysErrorMessage(GetLastError) + ').', True);
end;
end;
Result := not bError;
end;
function GetProcessID(strProcess: String; iSessionID: Integer = -1): DWORD;
var dwSessionId, winlogonSessId: DWord;
hsnap: THandle;
procEntry: TProcessEntry32;
myPID: Cardinal;
begin
Result := 0;
if not InitProcLibs then Exit;
{ check running processes and return ID of process in current session... }
if iSessionID = -1 then
dwSessionId := WTSGetActiveConsoleSessionId
else
dwSessionId := iSessionID;
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnap = INVALID_HANDLE_VALUE) then Exit;
strProcess := UpperCase(ExtractFileName(strProcess));
myPID:= GetCurrentProcessId;
procEntry.dwSize := sizeof(TProcessEntry32);
if (not Process32First(hSnap, procEntry)) then Exit;
repeat
if (procEntry.th32ProcessID <> myPID) and ((UpperCase(procEntry.szExeFile) = strProcess) or
(UpperCase(ExtractFileName(procEntry.szExeFile)) = strProcess)) then
begin
winlogonSessId := 0;
if (ProcessIdToSessionId(procEntry.th32ProcessID, winlogonSessId) and (winlogonSessId = dwSessionId)) then
begin
Result := procEntry.th32ProcessID;
break;
end;
end;
until (not Process32Next(hSnap, procEntry));
end;
有谁知道它为什么会失败,或者是否有办法通过这个调用来解决 API 中发生的事情?