Möchte hier mal eine recht einfache oder auch andere Art vorstellen eine Datei zu öffnen, und auf die Beendigung des ausführenden Programmes zu warten. Was so z.B mit CreateProcess nicht möglich währe.
Version 1:
Beispiel ist ohne gesonderten Thread für WaitForSingelObject, und daher eher für Testzwecke gedacht. Auch wurden nur die wichtigsten Errormeldungen behandelt. Die Variable Abbrechen ist Optional und wurde mit einem Extra Button auf True gesetzt. ShellApi muß in der Uses Klausel enthalten sein. Für weitere Optionen sollte man sich auch mal die Win-Api Hilfe zu ShellExecuteEx durchlesen.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39:
| var Abbruch: boolean;
function ExecuteAndWait(const Command: String): Integer; var w: Cardinal; ExecuteInfo: TSHELLEXECUTEINFO; begin Result:= -1; FillChar(ExecuteInfo, SizeOf(TSHELLEXECUTEINFO), 0); With ExecuteInfo do begin cbSize:= SizeOf(TSHELLEXECUTEINFO); lpVerb:= 'open'; lpFile:= PChar(Command); nShow:= SW_SHOW; fMask:= SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI; Wnd:= Application.Handle; end;
If ShellExecuteEx(@ExecuteInfo) and (ExecuteInfo.hInstApp> 32) then begin w:= WAIT_FAILED; If ExecuteInfo.hProcess <> 0 then Repeat w:= WaitForSingleObject(ExecuteInfo.hProcess, 1000); Application.ProcessMessages; Until (Abbruch= True) or (w= WAIT_OBJECT_0) or (w= WAIT_ABANDONED) or (w= WAIT_FAILED);
If (w<> WAIT_ABANDONED) and (w<> WAIT_FAILED) then Result:= 1 else Result:= 0; end else Case GetLastError of ERROR_FILE_NOT_FOUND, ERROR_PATH_NOT_FOUND: Result:= -2; ERROR_NO_ASSOCIATION: Result:= -3; end; end; |
Version 2:
Dies ist eine etwas geänderte Version die auch ohne gesonderten Thread gut zu gebrauchen ist, da Sie auf alle Events der Application auch im Wait Status ohne Verzögerung reagiert wie z.B. Paint, Mouse, Keybord etc.
Lest die Hilfe zu „MsgWaitForMultipleObjects“ dort werden die einzelnen Möglichkeiten auf was für Events reagiert werden soll gut beschrieben.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36:
| function ExecuteAndWait(const Command: String): Integer; var w: Cardinal; ExecuteInfo: TSHELLEXECUTEINFO; begin Result:= -1; FillChar(ExecuteInfo, SizeOf(TSHELLEXECUTEINFO), 0); With ExecuteInfo do begin cbSize:= SizeOf(TSHELLEXECUTEINFO); lpVerb:= 'open'; lpFile:= PChar(Command); nShow:= SW_SHOW; fMask:= SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI; Wnd:= Application.Handle; end;
If ShellExecuteEx(@ExecuteInfo) and (ExecuteInfo.hInstApp> 32) then begin w:= WAIT_FAILED; If ExecuteInfo.hProcess <> 0 then Repeat w:= MsgWaitForMultipleObjects(1, ExecuteInfo.hProcess, false ,INFINITE, QS_ALLEVENTS); Application.ProcessMessages; Until (Abbruch= True) or (w= WAIT_OBJECT_0) or (w= WAIT_ABANDONED_0) or (w= WAIT_FAILED);
If (w<> WAIT_ABANDONED_0) and (w<> WAIT_FAILED) then Result:= 1 else Result:= 0; end else Case GetLastError of ERROR_FILE_NOT_FOUND, ERROR_PATH_NOT_FOUND: Result:= -2; ERROR_NO_ASSOCIATION: Result:= -3; end; end; |
Beispiel für den Aufruf, hier wurde aber auf eine Prüfung ob sich das Programm noch im Warte Status befindet verzichtet. Was aber für ein fertiges Programm unbedingt Nötig ist!
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13:
| procedure TForm1.Button1Click(Sender: TObject); begin Abbruch:= false; Case ExecuteAndWait('E:\Temp\Test.mpg') of -3: ShowMessage('Kein Programm mit dieser Dateierweiterung verknüpft.'); -2: ShowMessage('Datei nicht gefunden.'); -1: ShowMessage('Datei konnte nicht geöffnet werden.'); 0: ShowMessage('Auf Prozess kann nicht gewartet werden.'); 1: If not Abbruch then ShowMessage('Ausführendes Programm wurde beendet.') else ShowMessage('Abbruch durch User.') end; end; |
Gruß gispos
Moderiert von Narses: Topic aus Windows API verschoben am Fr 02.11.2007 um 14:46
Moderiert von Narses: Beitragsformatierung überarbeitet