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

Тема в разделе "Delphi - Система", создана пользователем vital, 6 янв 2010.

  1. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.474
    Симпатии:
    27
    Суть функции – порождение дочернего процесса в редиме отладки, слежение за его выполнением, КОРРЕКТНОЕ прекращение в случае ошибки.
    Ошибки могут быть трех типов:
    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">
    Код (Text):
    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;
     
Загрузка...
Похожие Темы - Напишите функцию на
  1. Луиза
    Ответов:
    0
    Просмотров:
    297
  2. Davidka
    Ответов:
    0
    Просмотров:
    1.212
  3. bazleiter
    Ответов:
    1
    Просмотров:
    2.976
  4. Клюковка
    Ответов:
    1
    Просмотров:
    1.282
  5. grigsoft
    Ответов:
    14
    Просмотров:
    17.518

Поделиться этой страницей