Узнать о завершении запущенной программы

Written on . Posted in [Delphi] Приложение

ОГЛАВЛЕНИЕ

16-битная версия

uses Wintypes,WinProcs,Toolhelp,Classes,Forms;

Function WinExecAndWait(Path : string; Visibility : word) : word;
var

InstanceID : THandle;
PathLen : integer;
begin
  { Преобразуем строку в тип PChar }
PathLen := Length(Path);
Move(Path[1],Path[0],PathLen);
Path[PathLen] := #00;
  { Пытаемся запустить приложение }
InstanceID := WinExec(@Path,Visibility);
if InstanceID < 32 then { значение меньше 32 указывает на ошибку приложения }
WinExecAndWait := InstanceID

else begin
Repeat
Application.ProcessMessages;
until Application.Terminated or (GetModuleUsage(InstanceID) = 0);
WinExecAndWait := 32;
end;
end;


32-битная версия

function WinExecAndWait32(FileName:String; Visibility : integer):integer;
var

zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess(nil,
zAppName,                      { указатель командной строки }
nil,                           { указатель на процесс атрибутов безопасности }
nil,                           { указатель на поток атрибутов безопасности }
false,                         { флаг родительского обработчика }
CREATE_NEW_CONSOLE or          { флаг создания }
NORMAL_PRIORITY_CLASS,
nil,                           { указатель на новую среду процесса }
nil,                           { указатель на имя текущей директории }
StartupInfo,                   { указатель на STARTUPINFO }
ProcessInfo) then Result := -1 { указатель на PROCESS_INF }

else begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;


 

Дополнение

Вместо

WaitforSingleObject(ProcessInfo.hProcess,INFINITE);

лучше написать:

face="Courier New" size="2">

while WaitforSingleObject(ProcessInfo.hProcess,200)=WAIT_TIMEOUT do
Repaint;

Смысл замены прост: в первом варианте главное окно ждёт завершения вызванного сообщения, не обрабатывая при этом никаких событий. Вследствие этого главное окно даже не перерисовывается, что выглядит очень некрасиво. Второй вариант исправляет этот недостаток.

делфи форум