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

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

 D7,XE2 编译测试OK

 

//时间轮算法的定时器
//2014-02-23 14:54 QQ 287413288

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 := 0 to FSize - 1 do
  begin
    New(PI);
    PI^.UserData  := nil;
    PI^.Interval  := 0;
    FList.Add(PI);
  end;
  FPosition := 0;
  FreeOnTerminate := FALSE;
  FWorkDone := FALSE;
end;

destructor TTimeWheel.Destroy;
var
  Index:integer;
  PI:PTWItem;
begin
  FCS.Free();
  for Index := 0 to FList.Count - 1 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 > 0)) do
    begin
      Dec(Value,100);
      Sleep(100);
    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(100);
  end;
end;

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


end.