Programm vom Dienst starten mit mehr Rechten???

[pate444]

Hi,

ich habe mal deinen Code ohne die Anwendung der Jedi-Units umgeschrieben. Evtl. benötigt den noch irgendwer.

Code:

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;


function CreateProcess4LoggedOnUser(const cmd: String): Cardinal;


implementation

{$R *.dfm}

uses
  TlHelp32;


function CreateProcess4LoggedOnUser(const cmd: String): Cardinal;
var
  hToken : THandle;
  newToken : THandle;
  blub : Cardinal;
  aSessionId : Cardinal;
  aStartup : Windows.TStartupInfo;
  aPI : Windows.TProcessInformation;
  MyEnv : Pointer;
  bla : DWORD;
  f: textfile;
  root: string;
var
  CreateEnvironmentBlock: function(lpEnvironment: PPointer; hToken: THandle;
    bInherit: BOOL): BOOL; stdcall;
  WTSGetActiveConsoleSessionId: function: DWord; stdcall;
  DestroyEnvironmentBlock: function(lpEnvironment: Pointer): BOOL; stdcall;
begin
  @CreateEnvironmentBlock :=
    GetProcAddress(LoadLibrary('userenv.dll'), 'CreateEnvironmentBlock');
  @WTSGetActiveConsoleSessionId :=
    GetProcAddress(LoadLibrary('kernel32.dll'), 'WTSGetActiveConsoleSessionId');
  @DestroyEnvironmentBlock :=
    GetProcAddress(LoadLibrary('userenv.dll'), 'DestroyEnvironmentBlock');

  result := 0;
  root:= 'D:\temp.txt';
  assignfile(f, root);
  rewrite(f);
  writeln(f, datetimetostr(now())+ ' - Report des Dienstes:');
  if Windows.OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, hToken) then
  begin
    Writeln(f, 'OpenProcessToken Ok');
    if Windows.ImpersonateLoggedOnUser(hToken) then
    begin
      WriteLn(f,'ImpersonateLoggedOnUser Ok');
      if Windows.DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil, SecurityImpersonation, TOKENPRIMARY, newToken) then
      begin
        WriteLn(f,'DuplicateTokenEx Ok');
        aSessionId := WTSGetActiveConsoleSessionId;
        bla := DWORD(aSessionId);
        if Windows.SetTokenInformation(newToken, Windows.TokenSessionId, @bla, SizeOf(DWORD)) then //Hier wird ein Fehler ausgelöst: (Error-Code 1314): Dem Client fehlt ein erforderliches Recht
        begin
          WriteLn(f,'SetTokenInformation Ok');

          FillChar(aStartup,SizeOf(TStartupInfo),#0);
          FillChar(aPI,SizeOf(TProcessInformation),#0);
          aStartup.cb := SizeOf(TStartupInfo);
          aStartup.lpDesktop := 'WinSta0\Default';

          MyEnv := nil;
          // Umgebungsvariablen werden vom Benutzer ermittelt.
          if CreateEnvironmentBlock(@MyEnv, newToken, false) then
          begin
            WriteLn(f,'CreateEnvironmentBlock Ok');
            if Windows.CreateProcessAsUser(newToken, pChar(cmd),
                nil, nil, nil, true,
                NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE or CREATE_UNICODE_ENVIRONMENT,
                MyEnv, nil, aStartup ,aPI) then
            begin
              WriteLn(f,'CreateProcessAsUser Ok');
              CloseHandle(aPI.hProcess);
              CloseHandle(aPI.hThread);
            end
            else
            begin
              result := GetLastError;
              WriteLn(f,'7: '+Sysutils.SysErrorMessage(result));
            end;

            DestroyEnvironmentBlock(MyEnv);
          end
          else
          begin
            blub := Windows.GetLastError;
            WriteLn(f,'CreateEnvironmentBlock('+IntToStr(blub)+'): ' + Sysutils.SysErrorMessage(blub));
          end;
        end
        else
        begin
          blub := Windows.GetLastError;
          WriteLn(f,'SetTokenInformation('+IntToStr(blub)+'): ' + Sysutils.SysErrorMessage(blub));
        end;
      end
      else
        WriteLn(f,'DuplicateTokenEx: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
    end
    else
      WriteLn(f,'ImpersonateLoggedOnUser: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
  end
  else
    WriteLn(f,'OpenProcessToken: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
  close(f);
end;

end.