时间轮算法的定时器(Delphi)

源码下载 http://files.cnblogs.com/lwm8246/uTimeWheel.rar

D7,XE2 编译测试OK

 //时间轮算法的定时器
 //-- : QQ 

 unit uTimeWheel;

 interface

 uses
   Windows,Classes,SysUtils,SyncObjs;

 type
   PTWItem=^TTWItem;
   TTWItem=record
     UserData:Pointer; //用户数据
     Tag:Integer;      //用户数据
     Positin:Integer;
     Interval:Integer;//定时时间(ms)
   end;

   TTimeWheel=class(TThread)
   private
     FCS:TCriticalSection;
     FInterval:Integer;
     FWorkDone:Boolean;
     function getPosition: Integer;
   protected
     FPosition:Integer;
     FSize:DWORD;
     FList:TList;
     procedure Execute();override;
     procedure OnTime(PI:PTWItem);virtual;abstract;
   public
     //AOnTimeCount 最大触发次数
     constructor Create(AOnTimeCount:DWORD;AInterval:Integer);virtual;
     destructor  Destroy();override;
     procedure   Lock();
     procedure   UnLock();
     procedure   Start();
     procedure   Stop();
     //\\
     function   RegisterTime(AInterval:Integer):PTWItem;virtual;
   public
     property List:TList read FList;
     property Position:Integer read getPosition;
     property Interval:Integer  read FInterval; //单位 ms
     property WorkDone:Boolean read FWorkDone;
   end;

 implementation

 { TTimeWheel }

 constructor TTimeWheel.Create(AOnTimeCount:DWORD;AInterval:Integer);
 var
   Index:DWORD;
   PI:PTWItem;
 begin
   inherited Create(TRUE);
   FCS := TCriticalSection.Create();
   FLIst := TList.Create();
   FList.Capacity := AOnTimeCount;
   FSize     := AOnTimeCount;
   FInterval := AInterval;
   for Index :=  to FSize -  do
   begin
     New(PI);
     PI^.UserData  := nil;
     PI^.Interval  := ;
     FList.Add(PI);
   end;
   FPosition := ;
   FreeOnTerminate := FALSE;
   FWorkDone := FALSE;
 end;

 destructor TTimeWheel.Destroy;
 var
   Index:integer;
   PI:PTWItem;
 begin
   FCS.Free();
   for Index :=  to FList.Count -  do
   begin
     PI := PTWItem(FList.Items[Index]);
     if PI <> nil then Dispose(PI);
   end;
   FList.Free();
   inherited;
 end;

 procedure TTimeWheel.Execute;
   procedure Delay(Value:Integer);
   begin
     while((not Terminated) and (Value > )) do
     begin
       Dec(Value,);
       Sleep();
     end;
   end;
 var
   PI:PTWItem;
 begin
   while(not Terminated) do
   begin
     //Sleep(FInterval);
     Delay(FInterval);
     Lock();
     try
       Inc(FPosition);
       FPosition := FPosition mod FSize;
       PI := FList.Items[FPosition];
       PI^.Positin := FPosition;
     finally
       UnLock();
     end;
     //触发时间到事件
     if not Terminated then
     begin
       OnTime(PI);
     end;
   end;
   FWorkDone := TRUE;
 end;

 function TTimeWheel.getPosition: Integer;
 begin
   FCS.Enter();
   Result := FPosition;
   FCS.Leave();
 end;

 procedure TTimeWheel.Lock;
 begin
   FCS.Enter();
 end;

 function TTimeWheel.RegisterTime(AInterval: Integer): PTWItem;
 var
   Lfactor:Integer;
   LPosition:Integer;
 begin
   if AInterVal > FInterval * FSize then
     raise exception.CreateFmt('TTimeWheel.RegisterTime(%d),Out of Time Range',[AInterval]);
   Lfactor   := AInterval div FInterval;
   LPosition := Position + Lfactor;
   LPosition := LPosition mod FSize;
   Result    := FList.Items[LPosition];
   Result^.Interval := AInterval;
   Result^.Positin  := LPosition;
 end;

 procedure TTimeWheel.Start();
 begin
   Resume();
 end;

 procedure TTimeWheel.Stop;
 begin
   Terminate();
   while(TRUE) do
   begin
     if FWorkDone then Break;
     Sleep();
   end;
 end;

 procedure TTimeWheel.UnLock;
 begin
   FCS.Leave();
 end;

 end.