Запуск программы и ожидание ее окончания, принудительное завершение если Timeout
Автор: August
WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Запуск программы и ожидание ее окончания, принудительное завершение если timeout
Функция создавалась для запуска и сопровождения приложения в указаном интервале времени.
Я лично для наблюдения за работой приложения включил функцию в нить,
которая (обрывалась) по завершении процесса.
Зависимости: Classes, SysUtils, Windows, strUtils, Consts;
Автор: August, august@torba.com, ICQ:176381214
Copyright: doctorAugust
Дата: 5 февраля 2003 г.
***************************************************** }
function ExecuteFileTm(FileName: string ; Params: string ; Dsk: boolean; TimeOut:
cardinal): boolean;
var
Res: LongBool;
PIn: PROCESS_INFORMATION;
SII: STARTUPINFO;
RetCode: cardinal;
TmOut: cardinal; //In seconds
i: cardinal;
CreationsFlags: cardinal;
begin
TmOut := TimeOut;
try
if Dsk then
begin
CreationsFlags := CREATE_DEFAULT_ERROR_MODE or NORMAL_PRIORITY_CLASS
or CREATE_UNICODE_ENVIRONMENT;
end
else
begin
CreationsFlags := CREATE_DEFAULT_ERROR_MODE or CREATE_NO_WINDOW
or NORMAL_PRIORITY_CLASS
or CREATE_UNICODE_ENVIRONMENT;
end ;
getstartupinfo(SII);
Res := createprocess(
pchar(FileName),
pchar(Params),
nil ,
nil ,
True,
CreationsFlags,
nil ,
pchar(extractfilepath(FileName)),
SII,
PIn);
except
CloseHandle(Pin.hProcess);
ExecuteFileTm := False;
exit;
end ;
if not Res then
begin
CloseHandle(Pin.hProcess);
ExecuteFileTm := False;
exit;
end ;
i := 0;
RetCode := STILL_ACTIVE;
while (i <= TmOut) and (RetCode = STILL_ACTIVE) do
begin
try
GetExitCodeProcess(Pin.hProcess, RetCode);
except
CloseHandle(Pin.hProcess);
ExecuteFileTm := False;
exit;
end ;
Sleep(1000);
inc(i);
end ;
if (i > TmOut) and (RetCode = STILL_ACTIVE) then
begin
TerminateProcess(Pin.hProcess, RetCode);
CloseHandle(Pin.hProcess);
// ExecuteFilePrExt:=false;
ExecuteFileTm := false; // ION T
exit;
end ;
CloseHandle(Pin.hProcess);
ExecuteFileTm := True;
end ;
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Запуск программы и ожидание ее окончания, принудительное завершение если Timeout", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!