在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
源码下载 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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论