改编自TStringHash的Delphi哈希表类

  1unit zjHashedTable;
  2
  3interface
  4
  5uses
  6  SysUtils,
  7  Classes;
  8
  9type
 10  TzjStringHashProc = function(const aKey:string):Cardinal;
 11  TzjHashItemDisposeProc = procedure(aData:Pointer);
 12  TzjHashTableIterator = function(aKey:string;aData:Pointer;aParam:LongInt):Boolean;
 13
 14  PPzjHashItem = ^PzjHashItem;
 15  PzjHashItem = ^TzjHashItem;
 16  TzjHashItem = record
 17    Next: PzjHashItem;
 18    Key: string;
 19    Data: Pointer;
 20  end;
 21
 22  TzjHashedTable = class(TObject)
 23  private
 24    Buckets: array of PzjHashItem;
 25    FHashProc: TzjStringHashProc;
 26    FDisposeProc:TzjHashItemDisposeProc;
 27    FOwnsItem:Boolean;
 28    FCount:Integer;
 29    function GetContents: TList;
 30    function GetCapacity: Integer;
 31  public
 32    constructor Create(aHashProc:TzjStringHashProc = nil;aSize: Cardinal = 256);
 33    destructor Destroy; override;
 34    function Find(const aKey: string;aPos: Integer = -1): PzjHashItem;
 35    function Insert(const aKey: string; aData: Pointer; FailIfExists:Boolean = False):Boolean;
 36    procedure Clear;
 37    function Remove(const aKey: string):Boolean;
 38    function Extract(const aKey: string;out aData:Pointer):Boolean;
 39    function Modify(const aKey: string; aData: Pointer): Boolean;
 40    function GetItem(const aKey: string;out aData:Pointer): Boolean;
 41    function Exists(const aKey:string):Boolean;
 42    function Iterate(aIteratePrco:TzjHashTableIterator;aParam:LongInt):Boolean;
 43    property Contents:TList read GetContents;
 44    property DisposeProc:TzjHashItemDisposeProc read FDisposeProc write FDisposeProc;
 45    property OwnsItem:Boolean read FOwnsItem write FOwnsItem;
 46    property Count:Integer read FCount;
 47    property Capacity:Integer read GetCapacity;
 48  end;
 49
 50implementation
 51
 52
 53function DefStringHash(const aKey:string):Cardinal;
 54var
 55  I: Integer;
 56begin
 57  Result := 0;
 58  for I := 1 to Length(aKey) do
 59    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
 60      Ord(aKey[I]);
 61end;
 62
 63{ TzjHashedTable }
 64
 65procedure TzjHashedTable.Clear;
 66var
 67  I: Integer;
 68  P, N: PzjHashItem;
 69begin
 70  for I := 0 to Length(Buckets) - 1 do
 71  begin
 72    P := Buckets[I];
 73    while P <> nil do
 74    begin
 75      N := P^.Next;
 76      if Self.FOwnsItem then
 77        Self.FDisposeProc(P.Data);
 78      Dispose(P);
 79      P := N;
 80    end;
 81  end;
 82  FillChar(Buckets[0],Length(Buckets)*SizeOf(PzjHashItem),0);
 83  FCount:=0;
 84end;
 85
 86constructor TzjHashedTable.Create(aHashProc:TzjStringHashProc;aSize: Cardinal);
 87begin
 88  if @aHashProc=nil then
 89    Self.FHashProc:=@DefStringHash
 90  else
 91    Self.FHashProc:=@aHashProc;
 92  SetLength(Buckets, aSize);
 93  FillChar(Buckets[0],Length(Buckets)*SizeOf(PzjHashItem),0);
 94  FCount:=0;
 95end;
 96
 97destructor TzjHashedTable.Destroy;
 98begin
 99  Clear;
  inherited;
end;

function TzjHashedTable.Exists(const aKey: string): Boolean;
begin
  Result:=Find(aKey)<>nil;
end;

function TzjHashedTable.Extract(const aKey: string;out aData: Pointer): Boolean;
var
  Hash: Integer;
  P,Prev:PzjHashItem;
begin
  Result:=False;
  Hash := FHashProc(aKey) mod Cardinal(Length(Buckets));
  Prev:=nil;
  P := Buckets[Hash];
  while P <> nil do
  begin
    if P.Key = aKey then
    begin
      if Prev<>nil then
        Prev.Next:=P.Next
      else
        Buckets[Hash]:=P.Next;
      aData:=P.Data;
      Dispose(P);
      Dec(FCount);
      Result:=True;
      Break;
    end
    else
    begin
      Prev:=P;
      P:=P.Next;
    end;
  end;
end;

function TzjHashedTable.Find(const aKey: string;aPos: Integer): PzjHashItem;
var
  Hash: Integer;
begin
  if aPos < 0 then
    Hash := FHashProc(aKey) mod Cardinal(Length(Buckets))
  else
    Hash := aPos;
  Result := Buckets[Hash];
  while Result <> nil do
  begin
    if Result.Key = aKey then
      Exit
    else
      Result := Result.Next;
  end;
end;

function TzjHashedTable.GetCapacity: Integer;
begin
  Result:=Length(Buckets);
end;

function TzjHashedTable.GetContents: TList;
var
  I,J: Integer;
  P: PzjHashItem;
begin
  if FCount=0 then
  begin
    Result:=nil;
    Exit;
  end;
  Result:=TList.Create;
  Result.Count:=Self.FCount;
  J:=0;
  for I := 0 to Length(Buckets) - 1 do
  begin
    P := Buckets[I];
    while P <> nil do
    begin
      Result.Items[J]:=P.Data;
      Inc(J);
      P:=P.Next;
    end;
  end;
end;

function TzjHashedTable.GetItem(const aKey: string;out aData: Pointer): Boolean;
var
  P: PzjHashItem;
begin
  P := Find(aKey);
  if P=nil then
    Result:=False
  else
  begin
    aData:=P.Data;
    Result:=True;
  end;
end;

function TzjHashedTable.Insert(const aKey: string; aData: Pointer; FailIfExists:Boolean):Boolean;
var
  Hash: Integer;
  P,Bucket: PzjHashItem;
begin
  Result:=False;
  Hash := FHashProc(aKey) mod Cardinal(Length(Buckets));
  P:=Self.Find(aKey,Hash);
  if p=nil then
  begin
    New(Bucket);
    Bucket.Key := aKey;
    Bucket.Data := aData;
    Bucket.Next := Buckets[Hash];
    Buckets[Hash] := Bucket;
    Inc(FCount);
    Result:=True;
  end
  else if not FailIfExists then
  begin
    if Self.FOwnsItem then
      Self.FDisposeProc(P.Data);
    P.Data:=aData;
    Inc(FCount);
    Result:=True;
  end;
end;

function TzjHashedTable.Iterate(aIteratePrco: TzjHashTableIterator;
  aParam: Integer): Boolean;
var
  I: Integer;
  P: PzjHashItem;
begin
  Result:=False;
  for I := 0 to Length(Buckets) - 1 do
  begin
    P := Buckets[I];
    while P <> nil do
    begin
      Result:=aIteratePrco(P.Key,P.Data,aParam);
      if Result then Exit;
      P:=P.Next;
    end;
  end;
end;

function TzjHashedTable.Modify(const aKey: string;aData: Pointer): Boolean;
var
  P: PzjHashItem;
begin
  P := Find(aKey);
  if P = nil then
    Result:=False
  else
  begin
    if P.Data<>aData then
    begin
      if Self.FOwnsItem then
        Self.FDisposeProc(P.Data);
      P.Data:=aData;
      Result:=True;
    end
    else
      Result:=False;
  end;
end;

function TzjHashedTable.Remove(const aKey: string): Boolean;
var
  P:Pointer;
begin
  Result:=Self.Extract(aKey,P);
  if Result and Self.FOwnsItem then
    Self.FDisposeProc(P);
end;

end.