Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Запуск программы и ожидание ее окончания, принудительное завершение если 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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.