delphi 内核同步对象单元 其中包括精确的定时器

{内核同步对象单元}
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 ;     //默认轮询时间为　１0秒

  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.