Adminprozess starten und auf dessen Ende warten

[himitsu]

Morschn,

ich wollte eigentlich nur ein kleines Programm starten und auf dessen Ende warten.
Also statt ShellExecute auf CreateProcess umgestiegen und schon läuft, ähhh wartet das.

Nun das Problemchen:
Dieser Prozess hat mit Absicht ein Admin-Manifest, aber CreateProcess bringt nun keinen UAC-Dialog, sondern meckert einfach nur was von ungenügend Rechten, was im Prinzip auch stimmt.

Jetzt könnte ich mir die nötigen Rechte manuell besorgen und das ganze über CreateProcess, CreateProcessAsUser oder CreateProcessWithTokenW starten, was irgendwie bestimmt geht, aber das will ich nucht.
Auch CreateProcessWithLogonW oder LogonUser+CreateProcessWithTokenW will ich nicht unbedingt verwenden, da ich dann einen eigenen Dialog für Nutzername und Passwort bräuchte.
Ich hätte aber gerne stattdessen den UAC-Dialog ... ist sowas denn möglich?
Also sowas wie CreateProcessWithLogonW, aber mit UAC, wo ich dann ein ProcessHandle bekommen und damit dann warten kann?


PS: Es wäre gut, wenn es ohne Jedi oder Sowas ginge, denn nur deswegen sowas Großes hier versuchen einzubauen und eventuell noch ein paar Nebenefekte zu ernten, dann doch lieber der eigene Dialog.

[Relicted]

Juhu,

habe gerade leider keinen Compiler zur Hand daher kann ich es nicht testen:

Delphi-Quellcode:

procedure RunAsAdmin(hWnd: HWND; aFile: string; aParameters: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := sizeof(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;
  if not ShellExecuteEx(@sei) then 
    RaiseLastOSError;
end;

Und dann mit WaitForSingleObject warten?

Gruß,
Reli

[Peter1999]

@Reli: Das funktioniert bei mir nicht ganz aber fast. So gehts aber:

Delphi-Quellcode:

procedure RunAsAdminAndWait(hWnd: HWND; aFile: string; aParameters: string);
var
  sei: TShellExecuteInfo;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := sizeof(sei);
  sei.Wnd := hWnd;
  sei.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas'; // nur unter Vista / Win7 ... XP versteht runas als runasuser
  sei.lpFile := PChar(aFile);
  sei.lpParameters := PChar(aParameters);
  sei.nShow := SW_SHOWNORMAL;
  if ShellExecuteEx(@sei) then
  begin
    WaitForSingleObject(sei.hProcess, INFINITE);
    CloseHandle(sei.hProcess);
  end else
    RaiseLastOSError;

end;

Aufpassen muss man ja leider mit der Änderung des Verbs runas zwischen WinXP und Win7.

Viele Grüße...

[himitsu]

Was passiert denn unter XP, wenn es mit runas gestartzet wird?

Hab's jetzt erstmal so umgesetzt und noch einen Warte/Abbrechdialog integriert, welcher von der Funktion einem Delay(3*60*1000) entspricht, nur eben mit Abbruch, wenn vorher fertig.

Nun muß nur noch ein Problemchen mit dem Netsharelaufwerk gefunden werden.
Das auszuführende Programm wird zwar vorher nach %TEMP% kopiert und dort ausgeführt, aber es muß auf eine Datei im Adminverzeichnis zugreifen, welche dann global installiert werden müste, aber das ist/wird eine andere Frage.

Zumindestens scheint das Programm nun endlich zu starten und das mit UAC.

Delphi-Quellcode:

function DoExecuteAndWait(Filename, Parameter: string; StartParams: TExecuteParams = []): LongWord{ExitCode};
var
  SEI:              TShellExecuteInfo;
  StartInfo:        TStartupInfo;
  ProcInfo:         TProcessInformation;
  LastError, Len:   LongWord;
  Error:            EOSError;
  Dialog:           TForm;
  Title, Username:  string;
  Domain, Password: string;
  Host, Question:   string;
  StartTime:        LongWord;
  Objects:          array[0..1] of THandle;
  Event:            THandle;
begin
  Result := LongWord(-1);
  FillChar(SEI, SizeOf(SEI), 0);
  SEI.cbSize       := SizeOf(SEI);
  SEI.fMask        := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  if epOnlyWaitToIdleInput in StartParams then
    SEI.fMask      := SEI.fMask or SEE_MASK_WAITFORINPUTIDLE;
  SEI.Wnd          := Application.MainFormHandle;
  If epStartWithLogon in StartParams then
    SEI.lpVerb     := 'runas';
  SEI.lpFile       := PChar(Filename);
  SEI.lpParameters := PChar(Parameter);
  SEI.lpDirectory  := PChar(ExtractFileDir(Filename));
  SEI.nShow        := SW_SHOWNORMAL;
  if not ShellExecuteEx(@SEI) then
    RaiseLastOSError;
  try
    if StartParams * [epOnlyWaitToIdleInput, epNoWait] = [] then
      if GetCurrentThreadId = MainThreadID then begin
        Dialog := CreateMessageDialog('Warte auf ' + Filename, mtInformation, [mbAbort]);
        try
          Dialog.Show;
          Title := Dialog.Caption;
          Event := CreateEvent(nil, False, False, nil);  // dieses Event reagiert auf Messages im MainThread
          try
            Objects[0] := Event;
            Objects[1] := SEI.hInstApp;
            while True do begin
              Dialog.Caption := Format('[%ds] ', [LongInt(GetTickCount - StartTime) div 1000]) + Title;
              Application.ProcessMessages;
              if Dialog.ModalResult <> mrNone then
                raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Abbruch durch den Benutzer.');
              if Application.Terminated then
                raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Programm wird beendet');
              case MsgWaitForMultipleObjects(2, Objects, False, 5*60000, QS_ALLINPUT) of
                WAIT_OBJECT_0:   ;       // Programm hat irgendwas zu erledigen
                WAIT_OBJECT_0+1: Break;  // Programm beendet
                WAIT_TIMEOUT:    ;       // 5 Minuten lang nichts passiert? (ich glaub die Welt ist untergegangen)
                WAIT_FAILED:     raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Es war nicht möglich auf die Anwendung zu warten.');
                else             raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Unbekannter Fehler.');
              end;
            end;
            if not GetExitCodeProcess(SEI.hInstApp, Result) then
              Result := LongWord(-1);
          finally
            CloseHandle(Event);
          end;
        finally
          Dialog.Free;
        end;
      end else
        case WaitForSingleObject(SEI.hInstApp, 3*60000) of
          WAIT_OBJECT_0: if not GetExitCodeProcess(SEI.hInstApp, Result) then
                           Result := LongWord(-1);
          WAIT_TIMEOUT:  raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Gestartete Anwendung reagiert nicht. (innerhalb von 3 Minuten)');
          WAIT_FAILED:   begin
                           LastError := GetLastError;
                           raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + SysErrorMessage(LastError));
                         end;
          else           raise Exception.Create('DoExecuteAndWait: ' + Filename + sLineBreak + 'Unbekannter Fehler.');
        end;
  finally
    CloseHandle(SEI.hInstApp);
  end;
  Exit;

(ach ja, nicht wundern, aber ich hab die lokalen Variablen noch nicht aufgeräumt
und ich hasse die Codeformatiewrung im Forum, welche einfah so leerzeichen löscht und die Formatierung zerstört)

[Peter1999]

Unter Win7 bedeutet "runas", dass die UAC anspringt und das Programm als Admin ausgeführt werden kann.

Unter WinXP bedeutet "runas", dass das Auswahlfenster "Anwendung als Nutzer XYZ ausführen" angezeigt wird. Es floppt einem dann also immer sinnlos dieses Fenster entgegen, auch wenn man schon Admin ist.

Microsoft war da leider nicht sonderlich rückwärtskompatibel.

[Relicted]

OT: ich merke irgendwie die rund 3-4 Jahre DP/Foren-Pause ich hab grad tatsächlich den Like Knopf gesucht..

[himitsu]

@Peter1999:
OK, dann wird man auch gefragt, selbst wenn man schon Admin ist, aber ansonsten funktioniert es praktisch genauso, außer daß man eventuell auch keinen Adminbenutzer angeben könnte.
Also prinzipiell ist es auch unter XP funktionsfähig.

@Relicted:
Wie kannst du uns auch nur so vernachlässigen ... schäm dich.

Aber dennoch Danke für die Lösung.
Tausende Varianten und die eine Richtige übersieht man immer.

[Relicted]

Tjo das liegt an keinerlei Delphi Projekten viel C++ und PHP gemacht... Aber jetzt neue Firma neues Glück