在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.
3782
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
