hashtrie.pas

让你知道什么是 HASH算法 ,我测试了一下,再大数据,通过HASH算法来查找,有时只要查找一次!

        Exit;
      end;
      LinkedItem:=LinkedItem.Next;
    end;
  end;
end;

function TTreeItem.ROR(Value: DWORD): DWORD;
begin
  Result:=((Value and $FF) shl 24) or ((Value shr 8) and $FFFFFF);
end;

function TTreeItem.RORN(Value: DWORD; Level: integer): DWORD;
begin
  Result:=Value;
  while Level > 0 do begin
    Result:=ROR(Result);
    Dec(Level);
  end;
end;

function TTreeItem.Traverse(UserData,UserProc: Pointer;
  TraverseProc: TTraverseProc): Boolean;
var j: integer;
    LinkedItem: TLinkedItem;
begin
  Result:=False;
  for j:=0 to LeafSize-1 do
    if Items[j] <> nil then begin
      if Items[j] is TTreeItem then begin
        Result:=TTreeItem(Items[j]).Traverse(UserData,UserProc,TraverseProc);
      end else begin
        LinkedItem:=TLinkedItem(Items[j]);
        while LinkedItem <> nil do begin
          TraverseProc(UserData,UserProc,LinkedItem.Value,LinkedItem.Data,Result);
          LinkedItem:=LinkedItem.Next;
        end;
      end;
      if Result then Exit;
    end;
end;

{ TLinkedItem }

constructor TLinkedItem.Create(FValue,FData: DWORD; FNext: TLinkedItem);
begin
  Value:=FValue;
  Data:=FData;
  Next:=FNext;
end;

destructor TLinkedItem.Destroy;
begin
  if Next <> nil then
    Next.Free;
end;

{ THashTrie }

procedure THashTrie.AddDown(Value,Data,Hash: DWORD);
begin
  if Root = nil then
    Root:=TTreeItem.Create(Self);
  Root.AddDown(Value,Data,Hash);
end;

procedure THashTrie.Delete(Value,Hash: DWORD);
begin
  if Root <> nil then
    Root.Delete(Value,Hash);
end;

function THashTrie.Find(Value,Hash: DWORD; var Data: DWORD): Boolean;
begin
  if Root <> nil then
    Result:=Root.Find(Value,Hash,Data)
  else
    Result:=False;
end;

constructor THashTrie.Create;
begin
  inherited;
  Root:=nil;
end;

destructor THashTrie.Destroy;
begin
  if Root <> nil then Root.Free;
  inherited;
end;

procedure THashTrie.Traverse(UserData, UserProc: Pointer;
  TraverseProc: TTraverseProc);
begin
  if Root <> nil then
    Root.Traverse(UserData, UserProc, TraverseProc);
end;

{ TStringHashTrie }

procedure TStringHashTrie.Add(const S: string; Data: TObject);
begin
  AddDown(DWORD(NewStr(S)),DWORD(Data),HashStr(S));
end;

function TStringHashTrie.CompareValue(Value1, Value2: DWORD): Boolean;
begin
  if FCaseSensitive then
    Result:=PString(Value1)^ = PString(Value2)^
  else
    Result:=ANSICompareText(PString(Value1)^,PString(Value2)^) = 0;
end;

constructor TStringHashTrie.Create;
begin
  inherited;
  FCaseSensitive:=False;
  FAutoFreeObjects:=False;
end;

procedure TStringHashTrie.Delete(const S: string);
begin
  inherited Delete(DWORD(@S),HashStr(S));
end;

procedure TStringHashTrie.DestroyItem(var Value,Data: DWORD);
begin
  DisposeStr(PString(Value));
  if FAutoFreeObjects then
    TObject(Data).Free;
  Value:=0;
  Data:=0;
end;

function TStringHashTrie.Find(const S: string; var Data: TObject): Boolean;
begin
  Result:=inherited Find(DWORD(@S),HashStr(S),DWORD(Data));
end;

function TStringHashTrie.HashStr(const S: string): DWORD;
{var i: integer;}
begin
  if CaseSensitive then
    Result:=CalcStrCRC32(S)
  else
    Result:=CalcStrCRC32(ANSIUpperCase(S));

{ another hash fucn with good performance
  see code at the end of this unit
  if CaseSensitive then
    Result:=HashP2Str(S)
  else
    Result:=HashP2Str(ANSIUpperCase(S));
}

{ simple hash-func. don't use it !!!
  result:=Length(S);
  for i:=1 to Length(S) do
    if CaseSensitive then
      Result:= ((Result shl 5) xor (Result shr 27)) xor Ord(S[i])
    else
      Result:= ((Result shl 5) xor (Result shr 27)) xor Ord(ANSIUpperCase(S)[i]);
}
end;

function TStringHashTrie.HashValue(Value: DWORD): DWORD;
begin
  Result:=HashStr(PString(Value)^);
end;

procedure TStringHashTrie.Traverse(UserData: Pointer;
  UserProc: TStrHashTraverseProc);
begin
  inherited Traverse(UserData,@UserProc,TraverseProc);
end;

procedure TStringHashTrie.TraverseProc(UserData, UserProc: Pointer; Value,
  Data: DWORD; var Done: Boolean);
begin
  TStrHashTraverseProc(UserProc)(UserData,PString(Value)^,TObject(Data),Done);
end;

procedure TStringHashTrie.Traverse(UserData: Pointer; UserProc: TStrHashTraverseMeth);
begin
  inherited Traverse(UserData,@TMethod(UserProc),TraverseMeth);
end;

procedure TStringHashTrie.TraverseMeth(UserData, UserProc: Pointer; Value,
  Data: DWORD; var Done: Boolean);
type
  PTStrHashTraverseMeth = ^TStrHashTraverseMeth;
begin
  PTStrHashTraverseMeth(UserProc)^(UserData,PString(Value)^,TObject(Data),Done);
end;

{ dynamic crc32 table }

const
  CRC32_POLYNOMIAL = $EDB88320;
var
  Ccitt32Table: array[0..255] of DWORD;

function CalcStrCRC32(const S: string): DWORD;
var j: integer;
begin
  Result:=$FFFFFFFF;
  for j:=1 to Length(S) do
    Result:= (((Result shr 8) and $00FFFFFF) xor (Ccitt32Table[(Result xor byte(S[j])) and $FF]));
end;

procedure BuildCRCTable;
var i, j: longint;
    value: DWORD;
begin
  for i := 0 to 255 do begin
    value := i;
    for j := 8 downto 1 do
      if ((value and 1) <> 0) then
        value := (value shr 1) xor CRC32_POLYNOMIAL
      else
        value := value shr 1;
    Ccitt32Table[i] := value;
  end
end;

{ another hash func with good performance
  but more slow than CRC32

function HashP2(const Buff; buffLen: integer; initval: DWORD): DWORD;
var a,b,c: DWORD;  // the internal state
    len: integer;  // how many key bytes still need mixing
    k: PDWORD;
    kc: PByte;
  procedure hash_mix(var a,b,c: DWORD);
  begin
    a := a-b;  a := a-c;  a := a xor (c shr 13);
    b := b-c;  b := b-a;  b := b xor (a shl 8);
    c := c-a;  c := c-b;  c := c xor (b shr 13);
    a := a-b;  a := a-c;  a := a xor (c shr 12);
    b := b-c;  b := b-a;  b := b xor (a shl 16);
    c := c-a;  c := c-b;  c := c xor (b shr 5);
    a := a-b;  a := a-c;  a := a xor (c shr 3);
    b := b-c;  b := b-a;  b := b xor (a shl 10);
    c := c-a;  c := c-b;  c := c xor (b shr 15);
  end;
begin
   // Set up the internal state
   len := buffLen;
   k := PDWORD(@Buff);
   a := $9E3779B9;  // the golden ratio; an arbitrary value
   b := a;
   c := initval;    // variable initialization of internal state
   //---------------------------------------- handle most of the key
   while len >= 12 do begin
      a:=a+k^; Inc(k);
      b:=b+k^; Inc(k);
      c:=c+k^; Inc(k);
      hash_mix(a,b,c);
      Dec(len,12);
   end;
   //------------------------------------- handle the last 11 bytes
   c := c+DWORD(buffLen);
   kc := PByte(integer(k)+len-1);
   while len > 0 do begin
     case len of  // all the case statements fall through
       11: c := c+(kc^ shl 24);
       10: c := c+(kc^ shl 16);
       9 : c := c+(kc^ shl 8);
        // the first byte of c is reserved for the Len 
       8 : b := b+(kc^ shl 24);
       7 : b := b+(kc^ shl 16);
       6 : b := b+(kc^ shl 8);
       5 : b := b+kc^;
       4 : a := a+(kc^ shl 24);
       3 : a := a+(kc^ shl 16);
       2 : a := a+(kc^ shl 8);
       1 : a := a+kc^;
     end;
     Dec(len); Dec(kc);
   end;
   hash_mix(a,b,c);
   //-------------------------------------------- report the result
   Result := c;
end;

function HashP2Str(const Str: string): DWORD;
var S: string;
begin
  S:=ANSIUpperCase(Str);
  Result:=HashP2(S[1],Length(S),0);
end; }

initialization
  BuildCRCTable;
end.