Code:

{ **** UBPFD *********** by kladovka ****

>> Класс-оболочка для объекта синхронизации 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: Алексей Вуколов

********************************************** }

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; constName : 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; constName: string);

var

pName : PChar;

begin

inherited Create;

ifName = ''then pName := nilelse

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 = 0then

begin

DateTimeToSystemTime( FDueTime, SysTime );

SystemTimeToFileTime( SysTime, LocalTime );

LocalFileTimeToFileTime( LocalTime, UTCTime );

endelse

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; //запуск таймера

....