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

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Класс-оболочка для объекта синхронизации 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.

 

 

 

 

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

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

время и далее с интервалом в одну минуту".

Code:

var

Timer : TWaitableTimer;

....

begin

Timer := TWaitableTimer.Create(false, nil, '');

Timer.Time := Now + 1; //завтра в это же время

Timer.Period := 60 * 1000; //Интервал в 1 минуту

Timer.Start; //запуск таймера

....

 

 

 

 

©Drkb::00202