Как запустить приложение и дождаться его завершения?
// Способ первый (консольное приложение)
uses
{...,} ShellAPI;
procedure CrProcess(FileName, S, Dir, WindowName: string);
var
SeInfo: TShellExecuteInfo;
ExitCode: DWord;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0);
with SEInfo do
begin
cbSize := SizeOf(TShellExecuteInfo);
fmask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar('"' + FileName + '"');
lpParameters := PChar(S);
lpDirectory := nil;
nShow := SW_HIDE;
end;
if ShellExecuteEx(@SEInfo) then
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
until(FindWindow(nil, PChar(WindowName)) <> 0) or
(ExitCode <> STILL_ACTIVE) or Application.Terminated
else
MessageDlg('Ошибка создания внешнего процесса. Код ошибки: ' + SysErrorMessage(GetLastError), mtError, [mbAbort], 0);
CloseHandle(SEInfo.hProcess);
if FindWindow(nil, PChar(WindowName)) <> 0 then
begin
SendMessage(FindWindow(nil, PChar(WindowName)), WM_CLOSE, 0, 0);
while FindWindow(nil, PChar(WindowName)) <> 0 do
Application.ProcessMessages;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Заархивировать
// CrProcess('путь_к_архиваору_rar', 'a -r0 -m5 ' + 'имя_архива' + #32 + 'имя_каталога' + '*.*', TempPath, '(Сеанс завершен) - Rar');
// Разархивировать
// CrProcess('путь_к_архиваору_rar', 'x -y ' + 'имя_архива' + #32 + 'каталог_куда_разархивировать', '(Сеанс завершен) - Rar');
CrProcess('d:\Program Files\WinRAR\Rar.exe', 'a -r0 -m5 ' + '"c:\test.rar"' + #32 + '"c:\test rar\"' + '*.*', '', '(Сеанс завершен) - Rar');
CrProcess('d:\Program Files\WinRAR\Rar.exe', 'x -y ' + '"c:\test.rar"' + #32 + '"c:\test unrar\"', '', '(Сеанс завершен) - Rar');
end;
// Обратите внимание, используется альтернатива функции WaitForSingleObject(), собственная организация цикла.
// Процедура написана исходя из совместимости со старыми ДОС процессами. ДОС программы не оставляют код завершения
// своего процесса по коду STILL_ACTIVE, а поэтому в таком случае запуск процесса "повиснет", т.е. будет постоянно
// "крутится" в цикле Repeat .. Until(). Для таких случаев преднозначена переменная WindowName. Когда ДОС задача
// завершается, появляется окно "(Сеанс завершён) - Имя_процесса". Используйте эту переменную, если вы запускаете
// ДОС программу, вписав при этом в эту переменную свою строку по аналогии. В этом случае цикл Repeat .. Until()
// оборвётся при наличии такого окна, т.е. когда процесс и завершится. До кучи ещё процедура закроет это окно, чтобы
// предотвратить проблему при многократных запусках.
// Способ второй (CreateProcess)
function ExecAndWait(const FileName, Params: ShortString; const WinState: Word): Boolean; export;
var
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine: ShortString;
begin
CmdLine := '"' + Filename + '" ' + Params;
FillChar(StartInfo, SizeOf(StartInfo), #0);
with StartInfo do
begin
cb := SizeOf(StartInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WinState;
end;
Result := CreateProcess(nil, PChar(String(CmdLine)), nil, nil, false,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(Filename)), StartInfo, ProcInfo);
{ Ожидаем завершения приложения }
if Result then
begin
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ExecAndWait('c:\Windows\System32\calc.exe', '', SW_SHOWNORMAL);
end;
// Способ третий (CreateProcess)
procedure TForm1.Button1Click(Sender: TObject);
var
si: TStartupInfo;
p: TProcessInformation;
begin
FillChar(Si, SizeOf(si), 0);
si.cb := SizeOf(si);
Application.Minimize;
Createprocess(nil, 'notepad.exe', nil, nil, False,
CREATE_DEFAULT_ERROR_MODE, nil, nil, si, p);
WaitForSingleObject(p.hProcess, INFINITE);
CloseHandle(p.hProcess);
Application.Restore;
end;
// Способ четвертый (CreateProcess)
procedure TForm1.Button1Click(Sender: TObject);
var
si: TStartupInfo;
p: TProcessInformation;
begin
FillChar(si, SizeOf(si), 0);
si.cb := SizeOf(si);
if Createprocess(nil, 'notepad.exe', nil, nil, False, 0, nil, nil, si, p) then
begin
CloseHandle(p.hThread);
Waitforsingleobject(p.hProcess, INFINITE);
CloseHandle(p.hProcess);
end;
end;
// Способ пятый (CreateProcess)
function ExecAndWait(const FileName, Params: string): Boolean;
var
pi: TProcessInformation;
si: TStartupInfo;
begin
ZeroMemory(@si, SizeOf(si));
si.cb := SizeOf(si);
if not CreateProcess(PChar(FileName), PChar(Params), nil,
nil, False, 0, nil, nil, si, pi) then
begin
Result := False;
RaiseLastWin32Error;
Exit;
end;
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecAndWait('C:\winnt\system32\calc.exe', '');
end;
// А если заменить WaitForSingleObject(pi.hProcess, INFINITE); на
// while WaitforSingleObject(pi.hProcess, 200) = WAIT_TIMEOUT do
// Application.ProcessMessages;
// то вызывающая программа не будет казаться завешанной
// и будет отвечать на сообщения
function ExecAndWait(const FileName, Params: string): Boolean;
var
pi: TProcessInformation;
si: TStartupInfo;
begin
ZeroMemory(@si, SizeOf(si));
si.cb := SizeOf(si);
if not CreateProcess(PChar(FileName), PChar(Params), nil,
nil, False, 0, nil, nil, si, pi) then
begin
Result := False;
RaiseLastWin32Error;
Exit;
end;
while WaitforSingleObject(pi.hProcess, 200) = WAIT_TIMEOUT do
Application.ProcessMessages;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecAndWait('C:\winnt\system32\calc.exe', '');
end;
// Способ шестой (ShellExecute)
uses
{...,} ShellAPI;
procedure StartAndWait(Name: PChar);
var
ProcInfo: PShellExecuteInfo;
begin
GetMem(ProcInfo, SizeOf(ProcInfo^));
with ProcInfo^ do
begin
Wnd := Application.Handle;
cbSize := SizeOf(ProcInfo^);
lpFile := PChar(Name);
lpParameters := nil;
lpVerb := 'open';
nShow := SW_SHOW;
fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
end;
try
Win32check(ShellExecuteEx(ProcInfo));
while not Application.Terminated and (WaitForSingleObject(ProcInfo.hProcess, 100) = WAIT_TIMEOUT) do
Application.ProcessMessages;
finally
if ProcInfo.hProcess <> 0 then
CloseHandle(ProcInfo.hProcess);
Dispose(ProcInfo);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
(Sender as TControl).Enabled := False;
StartAndWait('notepad.exe');
(Sender as TControl).Enabled := True;
end;
|
