Programm von Dienst starten lassen (Jetzt aber wirklich mal)

[CodeX]

Klar doch.

[Olli]

Laß es ihn doch selber posten

[Dezipaitor]

Wäre mein nächster Vorschlag gewesen.
Hast du Lust einen Artikel über deinen Code zu posten auf : http://blog.delphi-jedi.net/

[CodeX]

Ja, kann ich machen. Dann brauch ich einen Login, oder?
Kannst mir die Login-Daten per PN schicken. Ich versuche, den Artikel noch heute zu verfassen, da ich ab morgen eine Woche unterwegs bin und keine Zeit haben werde. Sollte das heute nicht mehr klappen, dann mache ich das in einer Woche.

[Dezipaitor]

statt "is2000"
if TJwWindowsVersion.IsWindows2000(false)then vorher noch
uses ..., JwsclVersion;

[himitsu]

Zitat von Dezipaitor:

if TJwWindowsVersion.IsWindows2000(false)then

So langsam kann man sich soeine Abfrage auch sparen.

Delphi 2010 setzt ja schon mindestens ein WinNT (das hat eh keiner und's nächste der NT-Reihe war schon die 2000) oder gar ein XP voraus.

[Dezipaitor]

Jo, aber der Code läuft noch mit JWSCL unter D6.

[kuba]

Zitat von Dezipaitor:

Jo, aber der Code läuft noch mit JWSCL unter D6.

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;

Habe diesen Code umgebaut, funktioniert ab Windows 2000, ohne Admin Rechte ....

kuba

[squetk]

Wo kann man die Funktion GetShellProcName finden?

[Sir Rufo]

Zitat von squetk:

Wo kann man die Funktion GetShellProcName finden?

Über die Suchfunktion?