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.
delphi HASH类

相关推荐

评论
