1 unit uSocketHash;
  2 
  3 //2014-03-29 17:05
  4 //QQ 287413288
  5 
  6 interface
  7 
  8 uses SyncObjs;
  9 
 10 type
 11   {$IF CompilerVersion >= 22}  //XE=22,2010=21
 12      TSocket = NativeUInt;
 13   {$ELSE}
 14      TSocket = Integer;
 15   {$IFEND}
 16 
 17   PPSocketHashItem = ^PSocketHashItem;
 18   PSocketHashItem = ^TSocketHashItem;
 19   TSocketHashItem = record
 20     Next: PSocketHashItem;
 21     Key : TSocket;
 22     Value:Pointer;
 23   end;
 24 
 25   TSocketHash = class
 26   private
 27     FBucketPool:array of PSocketHashItem;
 28     Buckets: array of PSocketHashItem;
 29     function NewBucket():PSocketHashItem;
 30     procedure DisposeBucket(Value:PSocketHashItem);
 31   protected
 32     function Find(const Key: TSocket): PPSocketHashItem;
 33     function HashOf(const Key: TSocket): Cardinal; virtual;
 34   public
 35     constructor Create(Size: Cardinal = 256);
 36     destructor Destroy; override;
 37     function Add(const Key: TSocket; Value: Pointer):Integer;
 38     procedure Clear;
 39     procedure Remove(const Key: TSocket);
 40     function Modify(const Key: TSocket; Value: Pointer): Boolean;
 41     function ValueOf(const Key: TSocket): Pointer;
 42   end;
 43 
 44   TThreadSocketHash = class //线程安全
 45   private
 46     FObj:TSocketHash;
 47     FCS:TCriticalSection;
 48     procedure Lock();
 49     procedure UnLock();
 50   public
 51     constructor Create(Size: Cardinal = 256);
 52     destructor Destroy; override;
 53     function Add(const Key: TSocket; Value: Pointer):Integer;
 54     procedure Clear;
 55     procedure Remove(const Key: TSocket);
 56     function Modify(const Key: TSocket; Value: Pointer): Boolean;
 57     function ValueOf(const Key: TSocket): Pointer;
 58     function GetAndRemove(const Key:TSocket):Pointer;
 59   end;
 60 
 61 
 62 implementation
 63 
 64 { TStringHash }
 65 
 66 function TSocketHash.Add(const Key: TSocket; Value: Pointer):Integer;
 67 var
 68   Hash: Integer;
 69   Bucket: PSocketHashItem;
 70 begin
 71   Bucket:= NewBucket();
 72   if Bucket <> nil then
 73   begin
 74     Hash := HashOf(Key) mod Cardinal(Length(Buckets));
 75     Bucket^.Key := Key;
 76     Bucket^.Value := Value;
 77     Bucket^.Next := Buckets[Hash];
 78     Buckets[Hash] := Bucket;
 79     Result := Hash;
 80   end
 81   else Result := -1;//空间满
 82 end;
 83 
 84 procedure TSocketHash.Clear;
 85 var
 86   I: Integer;
 87   P, N: PSocketHashItem;
 88 begin
 89   for I := 0 to Length(Buckets) - 1 do
 90   begin
 91     P := Buckets[I];
 92     while P <> nil do
 93     begin
 94       N := P^.Next;
 95      // Dispose(P);
 96       DisposeBucket(P);
 97       P := N;
 98     end;
 99     Buckets[I] := nil;
100   end;
101 end;
102 
103 constructor TSocketHash.Create(Size: Cardinal);
104 var
105   Index:Integer;
106   PH:PSocketHashItem;
107 begin
108   inherited Create;
109   SetLength(Buckets, Size);
110   //\\
111   SetLength(FBucketPool,Size); //:array of PSocketHashItem;
112   for Index := Low(FBucketPool) to High(FBucketPool) do
113   begin
114     New(PH);
115     PH^.Next  := nil;
116     PH^.Key   := 0;
117     PH^.Value := nil;
118     FBucketPool[Index] := PH;
119   end;
120 end;
121 
122 destructor TSocketHash.Destroy;
123 var
124   Index:Integer;
125   P:PSocketHashItem;
126 begin
127   Clear;
128   for Index := Low(FBucketPool) to High(FBucketPool) do
129   begin
130     P := FBucketPool[Index];
131     if P <> nil then Dispose(P);
132   end;
133   inherited Destroy;
134 end;
135 
136 procedure TSocketHash.DisposeBucket(Value: PSocketHashItem);
137 var
138   Index:Integer;
139 begin
140   for Index := Low(FBucketPool) to High(FBucketPool) do
141   begin
142     if FBucketPool[Index] = nil then
143     begin
144       FBucketPool[Index] := Value;
145       Break;
146     end;
147   end;
148 end;
149 
150 function TSocketHash.Find(const Key: TSocket): PPSocketHashItem;
151 var
152   Hash: Integer;
153 begin
154   Hash := HashOf(Key) mod Cardinal(Length(Buckets));
155   Result := @Buckets[Hash];
156   while Result^ <> nil do
157   begin
158     if Result^.Key = Key then
159       Exit
160     else
161       Result := @Result^.Next;
162   end;
163 end;
164 
165 function TSocketHash.HashOf(const Key: TSocket): Cardinal;
166 var
167   I: Integer;
168   P: PByte;
169 begin
170   Result := 0;
171   P := @Key;
172   //for I := 1 to Length(Key) do
173    for I := 1 to SizeOf(Key) do
174    begin
175      Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor P^;
176      Inc(P);
177    end;
178       //Ord(Key[I]);P^
179 end;
180 
181 function TSocketHash.Modify(const Key: TSocket; Value: Pointer): Boolean;
182 var
183   P: PSocketHashItem;
184 begin
185   P := Find(Key)^;
186   if P <> nil then
187   begin
188     Result := True;
189     P^.Value := Value;
190   end
191   else
192     Result := False;
193 end;
194 
195 function TSocketHash.NewBucket: PSocketHashItem;
196 var
197   Index:Integer;
198 begin
199   Result := nil;
200   for Index := Low(FBucketPool) to High(FBucketPool) do
201   begin
202     Result := FBucketPool[Index];
203     if Result <> nil then
204     begin
205       FBucketPool[Index] := nil;
206       Break;
207     end;
208   end;
209 end;
210 
211 procedure TSocketHash.Remove(const Key: TSocket);
212 var
213   P: PSocketHashItem;
214   Prev: PPSocketHashItem;
215 begin
216   Prev := Find(Key);
217   P := Prev^;
218   if P <> nil then
219   begin
220     Prev^ := P^.Next;
221     //Dispose(P);
222     DisposeBucket(P);
223   end;
224 end;
225 
226 function TSocketHash.ValueOf(const Key: TSocket): Pointer;
227 var
228   P: PSocketHashItem;
229 begin
230   P := Find(Key)^;
231   if P <> nil then
232     Result := P^.Value
233   else
234     Result := nil;// -1;
235 end;
236 
237 
238 
239 { TThreadSocketHash }
240 
241 function TThreadSocketHash.Add(const Key: TSocket; Value: Pointer):Integer;
242 begin
243   Lock();
244   try
245     Result := FObj.Add(Key,Value);
246   finally
247     UnLock();
248   end;
249 end;
250 
251 procedure TThreadSocketHash.Clear;
252 begin
253   Lock();
254   try
255     FObj.Clear();
256   finally
257     UnLock();
258   end;
259 end;
260 
261 constructor TThreadSocketHash.Create(Size: Cardinal);
262 begin
263   FObj := TSocketHash.Create(Size);
264   FCS := TCriticalSection.Create();
265 end;
266 
267 destructor TThreadSocketHash.Destroy;
268 begin
269   FCS.Free();
270   FObj.Free();
271   inherited;
272 end;
273 
274 function TThreadSocketHash.GetAndRemove(const Key: TSocket): Pointer;
275 begin
276   Lock();
277   try
278     Result := FObj.ValueOf(Key);
279     FObj.Remove(Key);
280   finally
281     UnLock();
282   end;
283 end;
284 
285 procedure TThreadSocketHash.Lock;
286 begin
287   FCS.Enter();
288 end;
289 
290 function TThreadSocketHash.Modify(const Key: TSocket; Value: Pointer): Boolean;
291 begin
292   Lock();
293   try
294     FObj.Modify(Key,Value);
295   finally
296     UnLock();
297   end;
298 end;
299 
300 procedure TThreadSocketHash.Remove(const Key: TSocket);
301 begin
302   Lock();
303   try
304     FObj.Remove(Key);
305   finally
306     UnLock();
307   end;
308 end;
309 
310 procedure TThreadSocketHash.UnLock;
311 begin
312   FCS.Leave();
313 end;
314 
315 function TThreadSocketHash.ValueOf(const Key: TSocket): Pointer;
316 begin
317   Lock();
318   try
319     Result := FObj.ValueOf(Key);
320   finally
321     UnLock();
322   end;
323 end;
324 
325 end.