Mega Code Archive
Waiting till an application ends
<![CDATA[
Title: Waiting till an application ends
Question: How can I stop my app until a called application ends?
Answer:
If we ever need to run an external application and wait until it terminates, then we would have to do without ShellExecute and resort to more basic functions, like CreateProcess, WaitForSingleObject and CloseHandle:
procedure TForm1.Button1Click(Sender: TObject);
var
proc_info: TProcessInformation;
startinfo: TStartupInfo;
begin
// Initialize the structures
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
// Attempts to create the process
if CreateProcess('c:\windows\notepad.exe', nil, nil,
nil, false, NORMAL_PRIORITY_CLASS, nil, nil,
startinfo, proc_info) False then begin
// The process has been successfully created
// No let's wait till it ends...
WaitForSingleObject(proc_info.hProcess, INFINITE);
// Process has finished. Now we should close it.
CloseHandle(proc_info.hProcess);
Application.MessageBox('Notepad finished!',
'Info', MB_ICONINFORMATION);
end else begin
// Failure creating the process
Application.MessageBox('Couldn''t execute the '
+ 'application', 'Error', MB_ICONEXCLAMATION);
end;//if
end;
PROBLEMS
We have experienced problems with WaitForSingleObject in combination
with certain applications and we had to finish them with the Task
Manager. Other applications apparently fail to finish correctly and
WaitForSingleObject never returns. Appart from that, an application
does not respond to events while it waits and for example the forms
won't repaint... A possible workaround to these problems is checking
the status of the launched application (calling GetExitCodeProcess)
at intervals (in a timer event for example).
type
TForm1 = class(TForm)
btnExecute: TButton;
btnCancel: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: LongWord;
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
btnCancel.Enabled := False;
Timer1.Enabled := False;
Timer1.Interval := 200;
end;
procedure TForm1.btnExecuteClick(Sender: TObject);
begin
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
if CreateProcess(nil, 'c:\windows\notepad.exe', nil,
nil, false, CREATE_DEFAULT_ERROR_MODE
+ NORMAL_PRIORITY_CLASS, nil, nil, startinfo,
proc_info) then begin
btnExecute.Enabled := False;
btnCancel.Enabled := True;
Timer1.Enabled := True;
end else begin
CloseHandle(proc_info.hProcess);
Application.MessageBox('Couldn''t execute the application',
'Error', MB_ICONEXCLAMATION);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if GetExitCodeProcess(proc_info.hProcess, ExitCode)
then
if ExitCode = STILL_ACTIVE then
Timer1.Enabled := True
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
CloseHandle(proc_info.hProcess);
end
else begin
btnCancel.Enabled := False;
btnExecute.Enabled := True;
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
end;
end;
procedure TForm1.btnCancelClick(Sender: TObject);
begin
Timer1.Enabled := False;
if Application.MessageBox('You should try to finish'
+ ' the application normally.'#13#13'Terminate it '
+ 'anyway?', 'Warning', MB_YESNO + MB_DEFBUTTON2 +
MB_ICONQUESTION + MB_TASKMODAL) = ID_YES then begin
TerminateProcess(proc_info.hProcess, 0);
CloseHandle(proc_info.hProcess);
btnCancel.Enabled := False;
btnExecute.Enabled := True;
end else begin
Timer1.Enabled := True;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if btnCancel.Enabled then begin
btnCancelClick(Sender);
if btnCancel.Enabled then CanClose := False;
end;
end;
]]>