{内核同步对象单元}
unit UntKernel;
interface
uses Windows , Classes ,SysUtils ,DateUtils;
const
DefStackSize = LongWord(0) ;
DefMillSec = 5 * 1000 ;
DefMaxThreadCount = 16 ;
MaxThreadCount = 128 ;
DefOutTime = 10 * 60 * 1000 ; //默认超时时间为六十秒
DefQueryTiem = 10 * 1000 ; //默认轮询时间为 10秒
DefWaitTime = 5 * 1000 ; //1分钟查询一次
SecondM = 1 ;
MinuteM = 60 * SecondM ;
HourM = 60 * MinuteM ;
DayM = 24 * HourM ;
ms = 1000 ;
us = Ms * 1000 ;
ns = us * 1000 ;
WaitTime = 10 * ms;
millisecond = 1000 ;
type
TTimerproc = procedure of object;
type
//基本的内核对象
TKernelObject = Class
private
protected
_FHandle : THandle ; //内核对象的句柄
_PSecurityAttributes : PSecurityAttributes ; //内核对象的安全属性
_Error : integer ; //返回的错误信息
_Name : String ; //内核对象的名称 如果有的话
public
property Handle : Thandle Read _FHandle ;
property KernelHandel : Thandle Read _FHandle ; //内核对像的句柄
property Name : String Read _Name ;
property Error : integer Read _Error ;
constructor Create ;virtual ; //内核对象的创建函数
destructor Destroy; override; //内核对象的释放函数
end;
//互斥体对象
TMutex = class(TKernelObject)
private
protected
public
procedure Lock ;
procedure Unlock ;
constructor Create(ASecurityAttributes : PSecurityAttributes = nil ; Ainit : boolean = False ; AName : String = '') ;overload ; //内核对象的创建函数
destructor Destroy; override; //内核对象的释放函数
end;
// 事件内核对象
TEvent = Class(TKernelObject)
private
_ManualReset : Boolean ;
_InitialState : Boolean ;
protected
public
function ResetEvent : Boolean ;
function SetEvent : Boolean ;
constructor Create(ASecurityAttributes : PSecurityAttributes = nil ;
AManualReset : boolean = True ;
AInitialState : boolean = False ;
Aname : String = '') ;overload ; //内核对象的创建函数
destructor Destroy; override; //内核对象的释放函数
end;
//信标对象
TSemaphore = Class(TKernelObject)
private
_ManualReset : Boolean ;
protected
public
function ReleaseSemaphore(lReleaseCount : integer = 1 ) : Boolean ;
constructor Create(ASecurityAttributes : PSecurityAttributes = nil ;
AInitialCount : integer = 0 ;
AMaximumCount : integer = $7FFFFFFF ;
Aname : String = '') ;overload ; //内核对象的创建函数
destructor Destroy; override; //内核对象的释放函数
end;
TWaitableTimer = Class(TKernelObject)
private
_ManualReset : Boolean ;
protected
public
{ 1、> 0 时是绝对时间, 是一个 TFileTime 格式的时间(具体赋值方法后面详解);
2、< 0 时是相对时间, 相对是相对于当前, 譬如 -50000000 表示 5 秒钟后执行(单位是0.1毫秒, 后面详述);
问题 : 当 <0 的时候 200 秒以内是好用的 大于200 以后 就要用 > 0 的绝对时间
3、= 0 时, 立即执行, 不再等待; 上面的举例和下面第一个例子我们先用 0.
间隔时间(第三个参数)有两种情况:
1、譬如 5000 表示每隔 5 秒钟执行一次, 其单位是毫秒; 本页第二个例子使用了 500(半秒);
2、如果赋值为 0, 表示根据起始时间只执行一次, 不再重复执行.
}
//开始时间
procedure SetWaitableTimer(AStartTime : Tdatetime = 0 ;
//间隔时间
PAeriodTime : TDatetime = 0 ;
ApcFunP : TFNTimerAPCRoutine = Nil ;
ApcParameter : Pointer = nil ;
AResume : Boolean = False ); overload ;
procedure SetWaitableTimer(AStartTime : int64 ;
//间隔时间
PAeriodTime : int64 ); overload ;
procedure SetWaitableTimer(AStartTime : int64) ; overload ; //只执行一次
procedure CancelWaitableTimer;
property ManualReset : Boolean REad _ManualReset ;
constructor Create(ASecurityAttributes : PSecurityAttributes = nil ;
{True: 可调度多个线程; False: 只调度一个线程}
AManualReset : boolean = False ;
Aname : String = '') ;overload ;
destructor Destroy; override; //内核对象的释放函数
end;
//一个比较精确的定时器 没有考虑到运行过程所消耗的时间 是否可以开另一个线程处理?
TTimerThread = class(TThread)
private
_WaitableTimer : TWaitableTimer ;
_AeriodNum : integer ;
_StartNum : integer ;
_StopEvent : TEvent ;
_isStop : boolean ;
_Exit : Boolean ;
_OnTimerproc : TTimerproc ;
procedure initTimerThread;
procedure Execute ; override ;
procedure _Settimer(AStarttime , Aeriodtime : TDateTime) ;overload ;
procedure _Settimer( AeriodNum : Tdatetime) ;overload ;
procedure _Settimer( AeriodNum : integer) ;overload ;
public
property IsStop : Boolean Read _isStop ;
property OnTimerproc : TTimerproc Read _OnTimerproc Write _OnTimerproc ;
procedure ServerStart ;
procedure Serverend ;
procedure _Settimer(AStartNum , AeriodNum : integer) ;overload ;
procedure _OneSettimer( AeriodNum : integer) ;overload ; //制定秒数后执行一次
procedure _OneSettimer( AeriodNum : Tdatetime) ;overload ; //制定时间执行一次
//开始时间 间隔时间
constructor Create(AStartNum , AeriodNum : integer ); overload;
constructor Create( AeriodNum : integer ); overload;
constructor Create( PAeriodTime : TDatetime ); overload;
constructor Create ; overload;
destructor Destroy; override;
end;
implementation
{ TKernelObject }
// 日期时间转化成int64位时间数
function TimetoFileTimeInt64(ATime : Tdatetime) : int64 ;
var
st: TSystemTime;
ft,UTC: TFileTime;
dt: TDateTime;
Begin
DateTimeToSystemTime(ATime, st); {从 TDateTime 到 TSystemTime}
SystemTimeToFileTime(st, ft); {从 TSystemTime 到 TFileTime}
LocalFileTimeToFileTime(ft, UTC); {从本地时间到国际标准时间 UTC}
Result := Int64(UTC);
end;
//现在的时间加上秒数
function GetAddSceneRunTime(SceneRunTime : integer ) : TDateTime ;
begin
Result := IncSecond( Now , SceneRunTime );
end ;
// 用来把文件时间转化成 delphi时间
function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
SysTime: TSystemTime;
begin
if not FileTimeToSystemTime(FileTime, SysTime) then
Result := 0 ;
// raise Exception.CreateFmt('FileTimeToSystemTime failed. ' +
// 'Error code %d', [GetLastError]);
with SysTime do
Result := EncodeDate(SysTime.wYear, SysTime.wMonth, SysTime.wDay) +
EncodeTime(SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);
end;
function TimeToSecond(ATime : TdateTime ) : integer ;
var
AYear, AMonth, ADay, AHour, AMinute,ASecond, AMilliSecond: Word ;
Begin
DecodeDatetime(ATime,AYear, AMonth, ADay, AHour, AMinute,ASecond, AMilliSecond);
Result := AHour * HourM +
AMinute * MinuteM +
ASecond * SecondM ;
End;
constructor TKernelObject.Create;
begin
{$IFNDEF NOLOGS}
{$ENDIF}
end;
destructor TKernelObject.Destroy;
begin
inherited;
end;
{ TMutex }
constructor TMutex.Create(ASecurityAttributes: PSecurityAttributes;
Ainit: boolean; AName: String);
begin
inherited Create;
_FHandle := CreateMutex(ASecurityAttributes,Ainit,pchar(Aname));
_PSecurityAttributes := ASecurityAttributes ;
_Name := Aname ;
end;
destructor TMutex.Destroy;
begin
closehandle(_FHandle);
inherited;
end;
procedure TMutex.Lock;
begin
WaitForSingleObject(_FHandle, INFINITE) ;
end;
procedure TMutex.Unlock;
begin
ReleaseMutex(_FHandle);
end;
{ TEvent }
function TEvent.ResetEvent: Boolean;
begin
Result :=Windows.ResetEvent(_FHandle);
end;
function TEvent.SetEvent: Boolean;
begin
Result := Windows.SetEvent(_Fhandle);
end;
constructor TEvent.Create(ASecurityAttributes: PSecurityAttributes;
AManualReset, AInitialState: boolean; Aname: String);
begin
_PSecurityAttributes := ASecurityAttributes ;
_ManualReset := AManualReset ;
_InitialState := AInitialState ;
_Name := Aname ;
_FHandle := CreateEvent(_PSecurityAttributes, _ManualReset ,_InitialState , pchar(_Name));
end;
destructor TEvent.Destroy;
begin
closehandle(_FHandle);
inherited;
end;
{ TSemaphore }
{ TSemaphore }
constructor TSemaphore.Create(ASecurityAttributes: PSecurityAttributes;
AInitialCount, AMaximumCount: integer; Aname: String);
begin
_PSecurityAttributes := ASecurityAttributes ;
_FHandle := CreateSemaphore(_PSecurityAttributes, AInitialCount ,AMaximumCount , pchar(_Name));
end;
destructor TSemaphore.Destroy;
begin
closehandle(_FHandle);
inherited;
end;
function TSemaphore.ReleaseSemaphore(lReleaseCount: integer): Boolean;
begin
Result := Windows.ReleaseSemaphore(_FHandle,lReleaseCount , nil ) ;
end;
{ TWaitableTimer }
procedure TWaitableTimer.CancelWaitableTimer;
begin
Windows.CancelWaitableTimer(_FHandle);
end;
procedure TWaitableTimer.SetWaitableTimer(AStartTime,
PAeriodTime: TDatetime; ApcFunP: TFNTimerAPCRoutine;
ApcParameter: Pointer; AResume: Boolean);
Var
St : int64;
Aeriod : int64 ;
begin
St := TimetoFileTimeInt64(AStartTime);
Aeriod := TimeToSecond(PAeriodTime) * ms ;
Windows.SetWaitableTimer(_FHandle, St, Aeriod, ApcFunP, ApcParameter, AResume);
end;
procedure TWaitableTimer.SetWaitableTimer(AStartTime, PAeriodTime: int64);
begin
Windows.SetWaitableTimer(_FHandle, AStartTime, PAeriodTime , Nil, Nil, False);
end;
constructor TWaitableTimer.Create(ASecurityAttributes: PSecurityAttributes;
AManualReset: boolean; Aname: String);
begin
_PSecurityAttributes := ASecurityAttributes ;
_ManualReset := AManualReset ;
_Name := Aname ;
_FHandle := CreateWaitableTimer(_PSecurityAttributes, _ManualReset , pchar(_Name));
end;
destructor TWaitableTimer.Destroy;
begin
closehandle(_FHandle);
inherited;
end;
procedure TWaitableTimer.SetWaitableTimer(AStartTime: int64);
begin
Windows.SetWaitableTimer(_FHandle, AStartTime, 0 , Nil, Nil, False);
end;
procedure TTimerThread._Settimer(AStartNum, AeriodNum: integer);
begin
_AeriodNum := AeriodNum ;
_StartNum := AStartNum ;
_WaitableTimer.CancelWaitableTimer ;
_WaitableTimer.SetWaitableTimer(AStartNum ,AeriodNum );
end;
procedure TTimerThread._Settimer(AeriodNum: Tdatetime);
Var
Aeriod : int64 ;
begin
Aeriod := TimeToSecond(AeriodNum) * ms ;
_Settimer( 0 , Aeriod );
end;
constructor TTimerThread.Create(AStartNum, AeriodNum: integer);
begin
inherited Create(False);
initTimerThread;
_Settimer(AStartNum * 10000 ,AeriodNum * millisecond );
end;
constructor TTimerThread.Create(AeriodNum: integer);
begin
inherited Create(False);
initTimerThread;
_Settimer( 0 ,AeriodNum );
end;
constructor TTimerThread.Create(PAeriodTime: TDatetime);
Var
Aeriod : int64 ;
begin
inherited Create(False);
initTimerThread;
Aeriod := TimeToSecond(PAeriodTime) * ms ;
_Settimer( 0 , Aeriod );
end;
destructor TTimerThread.Destroy;
begin
Suspend ;
// Serverend ;
Terminate ;
_Exit := True ;
_StopEvent.SetEvent ;
_WaitableTimer.CancelWaitableTimer ;
_WaitableTimer.SetWaitableTimer(1);
Resume ;
WaitFor ;
_StopEvent.Free;
_WaitableTimer.Free ;
inherited;
end;
procedure TTimerThread.Execute;
begin
while not Self.Terminated do
begin
//根据设置等待
if WaitForSingleObject(_StopEvent._FHandle, INFINITE) = WAIT_OBJECT_0 then begin
if WaitForSingleObject(_WaitableTimer._FHandle ,INFINITE)= WAIT_OBJECT_0 then
begin
if _Exit then exit ;
Try
if Assigned(_OnTimerproc) then
_OnTimerproc ;
except
end ;
end ;
if not _isStop then
_StopEvent.SetEvent;
end;
end ;
end;
procedure TTimerThread.initTimerThread;
begin
_WaitableTimer := TWaitableTimer.Create ;
_isStop := False ;
_WaitableTimer.CancelWaitableTimer ;
_StopEvent := TEvent.Create(nil , false , False , PChar('')) ;
_Exit := False ;
end;
procedure TTimerThread.Serverend;
begin
_IsStop := True ;
_WaitableTimer.CancelWaitableTimer ;
end;
procedure TTimerThread.ServerStart;
begin
_IsStop := False ;
_StopEvent.SetEvent;
end;
procedure TTimerThread._Settimer(AeriodNum: integer);
begin
_AeriodNum := AeriodNum ;
_WaitableTimer.CancelWaitableTimer ;
_WaitableTimer.SetWaitableTimer( 0 ,AeriodNum );
end;
procedure TTimerThread._OneSettimer(AeriodNum: integer);
begin
if AeriodNum < 200 then
_WaitableTimer.SetWaitableTimer(0 - AeriodNum * 1000 * 10000 ,0 )
else
_WaitableTimer.SetWaitableTimer(GetAddSceneRunTime(AeriodNum), 0);
end;
constructor TTimerThread.Create;
Var
Aeriod : int64 ;
begin
inherited Create(False);
_WaitableTimer := TWaitableTimer.Create ;
_WaitableTimer.CancelWaitableTimer ;
_StopEvent := TEvent.Create(nil , false , False , PChar('')) ;
Serverend ;
_Exit := False ;
end;
procedure TTimerThread._Settimer(AStarttime, Aeriodtime: TDateTime);
Var
Aeriod : int64 ;
begin
Aeriod := TimeToSecond(Aeriodtime) * ms ;
_Settimer( AStarttime , Aeriod );
end;
procedure TTimerThread._OneSettimer(AeriodNum: Tdatetime);
begin
_WaitableTimer.SetWaitableTimer( AeriodNum ,0 );
end;
end.