Класс-оболочка для объекта синхронизации WaitableTimer

Delphi , Компоненты и Классы , Классы

Автор: Алексей Вуколов
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Класс-оболочка для объекта синхронизации WaitableTimer.

Класс представляет собой оболочку для объекта синхронизации WaitableTimer,
существующего в операционных системах, основанных на ядре WinNT.

Методы.
--------------
Start - запуск таймера.

Stop - остановка таймера.

Wait - ожидает срабатывания таймера заданное количество миллисекунд и
возвращает результат ожидания.

Свойства.
--------------
Time : TDateTime - дата/время когда должен сработать таймер.

Period : integer - Период срабатывания таймера. Если значение равно 0, то
таймер срабатывает один раз, если же значение отлично от нуля, таймер будет
срабатывать периодически с заданным интервалом, первое срабытывание произойдет
в момент, заданный свойством Time.

LongTime : int64 - альтернативный способ задания времени срабатывания. Время
задается в формате UTC.

Handle : THandle (только чтение) - хендл обекта синхронизации.

LastError : integer (только чтение) - В случае если метод Wait возвращает
wrError, это свойство содержит значение, возвращаемое функцией GetLastError.

Зависимости: Windows, SysUtils, SyncObjs
Автор:       vuk
Copyright:   Алексей Вуколов
Дата:        25 апреля 2002 г.
***************************************************** }

unit wtimer;

interface

uses
  Windows, SysUtils, SyncObjs;

type

  TWaitableTimer = class(TSynchroObject)
  protected
    FHandle: THandle;
    FPeriod: longint;
    FDueTime: TDateTime;
    FLastError: Integer;
    FLongTime: int64;
  public

    constructor Create(ManualReset: boolean;
      TimerAttributes: PSecurityAttributes; const Name: string);
    destructor Destroy; override;

    procedure Start;
    procedure Stop;
    function Wait(Timeout: longint): TWaitResult;

    property Handle: THandle read FHandle;
    property LastError: integer read FLastError;
    property Period: integer read FPeriod write FPeriod;
    property Time: TDateTime read FDueTime write FDueTime;
    property LongTime: int64 read FLongTime write FLongTime;

  end;

implementation

{ TWaitableTimer }

constructor TWaitableTimer.Create(ManualReset: boolean;
  TimerAttributes: PSecurityAttributes; const Name: string);
var
  pName: PChar;
begin
  inherited Create;
  if Name = '' then
    pName := nil
  else
    pName := PChar(Name);
  FHandle := CreateWaitableTimer(TimerAttributes, ManualReset, pName);
end;

destructor TWaitableTimer.Destroy;
begin
  CloseHandle(FHandle);
  inherited Destroy;
end;

procedure TWaitableTimer.Start;
var
  SysTime: TSystemTime;
  LocalTime, UTCTime: FileTime;
  Value: int64 absolute UTCTime;

begin
  if FLongTime = 0 then
  begin
    DateTimeToSystemTime(FDueTime, SysTime);
    SystemTimeToFileTime(SysTime, LocalTime);
    LocalFileTimeToFileTime(LocalTime, UTCTime);
  end
  else
    Value := FLongTime;
  SetWaitableTimer(FHandle, Value, FPeriod, nil, nil, false);
end;

procedure TWaitableTimer.Stop;
begin
  CancelWaitableTimer(FHandle);
end;

function TWaitableTimer.Wait(Timeout: Integer): TWaitResult;
begin
  case WaitForSingleObjectEx(Handle, Timeout, BOOL(1)) of
    WAIT_ABANDONED: Result := wrAbandoned;
    WAIT_OBJECT_0: Result := wrSignaled;
    WAIT_TIMEOUT: Result := wrTimeout;
    WAIT_FAILED:
      begin
        Result := wrError;
        FLastError := GetLastError;
      end;
  else
    Result := wrError;
  end;
end;

end.

Пример использования:

// Пример создания таймера, который срабатывает по алгоритму "завтра в это же
// время и далее с интервалом в одну минуту".

var
  Timer: TWaitableTimer;
begin
  Timer := TWaitableTimer.Create(false, nil, '');
  Timer.Time := Now + 1; //завтра в это же время
  Timer.Period := 60 * 1000; //Интервал в 1 минуту
  Timer.Start; //запуск таймера
end;

Класс Delphi для обертки объекта Windows WaitableTimer, который позволяет синхронизировать потоки.

Класс имеет несколько методов и свойств:

• Create: Создает новый объект WaitableTimer с указанным флагом ручного сброса, атрибутами безопасности и именем.
• Start: Начинает таймер.
• Stop: Останавливает таймер.
• Wait: Ждет, пока таймер не будет активирован или не истечет время ожидания. Возвращает код ошибки, указывающий, была ли ждание успешной или нет.
• Handle: Получает handle объекта WaitableTimer (чтение только).
• LastError: Получает последний код ошибки, возвращенный Windows (чтение только).
• Period: Получает или устанавливает период таймера в миллисекундах.
• Time: Получает или устанавливает дату и время, когда таймер должен быть активирован.
• LongTime: Получает или устанавливает альтернативный способ указания времени с помощью 64-разрядного целочисленного значения, представляющего собой UTC-время.

Класс имеет конструктор и деструктор. Конструктор создает объект WaitableTimer, а деструктор закрывает handle, когда объект будет уничтожен.

Метод Start преобразует свойство DueTime в формат времени Windows, если это необходимо, и затем использует функцию SetWaitableTimer, чтобы начать таймер.

Метод Stop просто вызывает функцию CancelWaitableTimer, чтобы остановить таймер.

Метод Wait использует функцию WaitForSingleObjectEx, чтобы ждать, пока таймер не будет активирован или не истечет время ожидания. Возвращает код ошибки, указывающий, была ли ждание успешной или нет, и также устанавливает свойство LastError, если произошла ошибка.

Пример использования класса:

var
  Timer: TWaitableTimer;
begin
  Timer := TWaitableTimer.Create(false, nil, '');
  Timer.Time := Now + 1; // завтра в то же время
  Timer.Period := 60 * 1000; // интервал в 1 минуту
  Timer.Start; // начать таймер
end;

В этом примере создается объект WaitableTimer, который будет активироваться завтра в то же время и повторять каждую минуту.

Класс-оболочка для объекта синхронизации WaitableTimer представляет собой оболочку для объекта синхронизации, существующего в операционных системах на базе ядра WinNT.

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

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

:: Главная :: Классы ::