请各位多提意见，可并发高效Hash表！(200分)

小弟因实现须要，便自己写一个Hash表的实现，以提供多线程下的高效Hash添加查找。
初步已实现完成，因我要考虑把它写成为了一比较通用的Hash表，所以用了不少接口。
但是我觉得我这个模型调用起来好像有点麻烦。不知道各位高人对此有何建议。测试工程下载地址:http://sorong.vicp.net/hash.rar
{
Hash 表及相关定义和实现
晚起的小虫
2006-6-11
THashTable 为Hash表
TCalHashCode　为计算Hash值的函数。外部传入到THashTable
THashItemQueue　为解决Hash值冲突的链表
ICompare　比较的接口，在Hash表中查找Key时用，节点对象必须实现该接口。
TItemObject 节点虚类。
}
unit uHash;

interface
uses
Classes, SysUtils, Forms, SyncObjs;
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;
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;
//添加节点，重复的忽略
procedure Add(Key: Pointer
Item: IInterface);
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
function GetUseItemCount: Integer;
protected
FLockStaterObj: TLockStater;
FLockStater: IInterface
//Lock计数自引用接口
FCount: Integer;
FCalHashCode: TCalHashCode;
FList: TList;
function FindItem(Key: Pointer): THashItemQueue;
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 UseItemCount: Integer read GetUseItemCount;
end;
//----------------------------------------------
implementation

{ TLockStater }

function TLockStater.GetLockCount: Integer;
begin
Result := FRefCount;
end;

{ THashItemQueue }

procedure THashItemQueue.Add(Key: Pointer
Item: IInterface);
begin
if indexOf(Key) >= 0 then
Exit
//如果原先存在就退出
FList.Add(Item);
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
else Result := nil;
end;

function THashItemQueue.GetCount: Integer;
begin
Result := FList.Count;
end;

function THashItemQueue.GetItems(i: Integer): IInterface;
begin
Result := FList.Items;
end;

function THashItemQueue.indexOf(Key: Pointer): Integer;
var
i: Integer;
// Comparer:ICompare;
begin
Result := -1;
if FList.Count = 0 then exit;
for i := 0 to FList.Count - 1 do
begin
if (FList.Items as ICompare).CompareToKey(Key) = 0 then
begin
Result := i;
Break;
end;
end;
end;

procedure THashItemQueue.Lock;
begin
FLock.Enter;
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
Item.Add(Key, obj);
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
Item.Delete(i);
finally
Item.UnLock;
end;
end;

destructor THashTable.Destroy;
var
i: Integer;
begin
for i := FCount - 1 downto 0 do
TObject(FList.Items).Free;

FList.Free;
FLockStater := nil;
inherited;
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);
end;

function THashTable.GetUseItemCount: Integer;
begin
Result := FLockStaterObj.LockCount;
end;

end.

unit uMain;

{$DEFINE DEBUG}}
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uHash;

type
TfrmMain = class(TForm)
mmo1: TMemo;
mmo2: TMemo;
btnCreate: TButton;
btnAdd: TButton;
btnFind: TButton;
edt1: TEdit;
btnDel: TButton;
edt2: TEdit;

btnFree: TButton;
procedure btnCreateClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure btnDelClick(Sender: TObject);
procedure btnFreeClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FHashTable: THashTable;
function CalHashCode(Key: Pointer): Integer;
end;

//测试接口
ITest = interface
['{570CBC50-20BE-4AEF-9199-52E33737A146}']
function getID: Integer;
function GetName: string;
end;

//测试的节点对象
TTestItem = class(TItemObject, ITest)
protected
FID: Integer;
FName: string;
public
{ public declarations }
constructor Create(aID: integer
aname: string);
destructor Destroy
override;

function getID: Integer;
function GetName: string;
function CompareToKey(Key: Pointer): Integer
override;
end;

var
frmMain: TfrmMain;
const
MaxItemsCount = 100;

implementation

{$R *.dfm}

procedure AddInfo(s: string);
begin
frmMain.mmo1.Lines.Add(s);
end;
{ TTestItem }

function TTestItem.CompareToKey(Key: Pointer): Integer;
begin
if FID = PInteger(Key)^ then
Result := 0
else if FID > PInteger(Key)^ then
Result := 1
else Result := -1;
end;

constructor TTestItem.Create(aID: integer
aName: string);
begin
FName := aname;
FID := aID

end;

destructor TTestItem.Destroy;
begin
//跟踪调试节点的释放
{$IFDEF DEBUG}
AddInfo(Format('Key is %d has Free', [FID]));
{$ENDIF}}
inherited;
end;

function TTestItem.getID: Integer;
begin
Result := FID
end;

function TTestItem.GetName: string;
begin
Result := FName

end;

{ TfrmMain }

function TfrmMain.CalHashCode(Key: Pointer): Integer;
begin
//计算Hash值
Result := PInteger(Key)^ mod MaxItemsCount;
end;

procedure TfrmMain.btnCreateClick(Sender: TObject);
begin
//创建
mmo2.Clear;
if FHashTable <> nil then FHashTable.Free;
FHashTable := THashTable.Create(MaxItemsCount, Self.CalHashCode);
mmo2.Lines.Add('Create hash table ' + inttostr(MaxItemsCount))

end;

procedure TfrmMain.btnAddClick(Sender: TObject);
var
i: Integer;
begin
//新增
for i := 0 to MaxItemsCount * 3 - 1 do
begin
if Random(3) = 0 then
begin
FHashTable.Add(@i, TTestItem.Create(i, 'Obj' + IntToStr(i)));
mmo2.Lines.Add(IntToStr(i))

end;
end;
end;

procedure TfrmMain.btnFindClick(Sender: TObject);
var
key: Integer;
iface: IInterface;
item: ITest;
begin
//查找显示
key := StrToInt(edt1.Text);
iface := FHashTable.Find(@key);
if iface = nil then //查找失败
mmo1.Lines.Add(Format('%d not find', [key]))
else
begin
item := iface as ITest;
AddInfo(Format('%d:%s is Exists', [item.getID, item.GetName]))

end;
end;

procedure TfrmMain.btnDelClick(Sender: TObject);
var
key: Integer;
begin
//删除
key := StrToInt(edt2.Text);
FHashTable.Delete(@key);
AddInfo(Format('%d is DELETE', [key]));
end;

procedure TfrmMain.btnFreeClick(Sender: TObject);
begin
//释放
FreeAndNil(FHashTable);
end;

end.


这个是我一个用来测试的小例子，暂时没有用上多线程。

各位可以到 http://sorong.vicp.net/hash.rar
下载整个工程来测试。16K而已
希望各位高人多提意见，在性能和易用性方面都可以。

Find方法是否可以有更加高效率的找法呢，一个一个轮询应该不是最好的方法。

Find方法确实可以提高效率的，比如用折半。而且实现也不难，只是一开始我觉得没啥大必要，毕竟THashItemsQueue只是为了解决Hash冲突而存在。一般Hash冲突的也不多。
不过为了更通用，使这个Hash可以做为一个更通用的容器，使用高效的Find还是有必要的。
呵呵，接受意见。

为Find方法提供折半查找了
更改如下
THashItemQueue新增保护方法
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 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;
修改IndexOf,Add方法
function THashItemQueue.indexOf(Key: Pointer): Integer;
var
i: Integer;
begin
Result := -1;
if SordFind(Key,i) then Result := i;
end;
procedure THashItemQueue.Add(Key: Pointer
Item: IInterface);
var
i :integer;
begin
if SordFind(Key,i) then Exit;//如果已存在则退出
FList.Insert(i,Item);
end;

key 可以是任何数据?对象或者其他?

Key可以是任何数据，但是对Key的操作却是要调用者负责。
用Key计算HashCode的　用户要定义一个TCalHashCode的函数
用Key对比就是节点要实现ICompare接口，CompareToKey方法。
这个考虑是为了通用性而设计的，当然调用者为了方便使用，可以已根据实际情况再封装一层。

。。。没人看得上眼吗？

高手哈

高！实在的高！

是否还应该加上线程安全的保护呢？

是这样的
THashTable 是没有必要加线程保护的,因为它本身是通过HashCode定位的,而且它包含的节点是THashItemQueue,是不会被删除的.须要保护的是THashItemQueue,它是有对象的添加删除的,所以要加线程保护的的
所以THashItemQueue具有以下两个方法
procedure Lock
//进入临界区锁定
procedure UnLock
//解除临界区锁定
而THashTable调用时
Item := FindItem(Key);
Item.Lock;
try
i := Item.indexOf(Key);
if i >= 0 then
Item.Delete(i);
finally
Item.UnLock;
end;
通用这种方式来锁定THashItemQueue而达到线程并发的目的的.而真正的节点对象是用接口保存的,这样就保证了绝对不会引用一个已经被释放的对象...

呵,不知道还有没有更好的处理方法.

多人接受答案了。