时间轮算法的定时器，Delphi

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

D7,XE2 编译测试OK

  1 //时间轮算法的定时器
  2 //2014-02-23 14:54 QQ 287413288
  3 
  4 unit uTimeWheel;
  5 
  6 interface
  7 
  8 uses
  9   Windows,Classes,SysUtils,SyncObjs;
 10 
 11 type
 12   PTWItem=^TTWItem;
 13   TTWItem=record
 14     UserData:Pointer; //用户数据
 15     Tag:Integer;      //用户数据
 16     Positin:Integer;
 17     Interval:Integer;//定时时间(ms)
 18   end;
 19 
 20   TTimeWheel=class(TThread)
 21   private
 22     FCS:TCriticalSection;
 23     FInterval:Integer;
 24     FWorkDone:Boolean;
 25     function getPosition: Integer;
 26   protected
 27     FPosition:Integer;
 28     FSize:DWORD;
 29     FList:TList;
 30     procedure Execute();override;
 31     procedure OnTime(PI:PTWItem);virtual;abstract;
 32   public
 33     //AOnTimeCount 最大触发次数
 34     constructor Create(AOnTimeCount:DWORD;AInterval:Integer);virtual;
 35     destructor  Destroy();override;
 36     procedure   Lock();
 37     procedure   UnLock();
 38     procedure   Start();
 39     procedure   Stop();
 40     //\\
 41     function   RegisterTime(AInterval:Integer):PTWItem;virtual;
 42   public
 43     property List:TList read FList;
 44     property Position:Integer read getPosition;
 45     property Interval:Integer  read FInterval; //单位 ms
 46     property WorkDone:Boolean read FWorkDone;
 47   end;
 48 
 49 implementation
 50 
 51 { TTimeWheel }
 52 
 53 constructor TTimeWheel.Create(AOnTimeCount:DWORD;AInterval:Integer);
 54 var
 55   Index:DWORD;
 56   PI:PTWItem;
 57 begin
 58   inherited Create(TRUE);
 59   FCS := TCriticalSection.Create();
 60   FLIst := TList.Create();
 61   FList.Capacity := AOnTimeCount;
 62   FSize     := AOnTimeCount;
 63   FInterval := AInterval;
 64   for Index := 0 to FSize - 1 do
 65   begin
 66     New(PI);
 67     PI^.UserData  := nil;
 68     PI^.Interval  := 0;
 69     FList.Add(PI);
 70   end;
 71   FPosition := 0;
 72   FreeOnTerminate := FALSE;
 73   FWorkDone := FALSE;
 74 end;
 75 
 76 destructor TTimeWheel.Destroy;
 77 var
 78   Index:integer;
 79   PI:PTWItem;
 80 begin
 81   FCS.Free();
 82   for Index := 0 to FList.Count - 1 do
 83   begin
 84     PI := PTWItem(FList.Items[Index]);
 85     if PI <> nil then Dispose(PI);
 86   end;
 87   FList.Free();
 88   inherited;
 89 end;
 90 
 91 procedure TTimeWheel.Execute;
 92   procedure Delay(Value:Integer);
 93   begin
 94     while((not Terminated) and (Value > 0)) do
 95     begin
 96       Dec(Value,100);
 97       Sleep(100);
 98     end;
 99   end;
100 var
101   PI:PTWItem;
102 begin
103   while(not Terminated) do
104   begin
105     //Sleep(FInterval);
106     Delay(FInterval);
107     Lock();
108     try
109       Inc(FPosition);
110       FPosition := FPosition mod FSize;
111       PI := FList.Items[FPosition];
112       PI^.Positin := FPosition;
113     finally
114       UnLock();
115     end;
116     //触发时间到事件
117     if not Terminated then
118     begin
119       OnTime(PI);
120     end;
121   end;
122   FWorkDone := TRUE;
123 end;
124 
125 function TTimeWheel.getPosition: Integer;
126 begin
127   FCS.Enter();
128   Result := FPosition;
129   FCS.Leave();
130 end;
131 
132 procedure TTimeWheel.Lock;
133 begin
134   FCS.Enter();
135 end;
136 
137 function TTimeWheel.RegisterTime(AInterval: Integer): PTWItem;
138 var
139   Lfactor:Integer;
140   LPosition:Integer;
141 begin
142   if AInterVal > FInterval * FSize then
143     raise exception.CreateFmt('TTimeWheel.RegisterTime(%d),Out of Time Range',[AInterval]);
144   Lfactor   := AInterval div FInterval;
145   LPosition := Position + Lfactor;
146   LPosition := LPosition mod FSize;
147   Result    := FList.Items[LPosition];
148   Result^.Interval := AInterval;
149   Result^.Positin  := LPosition;
150 end;
151 
152 procedure TTimeWheel.Start();
153 begin
154   Resume();
155 end;
156 
157 procedure TTimeWheel.Stop;
158 begin
159   Terminate();
160   while(TRUE) do
161   begin
162     if FWorkDone then Break;
163     Sleep(100);
164   end;
165 end;
166 
167 procedure TTimeWheel.UnLock;
168 begin
169   FCS.Leave();
170 end;
171 
172 
173 end.