Напишите функцию на WinApi

vital

Больной Компом Детектед
29.01.2006
2 432
42
#1
Суть функции – порождение дочернего процесса в редиме отладки, слежение за его выполнением, КОРРЕКТНОЕ прекращение в случае ошибки.
Ошибки могут быть трех типов:
RunTime Error – ошибка во время выполнения программы
Memory Limit – превышение отведенной памяти для процесса
Time Limit – превышение отведенного времени для процесса

Есть сишный вариант, нужно на дельфях, но одмин слишком криворук что бы сделать самостоятельно(
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">сишный вариант</div></div><div class="sp-body"><div class="sp-content">
C++:
#define TIME_LIMIT 100000000  //1 секунда
#define MEMORY_LIMIT 67108864 //64 мб
//...
HANDLE hjob = CreateJobObject(NULL, NULL);

JOBOBJECT_BASIC_LIMIT_INFORMATION jobli = {0};
JOBOBJECT_EXTENDED_LIMIT_INFORMATION jobeli={0};

jobli.PriorityClass = IDLE_PRIORITY_CLASS;
jobli.PerJobUserTimeLimit.QuadPart = TIME_LIMIT;

jobli.LimitFlags = JOB_OBJECT_LIMIT_PRIORITY_CLASS | JOB_OBJECT_LIMIT_JOB_TIME | 
JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION | JOB_OBJECT_LIMIT_JOB_MEMORY;

jobeli.BasicLimitInformation=jobli;
jobeli.JobMemoryLimit=MEMORY_LIMIT;

SetInformationJobObject(hjob, JobObjectExtendedLimitInformation, &jobeli, sizeof(jobeli));

JOBOBJECT_BASIC_UI_RESTRICTIONS jobuir;
jobuir.UIRestrictionsClass=JOB_OBJECT_UILIMIT_ALL;
SetInformationJobObject(hjob, JobObjectBasicUIRestrictions, &jobuir, sizeof(jobuir));  

g_hIOCP = CreateIoCompletionPort(INVALID_HANDLE_VALUE, NULL, 0, 0);//Для отлова событий Job
JOBOBJECT_ASSOCIATE_COMPLETION_PORT joacp = { (PVOID) ((UINT_PTR) 2), g_hIOCP };
SetInformationJobObject(hjob,JobObjectAssociateCompletionPortInformation,&joacp, sizeof(joacp));	

JOBOBJECT_END_OF_JOB_TIME_INFORMATION joeojti;
joeojti.EndOfJobTimeAction =JOB_OBJECT_POST_AT_END_OF_JOB;
SetInformationJobObject(hjob, JobObjectEndOfJobTimeInformation, &joeojti, sizeof(joeojti));

STARTUPINFOA si = { sizeof(si) };
PROCESS_INFORMATION pi; 
CreateProcessA(NULL, "test_program.exe", NULL, NULL, FALSE, CREATE_SUSPENDED, NULL, NULL, &si, &pi);
AssignProcessToJobObject(hjob, pi.hProcess);

ResumeThread(pi.hThread); 
CloseHandle(pi.hThread);

DWORD dwBytesXferred;
ULONG_PTR CompKey;
LPOVERLAPPED po;
start:
GetQueuedCompletionStatus(g_hIOCP,
&dwBytesXferred, &CompKey, &po, INFINITE);
cout<<dwBytesXferred<<endl;
switch (dwBytesXferred) 
{
case JOB_OBJECT_MSG_END_OF_JOB_TIME:
case JOB_OBJECT_MSG_END_OF_PROCESS_TIME:
printf("Time limit");
TerminateJobObject(hjob,0);
break;
case JOB_OBJECT_MSG_EXIT_PROCESS:
cout<<"Normal exit";
break;
case JOB_OBJECT_MSG_PROCESS_MEMORY_LIMIT:
case JOB_OBJECT_MSG_JOB_MEMORY_LIMIT:
cout<<"Memory limit";
break;
case JOB_OBJECT_MSG_NEW_PROCESS://для пропуска этого события.
goto start;
}
cout<<endl;
DWORD a;
JOBOBJECT_BASIC_ACCOUNTING_INFORMATION jobai;
QueryInformationJobObject(hjob,JobObjectExtendedLimitInformation, &jobeli,sizeof(jobeli),&a);
QueryInformationJobObject(hjob,JobObjectBasicAccountingInformation,&jobai,sizeof(jobai),&a);
//Вывод данных об используемом времени/памяти
cout<<jobeli.PeakJobMemoryUsed<<" bytes,"<<jobai.TotalUserTime.QuadPart/10000<<" msec";
CloseHandle(pi.hProcess);
CloseHandle(hjob);
//...
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">что-то насочиняное на дельфи.. Это нужно править конечно.. или забить вообще</div></div><div class="sp-body"><div class="sp-content">
Код:
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;

jobli: JOBOBJECT_BASIC_LIMIT_INFORMATION;
jl: JOBOBJECT_EXTENDED_LIMIT_INFORMATION;
begin

res := 'RE1';


hJob := CreateJobObject(nil, 'MyJob');

//Timelimit for JOB
jobli.LimitFlags := JOB_OBJECT_LIMIT_JOB_TIME;
jobli.PerJobUserTimeLimit.QuadPart := TimeLimit * 10000000; //наносекунды - по книге Рихтера
SetInformationJobObject(hJob, JobObjectBasicLimitInformation, Addr(jobli), sizeof(jobli));

//Memorylimit for JOB
jl.BasicLimitInformation.LimitFlags := JOB_OBJECT_LIMIT_PROCESS_MEMORY;
jl.ProcessMemoryLimit := MemoryLimit * 1024 * 1024;
SetInformationJobObject(hJob, JobObjectExtendedLimitInformation, Addr(jl), sizeof(jl));


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(CmdLine),	 //Строка параметров
nil,					 //Атрибуты защиты для нового процесса
nil,					 //Атрибуты защиты для первого потока созданного приложением
False,				  //Флаг наследования от процесса производящего запуск
DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS,  //Флаг способа создания процесса и его приоритет
nil,					 //Блок среды
nil,					 //Текущий диск и каталог
StartupInfo,			 //Используется для настройки свойств процесса, например расположения окон и заголовок
ProcessInfo			 //Информация о созданном процессе. Инициализируется самой функцией
);



if run then begin

AssignProcessToJobObject(hjob, ProcessInfo.hProcess);

tick:=GetTickCount;
res := 'AC';

try

while True do begin
if (getTickCount - tick) > (TimeLimit*1000) then begin
res := 'TL';
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';
break;
end;

if dbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then break;
end;


finally
TerminateProcess(ProcessInfo.hProcess, 0);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);

TerminateJobObject(hJob, 0);
CloseHandle(hJob);
end;

end;


Result := res;
end;