Einzelnen Beitrag anzeigen

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