delphi的hashmap

delphi的hashmap

/// 支持D7，更低版本没有测试，支持跨OS

unit hashMap;

interface

uses
  SysUtils;

type
  PHashData = ^THashData;

  THashData = record
    KeyS: string;
    KeyI: Int64;
    Next: PHashData;
    Data: Pointer;
  end;

  THashMap = class
  private
    FBucketsSize: Cardinal;                  // 桶大小
    FBuckets: array of PHashData;    // 桶
  public
    constructor Create(BucketsSize: Cardinal = 20000);
    destructor destroy; override;
  public
    procedure SetValue(const key: string; val: Pointer); overload;
    procedure SetValue(const key: integer; val: Pointer); overload;
    function GetValue(const key: string; var val: Pointer): Boolean; overload;
    function GetValue(const key: Integer; var val: Pointer): Boolean; overload;
  end;

function hashOf(const p: Pointer; l: Integer): Integer; overload;

function hashOf(const s: string): Integer; overload;

implementation

function hashOf(const p: Pointer; l: Integer): Integer; overload;
var
  ps: PInteger;
  lr: Integer;
begin
  Result := 0;
  if l > 0 then
  begin
    ps := p;
    lr := (l and $03);
    l := (l and $FFFFFFFC);
    while l > 0 do
    begin
      Result := ((Result shl 5) or (Result shr 27)) xor ps^;
      Inc(ps);
      Dec(l, 4);
    end;
    if lr <> 0 then
    begin
      l := 0;
      Move(ps^, l, lr);
      Result := ((Result shl 5) or (Result shr 27)) xor l;
    end;
  end;
end;

function hashOf(const s: string): Integer; overload;
begin
  Result := hashOf(PChar(s), Length(s) * SizeOf(Char));
end;

{ THashMap }

constructor THashMap.Create(BucketsSize: Cardinal = 20000);
var
  i: Integer;
begin
  FBucketsSize := BucketsSize;
  SetLength(FBuckets, FBucketsSize);
  for i := 0 to FBucketsSize - 1 do
    FBuckets[i] := nil;
end;

destructor THashMap.destroy;
var
  I: Integer;
  item, lNext: PHashData;
begin
  for I := 0 to High(FBuckets) do
  begin
    lNext := FBuckets[I];
    while lNext <> nil do
    begin
      item := lNext;
      lNext := lNext.Next;
      Dispose(item);
    end;
  end;
  inherited;
end;

function THashMap.GetValue(const key: string; var val: Pointer): Boolean;
var
  Idx: Cardinal;
  Rec: PHashData;
  HashV: Cardinal;
begin
  Result := False;
  HashV := Cardinal(hashOf(key));
  Idx := HashV mod Cardinal(FBucketsSize);
  Rec := FBuckets[Idx];
  while Assigned(Rec) do
  begin
    if Rec.KeyS = key then
    begin
      val := Rec.Data;
      Result := True;
      Break;
    end;
    Rec := Rec.Next;
  end;
end;

procedure THashMap.SetValue(const key: string; val: Pointer);
var
  Idx: Integer;
  Rec, MatchtedRec: PHashData;
  hashVal: Cardinal;
begin
  hashVal := Cardinal(hashof(key));
  Idx := hashVal mod Cardinal(FBucketsSize);
  Rec := FBuckets[Idx];
  MatchtedRec := nil;
  while Assigned(Rec) do
  begin
    if Rec.KeyS = key then
    begin
      MatchtedRec := Rec;
      Break;
    end;
    Rec := Rec.Next;
  end;
  if MatchtedRec <> nil then
  begin
    MatchtedRec.Data := val;
  end
  else
  begin
    New(MatchtedRec);
    MatchtedRec.KeyS := key;
    MatchtedRec.Data := val;
    MatchtedRec.Next := FBuckets[Idx];
    FBuckets[Idx] := MatchtedRec;
  end;
end;

function THashMap.GetValue(const key: Integer; var val: Pointer): Boolean;
var
  Idx: Cardinal;
  Rec: PHashData;
begin
  Result := False;
  Idx := Cardinal(key) mod FBucketsSize;
  Rec := FBuckets[Idx];
  while Assigned(Rec) do
  begin
    if Rec.KeyI = key then
    begin
      val := Rec.Data;
      Result := True;
      Break;
    end;
    Rec := Rec.Next;
  end;
end;

procedure THashMap.SetValue(const key: integer; val: Pointer);
var
  Idx: Integer;
  Rec, MatchtedRec: PHashData;
begin
  Idx := Cardinal(key) mod Cardinal(FBucketsSize);
  Rec := FBuckets[Idx];
  MatchtedRec := nil;
  while Assigned(Rec) do
  begin
    if Rec.KeyI = key then
    begin
      MatchtedRec := Rec;
      Break;
    end;
    Rec := Rec.Next;
  end;
  if MatchtedRec <> nil then
  begin
    MatchtedRec.Data := val;
  end
  else
  begin
    GetMem(MatchtedRec, SizeOf(THashData));
    MatchtedRec.KeyI := key;
    MatchtedRec.Data := val;
    MatchtedRec.Next := FBuckets[Idx];
    FBuckets[Idx] := MatchtedRec;
  end;
end;

end.