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
![Antworten [gesperrt]](./graphics/navbar/reply.png)
