AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Programm von Dienst starten lassen (Jetzt aber wirklich mal)

Programm von Dienst starten lassen (Jetzt aber wirklich mal)

Ein Thema von CodeX · begonnen am 25. Feb 2008 · letzter Beitrag vom 5. Aug 2014
Antwort Antwort
Seite 5 von 5   « Erste     345
CodeX

Registriert seit: 30. Okt 2004
458 Beiträge
 
Delphi 10.3 Rio
 
#41

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

  Alt 29. Nov 2011, 07:23
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!
Nur Delphi schafft es, einem ein Lächeln zu schenken, wenn man sich beim Schreiben von := vertippt und stattdessen ein :) erscheint.
  Mit Zitat antworten Zitat
nytaiceman

Registriert seit: 15. Dez 2005
Ort: Schweiz, Bern
57 Beiträge
 
Delphi XE3 Professional
 
#42

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

  Alt 22. Mai 2012, 12:52
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?



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
Einfach ist nur einfach, wenn Einfach auch einfach ist!
Vermeintlich einfache Workarounds führen irgendwann zu Problemen!
  Mit Zitat antworten Zitat
Benutzerbild von kuba
kuba

Registriert seit: 26. Mai 2006
Ort: Arnsberg
552 Beiträge
 
Delphi XE7 Professional
 
#43

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

  Alt 22. Mai 2012, 20:37
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?



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
Stefan Kubatzki
E=mc2

Geändert von kuba (22. Mai 2012 um 20:43 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von kuba
kuba

Registriert seit: 26. Mai 2006
Ort: Arnsberg
552 Beiträge
 
Delphi XE7 Professional
 
#44

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

  Alt 24. Mai 2012, 10:42
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
Angehängte Dateien
Dateityp: zip service1.zip (674,6 KB, 77x aufgerufen)
Stefan Kubatzki
E=mc2

Geändert von kuba (24. Mai 2012 um 16:39 Uhr)
  Mit Zitat antworten Zitat
Fuchtel

Registriert seit: 9. Nov 2005
Ort: Bamberg
50 Beiträge
 
Delphi 2005 Personal
 
#45

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

  Alt 5. Aug 2014, 08:19
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:06 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf