Service: UAC Elevated Child Prozess im Benutzerkontext starten

[Zacherl]

Hallo zusammen,

nachdem ich nun fast 4 Stunden herumprobiert habe, poste ich hier mal eine Lösung, mit der man aus einem Dienst heraus einen Prozess mit UAC Elevation starten kann. Ist der momentan eingeloggte Benutzer kein Administrator, wird der Prozess mit eingeschränkten Rechten gestartet.

Das Besondere an dieser Lösung ist, dass der neu erzeugte Prozess auch wirklich im Kontext des Benutzers und nicht als SYSTEM läuft.

Delphi-Quellcode:

function OpenShellProcessToken(ProcessName: String;
  var hToken: THandle): Boolean;
var
  hSnapshot,
  hProcess: THandle;
  Process: TProcessEntry32;
begin
  Result := false;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapshot <> 0) and (hSnapshot <> INVALID_HANDLE_VALUE) then
  try
    FillChar(Process, SizeOf(Process), #0);
    Process.dwSize := SizeOf(Process);
    if Process32First(hSnapshot, Process) then
    repeat
      if (AnsiLowerCase(Process.szExeFile) =
        AnsiLowerCase(ProcessName)) then
      begin
        hProcess :=
          OpenProcess(PROCESS_ALL_ACCESS, false, Process.th32ProcessID);
        if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
        try
          Result := OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken);
        finally
          CloseHandle(hProcess);
        end;
        Break;
      end;
    until (not Process32Next(hSnapshot, Process));
  finally
    CloseHandle(hSnapshot);
  end;
end;

function CreateProcessElevated(lpApplicationName: PChar; lpCommandLine: PChar;
  lpCurrentDirectory: PChar; var ProcessInfo: TProcessInformation): Boolean;
var
  WTSGetActiveConsoleSessionId: function: DWord; stdcall;
  WTSQueryUserToken: function(SessionId: ULONG;
    var phToken: THandle): BOOL; stdcall;
  CreateEnvironmentBlock: function(lpEnvironment: PPointer; hToken: THandle;
    bInherit: BOOL): BOOL; stdcall;
  DestroyEnvironmentBlock: function(lpEnvironment: LPVOID): BOOL; stdcall;
var
  hUserToken,
  hLinkedToken,
  hElevatedToken: THandle;
  ReturnLength,
  ElevationType: DWord;
  Environment: Pointer;
  StartupInfo: TStartupInfo;
begin
  Result := false;
  @CreateEnvironmentBlock :=
    GetProcAddress(LoadLibrary('userenv.dll'), 'CreateEnvironmentBlock');
  @DestroyEnvironmentBlock :=
    GetProcAddress(LoadLibrary('userenv.dll'), 'DestroyEnvironmentBlock');
  if (not Assigned(CreateEnvironmentBlock)) or
    (not Assigned(DestroyEnvironmentBlock)) then Exit;
  @WTSGetActiveConsoleSessionId :=
    GetProcAddress(LoadLibrary('kernel32.dll'), 'WTSGetActiveConsoleSessionId');
  @WTSQueryUserToken :=
    GetProcAddress(LoadLibrary('wtsapi32.dll'), 'WTSQueryUserToken');
  if (Assigned(WTSGetActiveConsoleSessionId) and
    Assigned(WTSQueryUserToken)) then
  begin
    Result := WTSQueryUserToken(WTSGetActiveConsoleSessionId, hUserToken);
  end else
  begin
    Result := OpenShellProcessToken('explorer.exe', hUserToken);
  end;
  if Result then
  try
    if GetTokenInformation(hUserToken, TokenElevationType, @ElevationType,
      SizeOf(ElevationType), ReturnLength) then
    begin
      if (ElevationType = 3) then
      begin
        if GetTokenInformation(hUserToken, TokenLinkedToken,
          @hLinkedToken, SizeOf(hLinkedToken), ReturnLength) then
        try
          Result := DuplicateTokenEx(hLinkedToken, MAXIMUM_ALLOWED, nil,
            SecurityImpersonation, TokenPrimary, hElevatedToken);
        finally
          CloseHandle(hLinkedToken);
        end;
      end else
      begin
        hElevatedToken := hUserToken;
      end;
      try
        if CreateEnvironmentBlock(@Environment, hElevatedToken, false) then
        try
          FillChar(StartupInfo, SizeOf(StartupInfo), #0);
          StartupInfo.cb := SizeOf(StartupInfo);
          Result := CreateProcessAsUser(hElevatedToken, lpApplicationName,
            lpCommandLine, nil, nil, false, CREATE_NEW_CONSOLE or
            CREATE_DEFAULT_ERROR_MODE or CREATE_UNICODE_ENVIRONMENT,
            Environment, lpCurrentDirectory, StartupInfo, ProcessInfo);
        finally
          DestroyEnvironmentBlock(Environment);
        end;
      finally
        CloseHandle(hElevatedToken);
      end;
    end;
  finally
    CloseHandle(hUserToken);
  end;
end;

Lauffähig sollte das ganze ab Windows 2000 sein.

Viele Grüße
Zacherl