delphi HASH类


这个HASH类是我在学习《DELPHI算法与数据结构》的时候按照上面的文字和例子重新整理的,就是为了自己看起来比较方便。这个HASH类使用的是线性探测的方式来消除冲突。希望这个HASH类对大家编写代码有一定的帮助。同时希望大家在发现代码中的错误或者问题后能给我留言。
{
类名  :线性探测HASH表
作者  :张超
创建时间  :2008-07-06
说明  :此HASH表使用线性探测方法实现。
修改说明  :
 2008-07-06  创建
测试说明  :
}
unit Hash_Unit;

interface
uses
 RecordList_Unit,Windows;
type
 TOnRomveHash  = procedure(Buf:Pointer) of object;
 //槽结构
 THashSlot = record
 FKey  : String;  //Hash的Key
 FItem : Pointer;  //内容
 FInUse: Boolean;  //是否在使用
 end;
 PHashSlot = ^THashSlot;
type
 THashClass = class
 private
 FHashCS:TRTLCriticalSection;
 FCount:Integer;
 FTable  : TRecordList;
 FOnRomve: TOnRomveHash;
 function  HashFunc(FKey:String;FTableSize:Integer):Integer;
 function  IndexOf(FKey:String;var FItem:Pointer):Integer;
 procedure SetTableSize(FTableSize:Integer);
 function  GetPrime(N:Integer):Integer;  //得到最接近的质数
 procedure SetOnRomve(const Value: TOnRomveHash);
 public
 constructor Create(TableSize:Integer = 1024);
 destructor Destroy; override;
 (****方法****)
 function  Delete(FKey:String):Boolean;
 function  Find(FKey:String;var FItem:Pointer):Boolean;
 function  Insert(const FKey:String;FItem:Pointer):Boolean;
 procedure Clear;
 published
 property  OnRomve:TOnRomveHash read FOnRomve write SetOnRomve;
 property  Count:Integer read FCount;
 end;
implementation
{ THashClass }
procedure THashClass.Clear;
var
 Inx : integer;
begin
 EnterCriticalSection(FHashCS);
 try
 if FCount<>0 then
 begin
 for Inx := 0 to pred(FTable.Count) do
 begin
 if PHashSlot(FTable[Inx])^.FInUse then
 begin
 PHashSlot(FTable[Inx])^.FKey:='';
 //抛出清空Hash中有数据的槽事件
 if Assigned(OnRomve) then
 begin
 OnRomve(PHashSlot(FTable[Inx])^.FItem);
 end;
 end;
 PHashSlot(FTable[Inx])^.FInUse:=false;
 end;
 FCount := 0;
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
constructor THashClass.Create(TableSize:Integer);
begin
 InitializeCriticalSection(FHashCS);
 FTable:=TRecordList.Create(SizeOf(THashSlot));
 FTable.Name:='';
 FTable.Count:=GetPrime(TableSize);
end;
function THashClass.Delete(FKey: String):Boolean;
var
 Inx:Integer;
 ItemSlot : Pointer;
 Slot : PHashSlot;
 Key  : string;
 Item : pointer;
begin
 EnterCriticalSection(FHashCS);
 try
 Result:=true;
 Inx := IndexOf(FKey, ItemSlot);
 if (Inx = -1) then
 begin
 //没有找到
 Result:=false;
 Exit;
 end;
 //Dispose(PHashSlot(ItemSlot).FItem);
 PHashSlot(ItemSlot).FInUse:=False;
 PHashSlot(ItemSlot).FKey:='';
 dec(FCount);
 inc(Inx);
 if (Inx = FTable.Count) then
 begin
 Inx := 0;
 end;
 Slot := PHashSlot(FTable[Inx]);
 while Slot^.FInUse do
 begin
 Item := Slot^.FItem;
 Key := Slot^.FKey;
 Slot^.FKey := '';
 Slot^.FInUse := False;
 dec(FCount);
 Insert(Key, Item);
 {move to the next slot}
 inc(Inx);
 if (Inx = FTable.Count) then
 begin
 Inx := 0;
 end;
 Slot := PHashSlot(FTable[Inx]);
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
destructor THashClass.Destroy;
begin
 if (FTable <> nil) then
 begin
 Clear;
 FTable.Destroy;
 end;
 DeleteCriticalSection(FHashCS);
 inherited Destroy;
end;
function THashClass.Find(FKey: String; var FItem: Pointer): Boolean;
var
 Slot : Pointer;
begin
 EnterCriticalSection(FHashCS);
 try
 if IndexOf(FKey,Slot)<>-1 then
 begin
 Result:=true;
 FItem:=PHashSlot(Slot).FItem;
 end
 else
 begin
 Result:=False;
 FItem:=nil;
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
function THashClass.GetPrime(N: Integer): Integer;
{$I TDPrimes.inc}
const
 Forever = true;
var
 L, R, M : integer;
 RootN  : integer;
 IsPrime : boolean;
 DivisorIndex : integer;
begin
 EnterCriticalSection(FHashCS);
 try
 if (N = 2) then
 begin
 Result := N;
 Exit;
 end;
 if Odd(N) then
 begin
 Result := N;
 end
 else
 begin
 Result := succ(N);
 end;
 if (Result <= MaxPrime) then
 begin
 L := 0;
 R := pred(PrimeCount);
 while (L <= R) do
 begin
 M := (L + R) div 2;
 if (Result = Primes[M]) then
 begin
 Exit;
 end
 else if (Result < Primes[M]) then
 begin
 R := pred(M);
 end
 else
 begin
 L := succ(M);
 end;
 end;
 Result := Primes[L];
 Exit;
 end;
 if (Result <= (MaxPrime * MaxPrime)) then
 begin
 while Forever do
 begin
 RootN := round(Sqrt(Result));
 DivisorIndex := 1; {ignore the prime number 2}
 IsPrime := true;
 while (DivisorIndex < PrimeCount) and (RootN > Primes[DivisorIndex]) do
 begin
 if ((Result div Primes[DivisorIndex]) * Primes[DivisorIndex] = Result) then
 begin
 IsPrime := false;
 Break;
 end;
 inc(DivisorIndex);
 end;
 if IsPrime then
 begin
 Exit;
 end;
 inc(Result, 2);
 end;
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
function THashClass.HashFunc(FKey: String; FTableSize: Integer): Integer;
var
 G:Longint;
 I:Integer;
 Hash:Longint;
begin
 Result:=0;
 Hash:=0;
 for I:=0 to Length(FKey) do
 begin
 Hash:=(Hash shl 4) + Ord(FKey[I]);
 G:=Hash and $F0000000;
 if (G<>0) then
 begin
 Hash:=Hash xor (G shr 24) xor G;
 end;
 Result:=Hash mod FTableSize;
 end;
end;
function THashClass.IndexOf(FKey: String; var FItem: Pointer): Integer;
var
 Inx:Integer;
 CurSlot  : PHashSlot;
 FirstInx : integer;
begin
 EnterCriticalSection(FHashCS);
 try
 //计算此KEY的Index
 Inx:=HashFunc(FKey,FTable.Count);
 FirstInx := Inx;
 while True do
 begin
 CurSlot := PHashSlot(FTable[Inx]);
 if not CurSlot.FInUse then
 begin
 FItem:=CurSlot;
 Result:=-1;
 Exit;
 end
 else
 begin
 if CurSlot^.FKey = FKey then
 begin
 FItem:=CurSlot;
 Result:=Inx;
 Exit;
 end;
 end;
 //没有找到,需要循环
 Inc(Inx);
 if (Inx = FTable.Count) then
 begin
 Inx := 0;
 end
 else if (Inx = FirstInx) then
 begin
 FItem := nil;
 Result := -1;
 Exit;
 end;
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
function THashClass.Insert(const FKey: String; FItem: Pointer):Boolean;
var
 Slot:Pointer;
begin
 EnterCriticalSection(FHashCS);
 try
 //加入HASH表中
 Result:=true;
 if IndexOf(FKey,Slot)<>-1 then
 begin
 //已经存在
 Result:=false;
 Exit;
 end;
 if Slot = nil then
 begin
 //Hash表已经满了
 Result:=false;
 Exit;
 end;
 PHashSlot(Slot).FKey:=FKey;
 PHashSlot(Slot).FItem:=FItem;
 PHashSlot(Slot).FInUse:=true;
 Inc(FCount);
 if FCount * 3 > (FTable.Count * 2) then
 begin
 //已经大于2/3需要扩展Hash表
 SetTableSize(GetPrime(succ(FTable.Count * 2)))
 end;
 finally
 LeaveCriticalSection(FHashCS);
 end;
end;
procedure THashClass.SetOnRomve(const Value: TOnRomveHash);
begin
 FOnRomve := Value;
end;
procedure THashClass.SetTableSize(FTableSize: Integer);
var
 Inx:Integer;
 OldTable:TRecordList;
begin
 OldTable := FTable;
 FTable := TRecordList.Create(sizeof(THashSlot));
 try
 FTable.Count := FTableSize;
 FCount := 0;
 for Inx := 0 to pred(OldTable.Count) do
 begin
 with PHashSlot(OldTable[Inx])^ do
 begin
 if FInUse then
 begin
 Insert(FKey, FItem);
 FKey := '';
 end;
 end;
 end;
 except
 FTable.Free;
 FTable := OldTable;
 raise;
 end;
 OldTable.Free;
end;
end.

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678