通信服务器哈希Socket查找(Delphi)

    在Socket通信服务器的开发中，我们经常会需要Socket与某个结构体指针进行绑定。当连接量很大时，意味着需要个高效的查找方法

Delphi中提供了哈希算法类，以此类为基础，修改出Socket专用Map类。

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

unit uSocketHash;

//2014-03-29 17:05
//QQ 287413288
  5 
interface

uses SyncObjs;

type
  {$IF CompilerVersion >= 22}  //XE=22,2010=21
     TSocket = NativeUInt;
  {$ELSE}
     TSocket = Integer;
  {$IFEND}

  PPSocketHashItem = ^PSocketHashItem;
  PSocketHashItem = ^TSocketHashItem;
  TSocketHashItem = record
    Next: PSocketHashItem;
    Key : TSocket;
    Value:Pointer;
  end;

  TSocketHash = class
  private
    FBucketPool:array of PSocketHashItem;
    Buckets: array of PSocketHashItem;
    function NewBucket():PSocketHashItem;
    procedure DisposeBucket(Value:PSocketHashItem);
  protected
    function Find(const Key: TSocket): PPSocketHashItem;
    function HashOf(const Key: TSocket): Cardinal; virtual;
  public
    constructor Create(Size: Cardinal = 256);
    destructor Destroy; override;
    function Add(const Key: TSocket; Value: Pointer):Integer;
    procedure Clear;
    procedure Remove(const Key: TSocket);
    function Modify(const Key: TSocket; Value: Pointer): Boolean;
    function ValueOf(const Key: TSocket): Pointer;
  end;

  TThreadSocketHash = class //线程安全
  private
    FObj:TSocketHash;
    FCS:TCriticalSection;
    procedure Lock();
    procedure UnLock();
  public
    constructor Create(Size: Cardinal = 256);
    destructor Destroy; override;
    function Add(const Key: TSocket; Value: Pointer):Integer;
    procedure Clear;
    procedure Remove(const Key: TSocket);
    function Modify(const Key: TSocket; Value: Pointer): Boolean;
    function ValueOf(const Key: TSocket): Pointer;
    function GetAndRemove(const Key:TSocket):Pointer;
  end;


implementation

{ TStringHash }

function TSocketHash.Add(const Key: TSocket; Value: Pointer):Integer;
var
  Hash: Integer;
  Bucket: PSocketHashItem;
begin
  Bucket:= NewBucket();
  if Bucket <> nil then
  begin
    Hash := HashOf(Key) mod Cardinal(Length(Buckets));
    Bucket^.Key := Key;
    Bucket^.Value := Value;
    Bucket^.Next := Buckets[Hash];
    Buckets[Hash] := Bucket;
    Result := Hash;
  end
  else Result := -1;//空间满
end;

procedure TSocketHash.Clear;
var
  I: Integer;
  P, N: PSocketHashItem;
begin
  for I := 0 to Length(Buckets) - 1 do
  begin
    P := Buckets[I];
    while P <> nil do
    begin
      N := P^.Next;
     // Dispose(P);
      DisposeBucket(P);
      P := N;
    end;
    Buckets[I] := nil;
  end;
end;

constructor TSocketHash.Create(Size: Cardinal);
var
  Index:Integer;
  PH:PSocketHashItem;
begin
  inherited Create;
  SetLength(Buckets, Size);
  //\
  SetLength(FBucketPool,Size); //:array of PSocketHashItem;
  for Index := Low(FBucketPool) to High(FBucketPool) do
  begin
    New(PH);
    PH^.Next  := nil;
    PH^.Key   := 0;
    PH^.Value := nil;
    FBucketPool[Index] := PH;
  end;
end;

destructor TSocketHash.Destroy;
var
  Index:Integer;
  P:PSocketHashItem;
begin
  Clear;
  for Index := Low(FBucketPool) to High(FBucketPool) do
  begin
    P := FBucketPool[Index];
    if P <> nil then Dispose(P);
  end;
  inherited Destroy;
end;

procedure TSocketHash.DisposeBucket(Value: PSocketHashItem);
var
  Index:Integer;
begin
  for Index := Low(FBucketPool) to High(FBucketPool) do
  begin
    if FBucketPool[Index] = nil then
    begin
      FBucketPool[Index] := Value;
      Break;
    end;
  end;
end;

function TSocketHash.Find(const Key: TSocket): PPSocketHashItem;
var
  Hash: Integer;
begin
  Hash := HashOf(Key) mod Cardinal(Length(Buckets));
  Result := @Buckets[Hash];
  while Result^ <> nil do
  begin
    if Result^.Key = Key then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

function TSocketHash.HashOf(const Key: TSocket): Cardinal;
var
  I: Integer;
  P: PByte;
begin
  Result := 0;
  P := @Key;
  //for I := 1 to Length(Key) do
   for I := 1 to SizeOf(Key) do
   begin
     Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor P^;
     Inc(P);
   end;
      //Ord(Key[I]);P^
end;

function TSocketHash.Modify(const Key: TSocket; Value: Pointer): Boolean;
var
  P: PSocketHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
  begin
    Result := True;
    P^.Value := Value;
  end
  else
    Result := False;
end;

function TSocketHash.NewBucket: PSocketHashItem;
var
  Index:Integer;
begin
  Result := nil;
  for Index := Low(FBucketPool) to High(FBucketPool) do
  begin
    Result := FBucketPool[Index];
    if Result <> nil then
    begin
      FBucketPool[Index] := nil;
      Break;
    end;
  end;
end;

procedure TSocketHash.Remove(const Key: TSocket);
var
  P: PSocketHashItem;
  Prev: PPSocketHashItem;
begin
  Prev := Find(Key);
  P := Prev^;
  if P <> nil then
  begin
    Prev^ := P^.Next;
    //Dispose(P);
    DisposeBucket(P);
  end;
end;

function TSocketHash.ValueOf(const Key: TSocket): Pointer;
var
  P: PSocketHashItem;
begin
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value
  else
    Result := nil;// -1;
end;



{ TThreadSocketHash }

function TThreadSocketHash.Add(const Key: TSocket; Value: Pointer):Integer;
begin
  Lock();
  try
    Result := FObj.Add(Key,Value);
  finally
    UnLock();
  end;
end;

procedure TThreadSocketHash.Clear;
begin
  Lock();
  try
    FObj.Clear();
  finally
    UnLock();
  end;
end;

constructor TThreadSocketHash.Create(Size: Cardinal);
begin
  FObj := TSocketHash.Create(Size);
  FCS := TCriticalSection.Create();
end;

destructor TThreadSocketHash.Destroy;
begin
  FCS.Free();
  FObj.Free();
  inherited;
end;

function TThreadSocketHash.GetAndRemove(const Key: TSocket): Pointer;
begin
  Lock();
  try
    Result := FObj.ValueOf(Key);
    FObj.Remove(Key);
  finally
    UnLock();
  end;
end;

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

function TThreadSocketHash.Modify(const Key: TSocket; Value: Pointer): Boolean;
begin
  Lock();
  try
    FObj.Modify(Key,Value);
  finally
    UnLock();
  end;
end;

procedure TThreadSocketHash.Remove(const Key: TSocket);
begin
  Lock();
  try
    FObj.Remove(Key);
  finally
    UnLock();
  end;
end;

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

function TThreadSocketHash.ValueOf(const Key: TSocket): Pointer;
begin
  Lock();
  try
    Result := FObj.ValueOf(Key);
  finally
    UnLock();
  end;
end;

end.