Запуск программы и ожидание ее окончания, принудительное завершение если Timeout

Delphi , Программа и Интерфейс , Приложения чужие

Автор: 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;

Функция Delphi ExecuteFileTm выполняет файл и ожидает его завершения, с возможностью прервать процесс если он занимает слишком много времени. Функция предназначена для выполнения в отдельном потоке, что позволяет мониторить выполнение программы без блокировки основного потока.

Функция принимает четыре параметра:

1. FileName: имя исполняемого файла, который будет выполняться.
2. Params: любые командные параметры, которые будут переданы в исполняемый файл.
3. Dsk: булевое значение, указывающее, должен ли процесс запускаться в отдельном десктопе (true) или нет (false).
4. TimeOut: максимальное время (в секундах), которое разрешено для выполнения процесса до его прерывания.

Вот шаг за шагом, как функция работает:

1. Она инициализирует несколько переменных, включая TmOut, который устанавливается в указанное значение таймаута.
2. Если Dsk истинно, она настраивает флаги создания процесса для запуска в отдельном десктопе с нормальной приоритетом и Unicode-окружением.
3. В противном случае она настраивает флаги создания процесса для запуска без создания нового окна и с нормальной приоритетом и Unicode-окружением.
4. Она вызывает GetStartupInfo для получения структуры информации о старте (SII).
5. Затем она создает процесс, используя CreateProcess, передавая имя файла, параметры и другие настройки.
6. Если создание процесса не удалось, она закрывает handle к процессу и возвращает false.
7. Затем она enters цикл, который проверяет код выхода процесса каждую секунду, пока таймаут не будет превышен или процесс не будет успешно завершен.
8. Если таймаут был превышен и процесс все еще работает, она прерывает процесс с помощью TerminateProcess.
9. Наконец, она закрывает handle к процессу и возвращает результат (true, если выполнение было успешным, false - иначе).

Функция использует несколько исключений для обработки ошибок, которые могут возникнуть при выполнении, таких как неудачное создание или закрытие handle.

В целом, эта функция предоставляет удобный способ запустить файл в отдельном потоке с контролем таймаута, что делает ее полезной для мониторинга и управления долгоживущими процессами.

Функция ExecuteFileTm позволяет запустить программу, ожидать ее окончания в указанном интервале времени и принудительно закрыть если timeout.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Приложения чужие ::