Delphi-PRAXiS
Seite 5 von 5   « Erste     345   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Programm von Dienst starten lassen (Jetzt aber wirklich mal) (https://www.delphipraxis.net/109191-programm-von-dienst-starten-lassen-jetzt-aber-wirklich-mal.html)

CodeX 29. Nov 2011 07:23

AW: Programm von Dienst starten lassen (Jetzt aber wirklich mal)
 
Zitat:

Zitat von kuba (Beitrag 1138333)
hier ganz ohne JEDI:
...
Habe diesen Code umgebaut, funktioniert ab Windows 2000, ohne Admin Rechte ....

Ohne Deinen Code Zeile für Zeile zu analysieren: Geht damit jetzt mehr als mit meinem Code hier aus diesem Thread, außer dass es ohne JEDI geht?
Für mich wäre ja ein wünschenswerter Fortschritt, dass der Service die Anwendung nicht mit System-Rechten, sondern mit Administratorrechten des eingeloggten Benutzers startet (selbstredend ohne UAC auszulösen). Lässt sich recht leicht über den Task-Manager überprüfen. Dort sollte bei den Prozessen bei Benutzername der eingeloggte Benutzer stehen und kein leeres Feld.

Wie ich gerade lese, hat Dezipaitor geschrieben, dass man über das LinkedToken an das AdminToken ja kommen würde, es aber nicht verwendbar ist. Vielleicht lässt sich ja doch irgendwie was machen? Immerhin stehen System-Rechte zur Verfügung!

nytaiceman 22. Mai 2012 12:52

AW: Programm von Dienst starten lassen (Jetzt aber wirklich mal)
 
Hat jemand von euch diesen Code unter Windows 7 / 2008R2 (also je in 64bit) erfolgreich verwendet?
Ich kriege das nicht zum Laufen.

Nach etwas Recherche, gibt es ein Problem, weil der Code von einem 32bit Dienst gestartet wird, man aber auf 64bit Infos zugreifen möchte.
Das Problem liegt genauer beim Verwenden von "WTSQueryUserToken". Es gibt einen Blog Eintrag zu diesem Thema, das bringt mich mit meinem bisherigen Kenntnissen aber nicht weiter: http://www.remkoweijnen.nl/blog/2011...ion-of-2003xp/

Kann jemand Licht ins Dunkle bringen und hat ein Stückchen Code dazu?


Zitat:

Zitat von kuba (Beitrag 1138333)

hier ganz ohne JEDI:

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 CreateUserProcess(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  : THandle;
  ReturnLength,
  Environment: Pointer;
  StartupInfo: {$IFDEF UNICODE}TStartupInfoW{$ELSE}TStartupInfoA{$ENDIF};
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(GetShellProcName, hUserToken);
  end;
  if Result then
      try
        if CreateEnvironmentBlock(@Environment, hUserToken, false) then
        try
          ZeroMemory(@StartupInfo, sizeof(StartupInfo));
          StartupInfo.cb := SizeOf(StartupInfo);
          StartupInfo.lpDesktop := 'winsta0\default';
          StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
          StartupInfo.wShowWindow := SW_SHOWDEFAULT;
          Result := CreateProcessAsUser
          (hUserToken,
          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(hUserToken);
  end;
end;
kuba


kuba 22. Mai 2012 20:37

AW: Programm von Dienst starten lassen (Jetzt aber wirklich mal)
 
Zitat:

Zitat von nytaiceman (Beitrag 1167596)
Hat jemand von euch diesen Code unter Windows 7 / 2008R2 (also je in 64bit) erfolgreich verwendet?
Ich kriege das nicht zum Laufen.

Nach etwas Recherche, gibt es ein Problem, weil der Code von einem 32bit Dienst gestartet wird, man aber auf 64bit Infos zugreifen möchte.
Das Problem liegt genauer beim Verwenden von "WTSQueryUserToken". Es gibt einen Blog Eintrag zu diesem Thema, das bringt mich mit meinem bisherigen Kenntnissen aber nicht weiter: http://www.remkoweijnen.nl/blog/2011...ion-of-2003xp/

Kann jemand Licht ins Dunkle bringen und hat ein Stückchen Code dazu?


Zitat:

Zitat von kuba (Beitrag 1138333)

hier ganz ohne JEDI:

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 CreateUserProcess(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  : THandle;
  ReturnLength,
  Environment: Pointer;
  StartupInfo: {$IFDEF UNICODE}TStartupInfoW{$ELSE}TStartupInfoA{$ENDIF};
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(GetShellProcName, hUserToken);
  end;
  if Result then
      try
        if CreateEnvironmentBlock(@Environment, hUserToken, false) then
        try
          ZeroMemory(@StartupInfo, sizeof(StartupInfo));
          StartupInfo.cb := SizeOf(StartupInfo);
          StartupInfo.lpDesktop := 'winsta0\default';
          StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
          StartupInfo.wShowWindow := SW_SHOWDEFAULT;
          Result := CreateProcessAsUser
          (hUserToken,
          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(hUserToken);
  end;
end;
kuba


Bei mir läuft das mit 64 Bit, falls dir was fehlt sende mir PN...
Hilft dir das weiter ?

Delphi-Quellcode:
const
  WTSQueryUserToken    : function(SessionId: Cardinal; var hToken: THandle): Boolean; stdcall = nil;
KUBA

kuba 24. Mai 2012 10:42

AW: Programm von Dienst starten lassen (Jetzt aber wirklich mal)
 
Liste der Anhänge anzeigen (Anzahl: 1)
OK,

habe ein funktionierendes Projekt angehängt, basierend auf den NT-Service von Assarbard. Programme die Administratorrechte zum Start benötigen, können mit CreateProcessElevated (von Zacherl) gestartet werden.

Installation mit service1.exe /i oder /ia, deinstallation mit /u

Gegenüber der JEDI Version wird hier nicht die Registry "verbogen" und das Programm läuft auch mit dem passenden Environment des Benutzers.

kuba

Fuchtel 5. Aug 2014 08:19

AW: Programm von Dienst starten lassen (Jetzt aber wirklich mal)
 
Ich muß diesen Thread noch mal hervorholen.

Ich habe einen Service, der Programme starten soll. Und zwar soll er die Programme unter dem Accaunt starten, unter dem er selbst angemeldet ist. Soweit erstmal läuft es.

Aus dem Service bekomme ich die SECURITY_LOGON_SESSION_DATA:
Delphi-Quellcode:
  PSECURITY_LOGON_SESSION_DATA = ^SECURITY_LOGON_SESSION_DATA;
  _SECURITY_LOGON_SESSION_DATA = record
    Size                 : ULONG;                
    LogonId              : LUID;                    // LUID of the logon session.
    UserName             : LSA_UNICODE_STRING;      // Account name of the logon session.
    LogonDomain          : LSA_UNICODE_STRING;      // Domain used to authenticate the owner of session.
    AuthenticationPackage : LSA_UNICODE_STRING;      
    LogonType            : SECURITY_LOGON_TYPE;    
    Session              : ULONG;                   // A Terminal Services session identifier.
    Sid                  : PSID;                    // A pointer to the user's security identifier (SID).

    ...

  end;
  SECURITY_LOGON_SESSION_DATA = _SECURITY_LOGON_SESSION_DATA;
Lauft der Service auf Session = 0 ist ja alles kein Problem.
Lauft der Service aber auf Session = 1 tritt folgendes Problem auf:

Delphi-Quellcode:
...
    Result := WTSQueryUserToken(WTSGetActiveConsoleSessionId, hUserToken);
    If not Result then
      Log('        => WTSQueryUserToken ERROR: ' +  SysErrorMessage(GetLastError));
...
erzeugt verständlicherweise die Fehlermeldung:
Code:
         => WTSQueryUserToken ERROR: Dem Client fehlt ein erforderliches Recht
In MSDN sthet ja auch drinnen:
Code:
...
the calling application must be running within the context of the LocalSystem account and have the SE_TCB_NAME privilege.
...

Ich suche jetzt eine Möglichkeit irgendwie anders mit den obigen Daten an hUserToken heranzukommen.

Danke für die Bemühungen,
Fuchtel


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:26 Uhr.
Seite 5 von 5   « Erste     345   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz