小
小雨哥
Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈，这是标题党的一贯做法，单元是我刚刚写的，连验证工作都没做，似乎可能还冒着热气~~~~，留给需要的人：unit DelphiHash;interfaceuses Windows, Classes;type PKeyValuePair = ^TKeyValuePair;
TKeyValuePair = record Next: PKeyValuePair;
Key: AnsiString;
Value:integer;
end;
PPKeyValuePair = ^PKeyValuePair;
TAnsiStringHashList = class(TPersistent) private FCount:integer;
BucketSize:integer;
FLock: TRTLCriticalSection;
FUseLock:Boolean;
Buckets: array of PKeyValuePair;
protected procedure Lock;
procedure Unlock;
function Find(const Key: AnsiString): PPKeyValuePair;
function HashIt(const Key: AnsiString): Cardinal;
dynamic;
public constructor Create(LockAccess:Boolean = True;
Size: Cardinal = 256);
destructor Destroy;
override;
procedure Add(const Key: AnsiString;
const Value:integer);
procedure Assign(Source: TPersistent);override;
procedure AssignTo(Dest: TPersistent);override;
function KeyExtist(const Key: AnsiString): Boolean;
function Modify(const Key: AnsiString;const Value: Integer): Boolean;
function ValueOf(const Key: AnsiString): Integer;
procedure Remove(const Key: AnsiString);
function Count: Integer;
procedure Clear;
end;
implementation// #########################################// # #// # <Delphi Hash> ++ Write by 小雨哥 #// # #// #########################################{ TAnsiStringHashList }constructor TAnsiStringHashList.Create(LockAccess:Boolean;
Size: Cardinal);
begin
inherited Create;
InitializeCriticalSection(FLock);
FUseLock := LockAccess;
BucketSize := Size;
SetLength(Buckets, BucketSize);
end;
destructor TAnsiStringHashList.Destroy;
begin
Clear;
SetLength(Buckets, 0);
DeleteCriticalSection(FLock);
inherited Destroy;
end;
function TAnsiStringHashList.HashIt(const Key: AnsiString): Cardinal;var i:integer;
begin
// ######################################################// # #// # 发布在 comp.lang.c 新闻组的著名的 DJB Hash #// # 由 Daniel J. Bernstein 教授发明 #// # 据传是史上最具散列(hash)效果的函数之一 #// # #// ###################################################### Result := 5381;
for i := 1 to Length(Key)do
Result := ((Result shl 5) + Result) + Ord(Key);
end;
function TAnsiStringHashList.Find(const Key: AnsiString): PPKeyValuePair;var Hash: Integer;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
Lock;
try Result := @Buckets[Hash];
while Result^ <> nildo
begin
if Result^.Key = Key then
Exit else
Result := @Result^.Next;
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Add(const Key: AnsiString;
const Value: integer);var Hash: Integer;
Bucket: PKeyValuePair;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
New(Bucket);
Lock;
try Bucket^.Key := Key;
Bucket^.Value := Value;
Bucket^.Next := Buckets[Hash];
Buckets[Hash] := Bucket;
Inc(FCount);
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Assign(Source: TPersistent);var I:integer;
Rs
PKeyValuePair;
begin
if Assigned(Source) then
begin
Self.Clear;
if Source is TStrings then
begin
Self.Lock;
try for I := 0 to TStrings(Source).Count - 1do
Self.Add(TStrings(Source), Integer(TStrings(Source).Objects));
finally Self.Unlock;
end;
end else
if Source is TAnsiStringHashList then
begin
Self.FUseLock := TAnsiStringHashList(Source).FUseLock;
TAnsiStringHashList(Source).Lock;
Self.Lock;
try Self.BucketSize := TAnsiStringHashList(Source).BucketSize;
SetLength(Self.Buckets, Self.BucketSize);
for I := 0 to TAnsiStringHashList(Source).BucketSize - 1do
begin
Rs := @TAnsiStringHashList(Source).Buckets;
while Rs^ <> nildo
begin
Self.Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Source).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.AssignTo(Dest: TPersistent);var I:integer;
RsPKeyValuePair;
begin
if Assigned(Dest) then
begin
if Dest is TStrings then
begin
Self.Lock;
try TStrings(Dest).Clear;
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TStrings(Dest).AddObject(Rs^.Key, TObject(Rs^.Value));
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
end;
end else
if Dest is TAnsiStringHashList then
begin
TAnsiStringHashList(Dest).Clear;
TAnsiStringHashList(Dest).FUseLock := Self.FUseLock;
TAnsiStringHashList(Dest).Lock;
Self.Lock;
try TAnsiStringHashList(Dest).BucketSize := Self.BucketSize;
SetLength(TAnsiStringHashList(Dest).Buckets, Self.BucketSize);
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TAnsiStringHashList(Dest).Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Dest).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.Clear;var I: Integer;
P, N: PKeyValuePair;
begin
Lock;
try for I := 0 to High(Buckets)do
begin
P := Buckets;
while P <> nildo
begin
N := P^.Next;
Dispose(P);
P := N;
end;
Buckets := nil;
end;
FCount := 0;
finally Unlock;
end;
end;
function TAnsiStringHashList.Count: Integer;
begin
Lock;
try Result := FCount;
finally Unlock;
end;
end;
function TAnsiStringHashList.KeyExtist(const Key: AnsiString): Boolean;
begin
Result := (Find(Key)^ <> nil);
end;
procedure TAnsiStringHashList.Lock;
begin
if FUseLock then
EnterCriticalSection(FLock);
end;
function TAnsiStringHashList.Modify(const Key: AnsiString;
const Value: Integer): Boolean;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try Result := P <> nil;
if Result then
P^.Value := Value;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Remove(const Key: AnsiString);var P: PKeyValuePair;
Prev: PPKeyValuePair;
begin
Prev := Find(Key);
Lock;
try P := Prev^;
if P <> nil then
begin
Prev^ := P^.Next;
Dispose(P);
Dec(FCount);
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Unlock;
begin
if FUseLock then
LeaveCriticalSection(FLock);
end;
function TAnsiStringHashList.ValueOf(const Key: AnsiString): Integer;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try if P <> nil then
Result := P^.Value else
Result := -1;
finally Unlock;
end;
end;
end.
大家知道，Delphi有自带的 THashedStringList [在 inifiles.pas 里]，也可以完成快速搜索的任务，这里提供另外的例子，只是仅供参考。我确实没有测试，但估计也不会有太大问题，理论上可以上100万以上的数据（适当调整BucketSize值，以减小深度），检索时间最坏情况下，应该也不会大于20ms。某些情况下，利用里面的 Assign、AssignTo 方法，甚至可以将这个类与 TStrings 联合起来使用。假如哪位细心的朋友验证测试发现问题，请留言指正。谢谢。
TKeyValuePair = record Next: PKeyValuePair;
Key: AnsiString;
Value:integer;
end;
PPKeyValuePair = ^PKeyValuePair;
TAnsiStringHashList = class(TPersistent) private FCount:integer;
BucketSize:integer;
FLock: TRTLCriticalSection;
FUseLock:Boolean;
Buckets: array of PKeyValuePair;
protected procedure Lock;
procedure Unlock;
function Find(const Key: AnsiString): PPKeyValuePair;
function HashIt(const Key: AnsiString): Cardinal;
dynamic;
public constructor Create(LockAccess:Boolean = True;
Size: Cardinal = 256);
destructor Destroy;
override;
procedure Add(const Key: AnsiString;
const Value:integer);
procedure Assign(Source: TPersistent);override;
procedure AssignTo(Dest: TPersistent);override;
function KeyExtist(const Key: AnsiString): Boolean;
function Modify(const Key: AnsiString;const Value: Integer): Boolean;
function ValueOf(const Key: AnsiString): Integer;
procedure Remove(const Key: AnsiString);
function Count: Integer;
procedure Clear;
end;
implementation// #########################################// # #// # <Delphi Hash> ++ Write by 小雨哥 #// # #// #########################################{ TAnsiStringHashList }constructor TAnsiStringHashList.Create(LockAccess:Boolean;
Size: Cardinal);
begin
inherited Create;
InitializeCriticalSection(FLock);
FUseLock := LockAccess;
BucketSize := Size;
SetLength(Buckets, BucketSize);
end;
destructor TAnsiStringHashList.Destroy;
begin
Clear;
SetLength(Buckets, 0);
DeleteCriticalSection(FLock);
inherited Destroy;
end;
function TAnsiStringHashList.HashIt(const Key: AnsiString): Cardinal;var i:integer;
begin
// ######################################################// # #// # 发布在 comp.lang.c 新闻组的著名的 DJB Hash #// # 由 Daniel J. Bernstein 教授发明 #// # 据传是史上最具散列(hash)效果的函数之一 #// # #// ###################################################### Result := 5381;
for i := 1 to Length(Key)do
Result := ((Result shl 5) + Result) + Ord(Key);
end;
function TAnsiStringHashList.Find(const Key: AnsiString): PPKeyValuePair;var Hash: Integer;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
Lock;
try Result := @Buckets[Hash];
while Result^ <> nildo
begin
if Result^.Key = Key then
Exit else
Result := @Result^.Next;
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Add(const Key: AnsiString;
const Value: integer);var Hash: Integer;
Bucket: PKeyValuePair;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
New(Bucket);
Lock;
try Bucket^.Key := Key;
Bucket^.Value := Value;
Bucket^.Next := Buckets[Hash];
Buckets[Hash] := Bucket;
Inc(FCount);
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Assign(Source: TPersistent);var I:integer;
Rs
PKeyValuePair;begin
if Assigned(Source) then
begin
Self.Clear;
if Source is TStrings then
begin
Self.Lock;
try for I := 0 to TStrings(Source).Count - 1do
Self.Add(TStrings(Source), Integer(TStrings(Source).Objects));
finally Self.Unlock;
end;
end else
if Source is TAnsiStringHashList then
begin
Self.FUseLock := TAnsiStringHashList(Source).FUseLock;
TAnsiStringHashList(Source).Lock;
Self.Lock;
try Self.BucketSize := TAnsiStringHashList(Source).BucketSize;
SetLength(Self.Buckets, Self.BucketSize);
for I := 0 to TAnsiStringHashList(Source).BucketSize - 1do
begin
Rs := @TAnsiStringHashList(Source).Buckets;
while Rs^ <> nildo
begin
Self.Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Source).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.AssignTo(Dest: TPersistent);var I:integer;
Rs
PKeyValuePair;begin
if Assigned(Dest) then
begin
if Dest is TStrings then
begin
Self.Lock;
try TStrings(Dest).Clear;
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TStrings(Dest).AddObject(Rs^.Key, TObject(Rs^.Value));
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
end;
end else
if Dest is TAnsiStringHashList then
begin
TAnsiStringHashList(Dest).Clear;
TAnsiStringHashList(Dest).FUseLock := Self.FUseLock;
TAnsiStringHashList(Dest).Lock;
Self.Lock;
try TAnsiStringHashList(Dest).BucketSize := Self.BucketSize;
SetLength(TAnsiStringHashList(Dest).Buckets, Self.BucketSize);
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TAnsiStringHashList(Dest).Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Dest).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.Clear;var I: Integer;
P, N: PKeyValuePair;
begin
Lock;
try for I := 0 to High(Buckets)do
begin
P := Buckets;
while P <> nildo
begin
N := P^.Next;
Dispose(P);
P := N;
end;
Buckets := nil;
end;
FCount := 0;
finally Unlock;
end;
end;
function TAnsiStringHashList.Count: Integer;
begin
Lock;
try Result := FCount;
finally Unlock;
end;
end;
function TAnsiStringHashList.KeyExtist(const Key: AnsiString): Boolean;
begin
Result := (Find(Key)^ <> nil);
end;
procedure TAnsiStringHashList.Lock;
begin
if FUseLock then
EnterCriticalSection(FLock);
end;
function TAnsiStringHashList.Modify(const Key: AnsiString;
const Value: Integer): Boolean;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try Result := P <> nil;
if Result then
P^.Value := Value;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Remove(const Key: AnsiString);var P: PKeyValuePair;
Prev: PPKeyValuePair;
begin
Prev := Find(Key);
Lock;
try P := Prev^;
if P <> nil then
begin
Prev^ := P^.Next;
Dispose(P);
Dec(FCount);
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Unlock;
begin
if FUseLock then
LeaveCriticalSection(FLock);
end;
function TAnsiStringHashList.ValueOf(const Key: AnsiString): Integer;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try if P <> nil then
Result := P^.Value else
Result := -1;
finally Unlock;
end;
end;
end.
大家知道，Delphi有自带的 THashedStringList [在 inifiles.pas 里]，也可以完成快速搜索的任务，这里提供另外的例子，只是仅供参考。我确实没有测试，但估计也不会有太大问题，理论上可以上100万以上的数据（适当调整BucketSize值，以减小深度），检索时间最坏情况下，应该也不会大于20ms。某些情况下，利用里面的 Assign、AssignTo 方法，甚至可以将这个类与 TStrings 联合起来使用。假如哪位细心的朋友验证测试发现问题，请留言指正。谢谢。