Delphi7中 自己创建HashTable

在Delphi7 以下版本中，我们发现库是不带HashTable这个类的，而这个类在java中被应用得风生水起。

一直想用Delphi7开发简单的数据库处理程序，但是我不想用Delphi中的那些个自动化的控件，不可控，不自由。

于是参照java，自己开发了很多类，包含字符串处理的，集合类。

对于多线程编程，队列也是一个基本类，一并开发了。自己开发的类有一个好处，就是方法随便添加，根据需要可以自由优化。那些通用的类和方法，通常性能是很差的，就如一个循环队列，Delphi本身就没有，别人开发的，测试了下，性能低得很。对于大数据量来说，线程池调度、队列等算法就很有发挥空间。

原来对java哈希表感觉很是神奇，其查询速度快得出奇，后来看了下其原理，才清楚背后的数学逻辑。

自己学着编写了一下，感觉还是不错的。对不同的hash函数进行了可视化的测试。

用一个GRID控件显示，来看下hash值分布情况，一目了然。对于不同的key类型测试，当然越均匀越好。

 

unit RSHashtable;
    
interface
    
uses  Windows,Classes, RSBase, sysutils;

type

 { TRSHashTable }

      PPRSHashItem = ^PRSHashItem;      //如果采用双向链表则不需要复指针。
      PRSHashItem = ^TRSHashItem;
      TRSHashItem = record
         Next: PRSHashItem;
         Key: string;
         IntValue: Integer;
         StrValue: String;     //double 采用string保存，FloatToStr
         Objvalue: TObject;
      end;

      TRSHashTable = class(TRSThreadObject)
      private
         FItemCount:cardinal;
         FArraySize: cardinal;
         FMaxTableSize:cardinal;
         FMulti: boolean;
         FAutoGrowth:boolean;      //不容许自动增长则是线程安全的。
         ArrayTable: array of PRSHashItem;
         function createHashItem(const Key: string):PRSHashItem;
      protected
         function Find(const Key: string): PPRSHashItem;
         function FindByCode(hashcode:cardinal;key:String): PPRSHashItem;
         function HashOf(const Key: string): Cardinal; virtual;
      public
         constructor Create(Size: Integer = 256; multi:boolean = false; AutoGrowth:boolean=true);
         destructor Destroy; override;
         function  GetInteger(const Key: String): Integer;
         function  GetString(const Key: String): String;
         function  GetObject(const Key: string): TObject;
         function  GetItem(const key:String): TRSHashItem;
         function  keyExists(const Key: String): boolean;
         function  GetArrayTable: Pointer;
         function  KeyToList(key:String;isStartWithKey:boolean=false):TStringList;
         function  ObjValueToList():TList;overload;
         function  ObjValueToListEx(key:String;isStartWithKey:boolean=false):TList;overload;
         function  KeyStrValueToList(key:String;isStartWithKey:boolean=false):TStringList;
         function  KeyIntValueToList(key:String;isStartWithKey:boolean=false):TStringList;
         procedure Put(const Key: string; Value:Integer);overload;
         procedure Put(const Key: string; Value:String);overload;
         procedure Put(const Key: string; Value:TObject);overload;
         procedure Clear;
         procedure Remove(const Key: string);
         procedure RemoveKey(const Key: string); //不释放对象
         procedure RemoveAll(const Key: string);
         procedure RemoveValue(const Key: string; aValue:String);
         procedure SetSize(size:Cardinal);
         procedure SetMaxTableSize(const size:Cardinal);
         property  count:cardinal  read FItemCount;
         property  size:cardinal  read FArraySize write SetSize;
         property  MaxTableSize:cardinal  read FMaxTableSize write SetMaxTableSize;
      end;

 { Iterator 迭代器通常不用作线程共享，因此没有实现线程安全}
      TIterator = class
      private
         FTable: TRSHashTable;
         ArrayTable: array of PRSHashItem;
         crtItem: PRSHashItem;
         crtIndex: cardinal;
         key: String;
         procedure findNextLink;
      public
         constructor Create(table: TRSHashTable;const key:String);
         function next:boolean;
         function getkey:String;
         function getInteger:Integer;
         function getString:String;
         function getObject:TObject;
      end;

const
   MAX_HASHTABLE_SIZE = 50000;
implementation
   uses RSFunctions;
 { TRSHashTable }

  {如果容许保存重复key项目，则首先从表查询，如果没有查找到，则创建}
    function TRSHashTable.createHashItem(const Key: string): PRSHashItem;
    var
      Hash: Integer;
      HashItem: PRSHashItem;
    begin
      Hash := HashOf(Key) mod FArraySize;
      result := nil;
      if not FMulti then
         result := FindByCode(Hash,key)^;
      if result = nil then
      begin
         New(HashItem);
         fillChar(HashItem^,sizeof(TRSHashItem),0);
         HashItem^.Key := Key;
         HashItem^.Next := ArrayTable[Hash];
         ArrayTable[Hash] := HashItem;
         result := HashItem;
         inc(FItemCount);
         if FAutoGrowth and (FArraySize < FMaxTableSize) and (FItemCount > 2*FArraySize) then  // FAutoGrowth and
            setSize(FItemCount);           //如果中途修改FMaxTableSize，则最大尺寸变成了FItemCount
       end;
   end;

    procedure TRSHashTable.Put(const Key: string; Value: Integer);
    begin
      Lock;
      try
         createHashItem(key).IntValue :=  value;
      finally
         UnLock;
      end; 
    end;

    { 字符串操作是非原子操作，非线程安全的 }
    procedure TRSHashTable.Put(const Key: string; Value: String);
    begin
      Lock();
      try
         createHashItem(key).StrValue :=  value;
      finally
         UnLock;
      end;
      //StrAlloc和StrDispose
    end;

    procedure TRSHashTable.Put(const Key: string; Value: TObject);
    begin
      Lock;
      try
         createHashItem(key).ObjValue :=  value;
      finally
         UnLock;
      end;
    end;

    function TRSHashTable.keyExists(const Key: String): boolean;
    begin
      Lock;
      try
         Result := Find(Key)^ <> nil;
      finally
         UnLock;
      end;
    end;

    function TRSHashTable.GetInteger(const Key: String): Integer;
    var
      P: PRSHashItem;
    begin
      Lock;
      try
         P := Find(Key)^;
         if P <> nil then
            Result := P^.IntValue
         else
            Result := 0;
      finally
         UnLock;
      end;
    end;

    function TRSHashTable.GetString(const Key: String): String;
    var
      P: PRSHashItem;
    begin
      Lock();
      try
         P := Find(Key)^;
         if P <> nil then
            Result := P^.StrValue
         else
            Result := '';
      finally
         UnLock();
      end;
    end;

    function TRSHashTable.GetObject(const Key: string): TObject;
    var
      P: PRSHashItem;
    begin
      Lock();
      try
         P := Find(Key)^;
         if P <> nil then
            Result := P^.ObjValue
         else
            Result := nil;
      finally
         UnLock();
      end;
    end;

    function TRSHashTable.GetItem(const key:String): TRSHashItem;      //直接指针引用，非线程安全，除非直接copy，然后释放锁
    begin
       result := Find(Key)^^;
    end;

    function  TRSHashTable.GetArrayTable:Pointer;
    begin
        result := ArrayTable;
    end;

    procedure TRSHashTable.Clear;
    var
      I: Integer;
      P, N: PRSHashItem;
    begin
      Lock();
      try
          for I := 0 to FArraySize - 1 do
          begin
              P := ArrayTable[I];
              while P <> nil do
              begin
                N := P^.Next;
                if p^.ObjValue <> nil then
                   p^.ObjValue.Free;
                Dispose(P);                //清空节点下的对象
                P := N;
              end;
              ArrayTable[I] := nil;        //节点清除
          end;
          FItemCount := 0;
      finally
         UnLock();
      end;
    end;

    constructor TRSHashTable.Create(Size: Integer; multi:boolean; AutoGrowth:boolean);   //;
    begin
      inherited Create;
      FArraySize := size;
      SetLength(ArrayTable,FArraySize);
      fillChar(ArrayTable[0],sizeof(integer)*Size,0);   //2017.3.24 setLength会自动清0
      FItemCount := 0;
      MaxTableSize := MAX_HASHTABLE_SIZE;
      if MaxTableSize < size then
         MaxTableSize := size;
      self.FAutoGrowth := AutoGrowth;
      self.FMulti := multi;
    end;
    
    destructor TRSHashTable.Destroy;
    begin
      Clear;
      inherited;
    end;

    function TRSHashTable.Find(const Key: string): PPRSHashItem;  //线程不安全，setSize时查询
    var
      Hash: Integer;
    begin
      Hash := HashOf(Key) mod FArraySize;
      Result := FindByCode(Hash,key);
    end;

    function TRSHashTable.FindByCode(hashcode:cardinal; key:String): PPRSHashItem;  //线程不安全
    begin
      Result := @ArrayTable[hashcode];
      while Result^ <> nil do
      begin
         if Result^.Key = Key then
            Exit
         else
            Result := @Result^.Next;
      end;
    end;

    procedure TRSHashTable.Remove(const Key: string);
    var
      P: PRSHashItem;
      Prev: PPRSHashItem;
    begin
      Lock();
      try
         Prev := Find(Key);  //如果没有该key, find返回的是数组表格的地址, 以hashcode为下标。
         P := Prev^;         //槽内指向的对象
         if P <> nil then
         begin
           Prev^ := P^.Next;
           if p^.ObjValue <> nil then
           try
              p^.ObjValue.Free;
           except
           end;
           Dispose(P);  //删除Item
          // p := nil;    //清除上一个的 Next 内容。
           DEC(FItemCount);
         end;
      finally
        UnLock();
      end;
    end;

    procedure TRSHashTable.RemoveKey(const Key: string);
    var
      P: PRSHashItem;
      Prev: PPRSHashItem;
    begin
      Lock();
      try
         Prev := Find(Key);
         P := Prev^;
         if P <> nil then
         begin
           Prev^ := P.Next;
           Dispose(P);
          // p := nil;    //清除上一个的 Next 内容。
           DEC(FItemCount);
         end;
      finally
        UnLock();
      end;
    end;
    procedure TRSHashTable.RemoveAll(const Key: string);
    var
      P: PRSHashItem;
      Prev: PPRSHashItem;
    begin
      Prev := Find(Key);
      P := Prev^;
      while (P <> nil) do
      begin
        if (P^.Key <> Key) then begin
           P := P^.Next;
           continue;
        end;
        Prev^ := P^.Next;
        if p^.ObjValue <> nil then
        try
           p^.ObjValue.Free;
        except
        end;
        Dispose(P);
        p := Prev^;
      end;
      FItemCount := 0;
    end;

    procedure TRSHashTable.RemoveValue(const Key: string; aValue:String);
    var
      P: PRSHashItem;
      Prev: PPRSHashItem;
    begin
      Prev := Find(Key);
      P := Prev^;
      while (P <> nil) do
      begin
        if (P^.Key = Key) and (p^.StrValue = aValue) then
        begin
          Prev^ := P^.Next;
          Dispose(P);
          DEC(FItemCount);
          break;
        end;
        p := p^.Next;   
      end;
    end;

    {创建临时表，将原来的item按照新的表重新hash，}
    procedure TRSHashTable.SetSize(size: cardinal);     //非线程安全，如果要严格线程安全，则读取的时候也要上锁
    var
      tempArrayTable: Array of PRSHashItem;
      I,Hash: Integer;
      P,N,Prev: PRSHashItem;
    begin
      if not FAutoGrowth then exit;
      if size <FArraySize     then exit;
      if size > FMaxTableSize then
         size := FMaxTableSize;
      Lock();
      try
     // ReallocMem(tempArrayTable,sizeof(PRSHashItem));   //setLength
      SetLength(tempArrayTable,size);
      fillChar(tempArrayTable[0],sizeof(integer)*Size,0);   //2017.3.24 setLength会自动清0
      for I := 0 to FArraySize - 1 do
      begin
         P := ArrayTable[I];
         while P <> nil do
         begin
            Hash := HashOf(P^.Key) mod size;   //注意是新的size
            N := tempArrayTable[Hash];           //此处处理顺序问题，如果不按照顺序，那么多个key相同时只能取到第一个值，而不是最新的值。
            Prev := N;
            while N <> nil do                 //如果一个重复Key很多，这里就会搜索到末尾需要很长时间
            begin
               Prev := N;
               N := N^.Next;
            end;
           N := P^.Next;
           P^.Next := nil;
           if Prev = nil then
               tempArrayTable[Hash] := P
           else
               Prev^.Next := P;
           {
           N := P^.Next;
           P^.next := tempArrayTable[Hash];
           tempArrayTable[Hash]:= P;
           }
           P := N;
         end;
         ArrayTable[I] := nil;
      end;

      FArraySize := size;
      setLength(ArrayTable,FArraySize);
      for I := 0 to FArraySize - 1 do
         ArrayTable[i] := tempArrayTable[i];
      finally
        UnLock();
      end;
    end;

    procedure TRSHashTable.SetMaxTableSize(const size: cardinal);   //非线程安全
    begin
       if size > FArraySize then        //不能减小
          FMaxTableSize := size;
    end;

   {以下编译选项：Q表示是否打开运行时检查，有Range检查和溢出检查，这在项目属性中设置，如果项目设置了溢出检查，
     这里则关闭，否则总是跳出错误}
   {$UNDEF SaveQ} {$IFOPT Q+} {$Q-} {$DEFINE SaveQ} {$ENDIF}
    function TRSHashTable.HashOf(const Key: string): Cardinal;
    var
      I,k: Integer;
    begin
       result := 5381;
       k := Length(key);
       for I := 1 to k do
          result := (result shl 5) +result + Ord(Key[I]);
    end;
    {$IFDEF SaveQ} {$Q+} {$UNDEF SaveQ} {$ENDIF}

    function TRSHashTable.ObjValueToList():TList;
    var
      Iterator: TIterator;
      crtItem : PRSHashItem;
      i:Integer;
    begin
       result := TList.Create;
       crtItem := nil;
       for i:=0 to  FArraySize-1 do
       begin
          crtItem := ArrayTable[i];
          if crtItem=nil then
             continue;
          repeat
             result.Add(crtItem.Objvalue);
             crtItem := crtItem.Next;
          until crtItem = nil;
       end;
    end;

    function TRSHashTable.ObjValueToListEx(key:String;isStartWithKey:boolean):TList;
    var
      Iterator: TIterator;
      crtItem : PRSHashItem;
      i:Integer;
    begin
       result := TList.Create;
       crtItem := nil;
       for i:=0 to  FArraySize-1 do
       begin
          crtItem := ArrayTable[i];
          if crtItem=nil then
             continue;
          repeat
             if key='' then
                result.Add(crtItem.Objvalue)
             else if ((not isStartWithKey) and (key = crtItem.Key))
                or ( isStartWithKey and (startWiths(crtItem.Key,key))) then
               result.Add(crtItem.Objvalue);
             crtItem := crtItem.Next;
          until crtItem.Next = nil;
       end;
    end;
    {    var
      Iterator: TIterator;
    begin
       result := TStringList.Create;
       Iterator := TIterator.Create(self,key,isStartWithKey);
       while Iterator.next do
          result.Add(Iterator.getkey());}
          
    function TRSHashTable.KeyToList(key:String;isStartWithKey:boolean):TStringList;
    var
      Iterator: TIterator;
    begin
       result := TStringList.Create;
       Iterator := TIterator.Create(self,key);
       while Iterator.next do
          result.Add(Iterator.getkey());
    end;

    function TRSHashTable.KeyStrValueToList(key:String;isStartWithKey:boolean):TStringList;
    var
      Iterator: TIterator;
    begin
       result := TStringList.Create;
       Iterator := TIterator.Create(self,key);
       while Iterator.next do
       begin
          result.Add(Iterator.getkey()+'='+Iterator.getString());
        end;
    end;
    
    function TRSHashTable.KeyIntValueToList(key:String;isStartWithKey:boolean):TStringList;
    var
      Iterator: TIterator;
    begin
       result := TStringList.Create;
       Iterator := TIterator.Create(self,key);
       while Iterator.next do
          result.Add(Iterator.getkey()+'='+IntToStr(Iterator.getInteger()));
    end;
        
     {Iterator}

    constructor TIterator.Create(table: TRSHashTable;const key:String);
    begin
       self.FTable := table;
       self.key := key;
       crtIndex := 0;
       ArrayTable := table.GetArrayTable;
    end;

    procedure TIterator.findNextLink;
    begin
       if key <>'' then
          crtItem := FTable.Find(key)^
       else
       begin
          while crtItem = nil do
          begin
             if (crtIndex > Ftable.size-1) then
                break;
             crtItem := ArrayTable[crtIndex];
             inc(crtIndex);
          end;
       end;
    end;

    //遍历所有Item
    function TIterator.next:boolean;
    begin
       result := false;
       if crtItem = nil then //当前不能为空
          findNextLink
       else
          crtItem := crtItem^.Next;

       if key = '' then
       begin
          if crtItem = nil then   //如果没有找到，如果是链表尾部还要找一次数组
              findNextLink;
          if crtItem  <> nil then
             result := true;
       end
       else
       begin
          while (crtItem <> nil) and (crtItem^.Key <> key) do
             crtItem := crtItem^.Next;
          if crtItem  <> nil then
             result := true;
       end;
    end;

    function TIterator.getInteger:Integer;
    begin
       if crtItem <> nil then
          result := crtItem^.IntValue
       else
          result := 0;
    end;

    function TIterator.getString:String;
    begin
       if crtItem <> nil then
          result := crtItem^.StrValue
       else
          result := '';
    end;

    function TIterator.getObject:TObject;
    begin
       if crtItem <> nil then
          result := crtItem^.Objvalue
       else
          result := nil;
    end;

    function TIterator.getKey:String;
    begin
       if crtItem <> nil then
          result := crtItem^.key
       else
          result := '';
    end;

end.