unit StringBucketList;
interface
uses
SysUtils, Classes, Contnrs;
type
TStringBucketList =
class(TCustomBucketList)
private
FOwnsObjects: Boolean;
function GetData(AItem:
string): TObject;
procedure SetData(AItem:
string;
const AData: TObject);
// hash generation
function HashOf(
const Key:
string): Cardinal;
function HashString(
const Value:
string): Longint;
protected
function BucketFor(AItem: Pointer): Integer;
override;
function FindItem(AItem: Pointer;
out ABucket, AIndex: Integer): Boolean;
override;
function AddItem(ABucket: Integer; AItem, AData: Pointer): Pointer;
override;
function DeleteItem(ABucket: Integer; AIndex: Integer): Pointer;
override;
public
constructor Create;
overload;
constructor Create(AOwnsObjects: Boolean);
overload;
function Add(AItem:
string; AData: TObject): TObject;
function Extract(AItem:
string): TObject;
function Remove(AItem:
string): Boolean;
function Exists(AItem:
string): Boolean;
// properties
property Data[AItem:
string]: TObject
read GetData
write SetData;
default;
end;
//procedure Register;
implementation
const
function TStringBucketList.HashOf(
const Key:
string): Cardinal;
var
I: Integer;
begin
Result := 0;
for I := 1
to Length(Key)
do
Result := ((Result
shl 2)
or (Result
shr (SizeOf(Result) * 8 - 2)))
xor
Ord(Key[I]);
end;
function TStringBucketList.HashString(
const Value:
string): Longint;
begin
Result := HashOf(Value);
end;
{
procedure Register;
begin
RegisterComponents('ZTools', [TStringBucketList]);
end;}
function TStringBucketList.Add(AItem:
string; AData: TObject): TObject;
begin
Result := TObject(
inherited Add(Pointer(AItem), AData));
end;
function TStringBucketList.AddItem(ABucket: Integer; AItem,
AData: Pointer): Pointer;
function ReferenceString(Item: Pointer): Pointer;
begin
Initialize(
string(Result));
string(Result) :=
string(Item);
end;
begin
Result :=
inherited AddItem(ABucket, ReferenceString(AItem), AData);
end;
constructor TStringBucketList.Create;
begin
Create(False);
end;
constructor TStringBucketList.Create(AOwnsObjects: Boolean);
begin
inherited Create;
FOwnsObjects := AOwnsObjects;
end;
function TStringBucketList.DeleteItem(ABucket, AIndex: Integer): Pointer;
procedure DereferenceString(Item: Pointer);
begin
Finalize(
string(Item));
end;
begin
DereferenceString(Buckets[ABucket].Items[AIndex].Item);
Result :=
inherited DeleteItem(ABucket, AIndex);
if FOwnsObjects
then
FreeAndNil(TObject(Result));
end;
function TStringBucketList.Exists(AItem:
string): Boolean;
begin
Result :=
inherited Exists(Pointer(AItem));
end;
function TStringBucketList.Extract(AItem:
string): TObject;
begin
Result :=
nil;
if not FOwnsObjects
then
Result := TObject(
inherited Remove(Pointer(AItem)))
else if Exists(AItem)
then
begin
Result := Data[AItem];
Data[AItem] :=
nil;
inherited Remove(Pointer(AItem));
end;
end;
function TStringBucketList.FindItem(AItem: Pointer;
out ABucket,
AIndex: Integer): Boolean;
var
I: Integer;
begin
Result := False;
ABucket := BucketFor(AItem);
with Buckets[ABucket]
do
for I := 0
to Count - 1
do
if string(Items[I].Item) =
string(AItem)
then
begin
AIndex := I;
Result := True;
Break;
end;
end;
function TStringBucketList.GetData(AItem:
string): TObject;
begin
Result := TObject(
inherited Data[Pointer(AItem)]);
end;
function TStringBucketList.Remove(AItem:
string): Boolean;
begin
Result := Exists(AItem);
inherited Remove(Pointer(AItem));
end;
procedure TStringBucketList.SetData(AItem:
string;
const AData: TObject);
begin
inherited Data[Pointer(AItem)] := AData;
end;
function TStringBucketList.BucketFor(AItem: Pointer): Integer;
begin
Result := HashString(
string(AItem));
end;
end.