Корректное завершение дочернего процесса

[Guest]

Пишу прилодение которое многократно порождает дочернее приложение и смотрит как долго оно работает. Если лимит времени превышен, то дочерний процесс завершается и функция возвращает значение 'TL' - Time Limit - т.е. превышен интервал ожидания. Проблема в том что дечернее приложение не завершается после окончания работы функции (ProcessExplorer так говорит), а вновь вызванная ниже функция дает нормальный результат работы приложения. Т.е. получается цепочка результатов вызовов функций:
TimeLimit, Accept, TimeLimit, Accept, TimeLimit, Accept ...

Как добиться корректного завершения дочернего процесса ?

function runSolve(CmdLine: string; TimeLimit: Cardinal = INFINITE; MemoryLimit: Cardinal = INFINITE): String;
var
StartUpInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
dbg: _Debug_event;
run: Boolean;
tick: Cardinal;
res: String;
begin
res := 'AC';

with StartUpInfo do begin
cb := sizeof(StartUpInfo);
lpReserved := nil;
lpDesktop := nil;
lpTitle := PChar('External program "' + CmdLine + '"');
dwFlags := 0;
cbReserved2 := 0;
lpReserved2 := nil;
end;


run := CreateProcess(
nil,					 //Полный путь к исполняемому модулю программы
PChar(runCMDsolve),	 //Строка параметров
nil,					 //Атрибуты защиты для нового процесса
nil,					 //Атрибуты защиты для первого потока созданного приложением
False,				  //Флаг наследования от процесса производящего запуск
DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS,  //Флаг способа создания процесса и его приоритет
nil,					 //Блок среды
nil,					 //Текущий диск и каталог
StartupInfo,			 //Используется для настройки свойств процесса, например расположения окон и заголовок
ProcessInfo			 //Информация о созданном процессе. Инициализируется самой функцией
);



if run then begin
tick:=GetTickCount;
res := 'AC';

try

while True do begin
if (getTickCount - tick) > (TimeLimit*1000) then begin
res := 'TL';
TerminateProcess(ProcessInfo.hProcess, 0);
break;
end;

if not WaitForDebugEvent(dbg, 100) then begin
Application.ProcessMessages;
Continue;
end;
ContinueDebugEvent(dbg.dwProcessId, dbg.dwThreadId, DBG_CONTINUE);

if (dbg.dwDebugEventCode = EXCEPTION_DEBUG_EVENT) and (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP) and (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_BREAKPOINT) then begin
res := 'RE';
TerminateProcess(ProcessInfo.hProcess, 0);
end;

if dbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then break;
end;


finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;

end;


Result := res;
end;

 

[Guest]

Попробовал сделать через JOB, но результат тотже

function runSolve(CmdLine: string; TimeLimit: Cardinal = INFINITE; MemoryLimit: Cardinal = INFINITE): String;
var
StartUpInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
dbg: _Debug_event;
run: Boolean;
tick: Cardinal;
res: String;
hJob: THandle;
begin

res := 'RE1';

with StartUpInfo do begin
cb := sizeof(StartUpInfo);
lpReserved := nil;
lpDesktop := nil;
lpTitle := PChar('External program "' + CmdLine + '"');
dwFlags := 0;
cbReserved2 := 0;
lpReserved2 := nil;
end;

(* СДЕЛАТЬ ЗАЩИТУ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)
run := CreateProcess(
nil,					 //Полный путь к исполняемому модулю программы
PChar(runCMDsolve),	 //Строка параметров
nil,					 //Атрибуты защиты для нового процесса
nil,					 //Атрибуты защиты для первого потока созданного приложением
False,				  //Флаг наследования от процесса производящего запуск
DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS,  //Флаг способа создания процесса и его приоритет
nil,					 //Блок среды
nil,					 //Текущий диск и каталог
StartupInfo,			 //Используется для настройки свойств процесса, например расположения окон и заголовок
ProcessInfo			 //Информация о созданном процессе. Инициализируется самой функцией
);



if run then begin
hJob := CreateJobObjectA(nil, 'MyJob');
AssignProcessToJobObject(hjob, ProcessInfo.hProcess);
tick:=GetTickCount;
res := 'AC';

try
while True do begin
if (getTickCount - tick) > (TimeLimit*1000) then begin
res := 'TL';
TerminateJobObject(hJob, 0);
//				TerminateProcess(ProcessInfo.hProcess, 0);
break;
end;

if not WaitForDebugEvent(dbg, 100) then begin
Application.ProcessMessages;
Continue;
end;
ContinueDebugEvent(dbg.dwProcessId, dbg.dwThreadId, DBG_CONTINUE);

if (dbg.dwDebugEventCode = EXCEPTION_DEBUG_EVENT) and (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP) and (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_BREAKPOINT) then begin
res := 'RE';
TerminateJobObject(hJob, 0);
//			TerminateProcess(ProcessInfo.hProcess, 0);
break;
end;

if dbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then break;
end;

finally
//	 TerminateProcess(ProcessInfo.hProcess, 0);
//	 TerminateJobObject(hJob, 0);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;

end;


Result := res;
end;