Hash表，其实就是一个Key对应一个Object
在Delphi里最简单实现Hash的就是TStrings
通过它的AddObject,IndexOf,Objects等方法可以做一个很简单的Hash表。
TStrings没有排序，所以IndexOf比较慢，而它的子类TStringList具有Stored属性，设置为True之后，IndexOf是用折半查找的，效率很高。
所以在Delphi里可以用TstringList做一个简单的Hash。
但是TStringList做Hash是有一些限制性的
1.只限字符串做Key了
2.HashCode冲突没法解决
3.不可并发
类似TStrings及其子类的还有TList及类似List等。
但是这些都存在着Hash冲突和并发问题。
现在就来在Delphi的基础的TList和TInterfaceList的基础上做一个 通用的可并发并且有效解决Hash冲突的Hash表。
先是总体结构
Hash表是一个List，就用TList就行了，Hash表类THashTable
为了解决Hash冲突，每个Hash的List的一个点其实也应该是一个对列，我这里采用了TinterfaceList，冲突列表类THashItemQueue，原因后面再讲。
这样做出来其实就像一个二维数组一样，一维的是Hash队列THashTable，二维的HashCode冲突的队列THashItemQueue。
THashTable 1:n THashItemQueue
再来考虑并发问题
以THashTable 的List来说，它是通过HashCode定位的，并且容量大小最好先固定下来，这样Hash表本身就不存在并发问题，本身就可支持并发了。
但是Hash冲突列表THashItemQueue因为在查找添加删除时都会有并发问题，所以，为每一个THashItemQueue实例做临界区保护即可。
再就是通用性考虑。
为了适应不同的HashCode计算，和节点比较
所以应该把这两个接口外放，即要由调用者实现，而ThashTable只提供一个容器和接口
先看HashCode，HashCode计算其实就是一个函数，通过计算节点的Key值，计算出在Hash表中的位置。所以可以定义一个函数引用。TCalHashCode = function(Key: Pointer): Integer of object; 而THashTable 里设置一个TCalHashCode 属性，调用者实现这个函数并传给THashTable
而节点与Key之间的比较，可以通过让节点实现ComparetoKey接口的
//--比较的接口
ICompare = interface
['{C43DAF4B-E08D-4E09-B830-342D1B10B7B7}'] //一定要GUID，以做接口转换
// a>b 返回 1,相等=0, a<b返回-1
//为了适应数值类型和对象引用，故采用指针方式传参
function CompareToKey(Key: Pointer): Integer;
end;
这样就可以把Key的比较完全外放，而达到ThashTable完全通用的目的。
再来考虑另一个重要的问题:节点的生命周期问题。
节点何时应该被正确释放？
我采用的方法是让接口来管理节点生命周期的，当没有对一个节点对象的任何引用时，该节点被释放。
综上，以下是该Hash的定义和实现代码
{
Hash 表及相关定义和实现
晚起的小虫
2006-6-11
THashTable 为Hash表
TCalHashCode 为计算Hash值的函数。外部传入到THashTable
THashItemQueue 为解决Hash值冲突的链表
ICompare 比较的接口，在Hash表中查找Key时用，节点对象必须实现该接口。
TItemObject 节点虚类。
}
unit uHash;
interface
uses
Classes, SysUtils, Forms, SyncObjs ,Windows;
type
//----------------节点----------------------
//--比较的接口
ICompare = interface
['{C43DAF4B-E08D-4E09-B830-342D1B10B7B7}'] //一定要GUID，以做接口转换
// a>b 返回 1,相等=0, a<b返回-1
//为了适应数值类型和对象引用，故采用指针方式传参
function CompareToKey(Key: Pointer): Integer;
end;
//--节点纯虚类
TItemObject = class(TInterfacedObject, ICompare)
public
function CompareToKey(Key: Pointer): Integer; virtual; abstract;
end;
//---------------节点链表----------------------------
//--Hash节点链表，解决Hash冲突。
{
THashItemQueue以保存接口的方式保存对象引用，要保存的节点对象必须实现IInterface和ICompare接口
}
THashItemQueue = class
protected
FLock: TCriticalSection;
FList: TInterfaceList;
function GetItems(i: Integer): IInterface;
function GetCount: Integer;
function SordFind(Key: Pointer;var Index:Integer):Boolean;
public
constructor Create;
destructor Destroy; override;
property Items[i: Integer]: IInterface read GetItems;
//按Key查找，找到返回节点的位置，找不到返回-1
function IndexOf(Key: Pointer): Integer;
//按Key查找，找到返回节点接口，找不到返回nil
function Find(Key: Pointer): IInterface;
property Count: Integer read GetCount;
//添加节点，重复的忽略
function Add(Key: Pointer; Item: IInterface):Boolean;
procedure Delete(i: Integer);
procedure Lock; //进入临界区锁定
procedure UnLock; //解除临界区锁定
end;
//----------------HashTable---------------------------
//--利用接口的引用计数来统计当前正在被Lock中的THashItemQueue个数统计
TLockStater = class(TInterfacedObject)
protected
function GetLockCount: Integer;
public
property LockCount: Integer read GetLockCount;
end;
//--计算Hash的函数
TCalHashCode = function(Key: Pointer): Integer of object;
//--Hash接口
IHashTable = interface
['{A05C330A-DA86-4909-BBF5-B98931293735}']
function Find(Key: Pointer): IInterface;
procedure Add(Key: Pointer; obj: IInterface);
procedure Delete(Key: Pointer);
end;
//--Hash链表
THashTable = class(TInterfacedObject, IHashTable)
private
FItemsCount: Integer;
function GetUseItemCount: Integer;
protected
FLockStaterObj: TLockStater;
FLockStater: IInterface; //Lock计数自引用接口
FCount: Integer;
FCalHashCode: TCalHashCode;
FList: TList;
function FindItem(Key: Pointer): THashItemQueue;
procedure Error(Msg:string);
public
constructor Create(ItemsCount: Integer; CalHashCode: TCalHashCode);
destructor Destroy; override;
//查找,找到返回对象接口,找不到返回nil
function Find(Key: Pointer): IInterface;
//添加接口，如果Key已存在，则不添加
procedure Add(Key: Pointer; obj: IInterface);
//删除一个Key
procedure Delete(Key: Pointer);
property Count: Integer read FCount;
property ItemsCount:Integer read FItemsCount;
property UseItemCount: Integer read GetUseItemCount;
end;
//----------------------------------------------
implementation
{ TLockStater }
function TLockStater.GetLockCount: Integer;
begin
Result := FRefCount;
end;
{ THashItemQueue }
function THashItemQueue.Add(Key: Pointer; Item: IInterface):Boolean;
var
i :integer;
begin
if SordFind(Key,i) then
begin
Result := False;
Exit;//如果已存在则退出
end;
FList.Insert(i,Item);
Result := True;
end;
constructor THashItemQueue.Create;
begin
inherited;
FList := TInterfaceList.Create;
FLock := TCriticalSection.Create;
end;
procedure THashItemQueue.Delete(i: Integer);
begin
FList.Delete(i);
end;
destructor THashItemQueue.Destroy;
var
i: Integer;
begin
for i := FList.Count - 1 downto 0 do
begin
FList.Delete(i);
end;
FLock.Free;
FList.Free;
inherited;
end;
function THashItemQueue.Find(Key: Pointer): IInterface;
var
i: Integer;
begin
i := indexOf(Key);
if i >= 0 then Result := FList.Items[i]
else Result := nil;
end;
function THashItemQueue.GetCount: Integer;
begin
Result := FList.Count;
end;
function THashItemQueue.GetItems(i: Integer): IInterface;
begin
Result := FList.Items[i];
end;
function THashItemQueue.IndexOf(Key: Pointer): Integer;
var
i: Integer;
begin
Result := -1;
if SordFind(Key,i) then Result := i;
end;
procedure THashItemQueue.Lock;
begin
FLock.Enter;
end;
function THashItemQueue.SordFind(Key: Pointer; var Index: Integer): Boolean;
var
L, H, I, C: Integer;
begin
//折半查找
Result := False;
L := 0;
H := Count - 1;
while L <= H do
begin
I := (L + H) shr 1;
C := (FList.Items[i] as ICompare).CompareToKey(Key);
if C < 0 then L := I + 1 else
begin
H := I - 1;
if C = 0 then
begin
Result := True;
L := I;
end;
end;
end;
Index := L;
end;
procedure THashItemQueue.UnLock;
begin
FLock.Leave;
end;
{ THashTable }
procedure THashTable.Add(Key: Pointer; obj: IInterface);
var
Item: THashItemQueue;
tmp: IInterface;
begin
tmp := FLockStater;
Item := FindItem(Key);
Item.Lock;
try
if Item.Add(Key, obj) then InterlockedIncrement(FItemsCount)
else
Error('Key已存在!添加失败!');
finally
Item.UnLock;
end;
end;
constructor THashTable.Create(ItemsCount: Integer; CalHashCode: TCalHashCode);
var
i: Integer;
begin
inherited Create;
FCount := ItemsCount;
FCalHashCode := CalHashCode;
FList := TList.Create;
for i := 0 to FCount - 1 do
begin
FList.Add(THashItemQueue.Create);
end;
FLockStaterObj := TLockStater.Create;
FLockStater := FLockStaterObj;
end;
procedure THashTable.Delete(Key: Pointer);
var
Item: THashItemQueue;
i: Integer;
tmp: IInterface;
begin
tmp := FLockStater;
Item := FindItem(Key);
Item.Lock;
try
i := Item.IndexOf(Key);
if i >= 0 then
begin
Item.Delete(i);
InterlockedDecrement(FItemsCount);
end
else
Error('要删除的Key不存在!');
finally
Item.UnLock;
end;
end;
destructor THashTable.Destroy;
var
i: Integer;
begin
for i := FCount - 1 downto 0 do
TObject(FList.Items[i]).Free;
FList.Free;
FLockStater := nil;
inherited;
end;
procedure THashTable.Error(Msg: string);
begin
raise Exception.Create(Msg);
end;
function THashTable.Find(Key: Pointer): IInterface;
var
Item: THashItemQueue;
i: Integer;
tmp: IInterface;
begin
tmp := FLockStater;
Item := FindItem(Key);
Item.Lock;
try
Result := Item.Find(Key);
finally
Item.UnLock;
end;
end;
function THashTable.FindItem(Key: Pointer): THashItemQueue;
var
i: integer;
begin
i := FCalHashCode(Key);
Result := THashItemQueue(FList.Items[i]);
end;
function THashTable.GetUseItemCount: Integer;
begin
Result := FLockStaterObj.LockCount;
end;
end.