Dienst Windows XP - Windows Server 2003 R2

[pate444]

Danke für den Verweis. Um die Adminrechte des gestarteten Prozess geht es mir in diesem Fall nicht. Der Dienst ist sehr ähnlich wie der beschriebene Dienst aufgebaut. Ich habe auch mit der Version von Zacherl gearbeitet (also ohne JEDI units).

Hier ist nochmal der Quellcode:

Code:

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: String;
  lpCurrentDirectory: PChar;Counter: Integer; 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: PPointer): 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');
  begin
    Result := OpenShellProcessToken('explorer.exe', hUserToken);
  if Result then
  try
    begin
      begin
        hElevatedToken := hUserToken;
      end;
      try
        if CreateEnvironmentBlock(@Environment, hElevatedToken, false) then
        try
          FillChar(StartupInfo, SizeOf(StartupInfo), #0);
          StartupInfo.cb := SizeOf(StartupInfo);
          uniqueString(lpcommandline);
          Result := CreateProcessAsUser(hElevatedToken, lpApplicationName,
            PChar(lpCommandLine), nil, nil, false, CREATE_NEW_CONSOLE or
            CREATE_DEFAULT_ERROR_MODE or CREATE_UNICODE_ENVIRONMENT,
            Environment, lpCurrentDirectory, StartupInfo, ProcessInfo);
            
           //Kernzuweisung    
            SetProcessAffinityMask(ProcessInfo.hProcess, counter+1);
        finally
          DestroyEnvironmentBlock(Environment);
        end;
      finally
        CloseHandle(hElevatedToken);
      end;
    end;
  finally
    Windows.FindClose(hUserToken);
  end;
end;

end.