ExecAndWait

[spacewolf]

Hallo wir haben die allgemeingültige ExecAndWait etwas anders gestaltet... (so mit Timeouts usw..)

Delphi-Quellcode:

function ExecAndWait(const AFileName, AParams: String; AShowWindow: Word;
  AWarten: Boolean; AUserName, ADomain, APass: String; AMoniIdx: Integer;
  AWindowName: String; var AExitCode, APId: DWord;
  const ATimeOut: Integer = 0; const ASetForegroundWnd: Boolean = False): Boolean;
var
  SEInfo: TShellExecuteInfo;
  LProcInfo: TProcessInformation;
  Path: String;
begin
  Result := False;

  if GDaProtCreated then
    AddDo('AFileName AParams: ' + AFileName + ' ' + AParams);

  try
    try
      if ExtractFileDir(AFileName) <> '' then begin
        GetDir(0, Path);
        ChDir(ExtractFileDir(AFileName));
      end else
        GetDir(0, Path);
    except end;
    try
      if AUserName <> '' then begin
        //Start Process with Logon - raises Exception if fails
        daCreateProcessWithLogonW(AUserName, ADomain, APass, AFileName, AParams,
          AShowWindow, @LProcInfo);
        SetToMoni(LProcInfo.hProcess);
        WaitForApp(LProcInfo.hProcess);
        CloseHandle(LProcInfo.hProcess);
        CloseHandle(LProcInfo.hThread);
        Result := True;
      end else begin
        FillChar(SEInfo, SizeOf(SEInfo), 0);
        SEInfo.cbSize := SizeOf(TShellExecuteInfo);
        with SEInfo do begin
          fMask := SEE_MASK_NOCLOSEPROCESS OR SEE_MASK_FLAG_NO_UI;
          Wnd := Application.Handle;
          lpFile := PChar(AFileName);
          if AParams = '' then
            lpParameters := nil
          else
            lpParameters := PChar(AParams);
          nShow := AShowWindow;
        end;
        if ShellExecuteEx(@SEInfo) then
        begin
          // nur zum Test:
          if aWarten then
            WaitForSingleObject(SEInfo.hProcess,INFINITE); 

          WaitForApp(SEInfo.hProcess);
          CloseHandle(SEInfo.hProcess);
          Result := True;
        end else begin
          Result := False;
          RaiseLastOSError;
        end;
      end;//ELSE OF if AUserName <> '' then begin
    finally
      try
        ChDir(Path);
      except end;
    end;
  except
    on e:Exception do
      daShowMessage(Format(SPMEErrRunProcess, [ExtractFileName(AFileName)])+#13#10#13#10+
                    SPMErrMsg+ ': '+e.Message+#13#10#13#10+
                    SPMPath+': '+AFileName+#13#10+
                    SPMParams+': '+AParams+#13#10+
                    SPMStatus+': '+IntToStr(AShowWindow)+#13#10+
                    SPMErrCls+': '+e.ClassName);
  end;
end;

In dieser Methode wird ein WaitForApp aufgerufen:

Delphi-Quellcode:

  procedure WaitForApp(const AHdlProcess: Cardinal);
  var
    Window: Cardinal;
    LStart: TDateTime;
  begin
    if AWarten then begin
      LStart := Now;
      if ASetForegroundWnd then
        Window := GetActiveWindow;

      repeat
        Sleep(100);//2004_12_15 to prevent 100% CPU-Usage
        Application.ProcessMessages;
        GetExitCodeProcess(AHdlProcess, AExitCode);
        if (AExitCode <> STILL_ACTIVE) OR Application.Terminated then
          Break;
        //2009.04.05 MET: ATimeOut-Handling
        if (ATimeOut <> 0) AND (Now - LStart >= ATimeOut) then begin
          AExitCode := STATUS_TIMEOUT;
          Break;
        end;
      until True;

      if ASetForegroundWnd then
        SetForegroundWindow(Window);
    end;
  end;

Dieses WaitForApp aber wiederum funktioniert nicht so wie geplant, scheint aus der Funktion herauszuspringen bevor das Programm sich beendet:

Wenn ich nach alter Manier ein: WaitForSingleObject - einfüge funktioniert alles wieder.

So nun meine Frage, kann jemand im WaitForApp - etwas erkennen was da falsch gedacht ist?

der

Andreas

[new32]

Die Schleife hat ne falsche Abbruchbedingung (until true)


für Endlosschleife in Delphi:
while true do ... oder
repeat ... until false;

Code:

do{ ... }while(1)

gibts in pascal glaub ich garnichich.

[Apollonius]

Darf ich mal fragen, wer dieses WaitForApp verbrochen hat? So eine Aufgabe löst man mit MsgWaitForMultipleObjects.

[Meta777]

@new32: genau. muss natürlich repeat..until False sein..

@Apollonius: Überheblichkeit nützt hier nichts . MsgWaitForMultipleObjects ist zudem scheinbar erst ab Win2k verfügbar.

[Apollonius]

Das war lediglich konstruktive Kritik. Ich finde es einfach traurig, den gleichen Polling-Code immer weiter durchs Netz verbreitet zu sehen, wenn die korrekte Variante auch noch kürzer ist. Über die Kompatibilität kann ich nichts sagen. Woher hast du das? Auf der anderen Seite unterstützt Microsoft auch nur noch Windows 2000.

[Dezipaitor]

Für nicht-NT nimm WaitForMultipleObjects und mach ein Timeout rein, bei dem man Application.ProcessMessages aufrufen kann.

Bei NT ist MsgWaitForMultipleObjects die beste Wahl.

Aber wenn du schon CreateProcessWithLogonW verwendest, dann ist die Wahl eh schon getroffen: MsgWaitForMultipleObjects

Update:
Hab gerade mal nach der Funktion in der Delphi 7 Hilfe geschaut. Dort wird MsgWaitForMultipleObjects ab Windows 95 gelistet. Nur Win32s unterstützt sie nicht.

[Meta777]

gut zu wissen das es auch möglich wäre. Aber würde ich nicht letztendlich auch wieder in einer schleife mit WaitFor.. warten? Ok, alternative könnte man das in einem thread auslagern... auf den den man den wiederum warten müsste.... in einer schleife, oder?

Also wenn jmd. ein praktisches beispiel vorschalgen könnte: Nach diesem beitrag ist noch platz im thread

Shalom

EDIT: Es muss unter Win9x auch gehn