Класс-оболочка для объекта синхронизации WaitableTimer
Falk0ner, вс, 06/07/2008 - 15:34.
Класс-оболочка для объекта синхронизации WaitableTimer
{ **** UBPFD *********** by kladovka.net.ru ****
>> .
Класс представляет собой оболочку для объекта синхронизации 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.
>> .
Класс представляет собой оболочку для объекта синхронизации 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; //запуск таймера
....
Timer : TWaitableTimer;
....
begin
Timer := TWaitableTimer.Create(false, nil, '');
Timer.Time := Now + 1; //завтра в это же время
Timer.Period := 60 * 1000; //Интервал в 1 минуту
Timer.Start; //запуск таймера
....
Отправить комментарий