TStringBucketList Fehler bei Bereichsüberprüfung

[inriz]

hallo,

es ist wohl schwerer eine eigene hashlist zu schreiben als ich dachte.
ich hab mir eine klasse geschrieben namens TStringBucketList die von
TCustomBucketList erbt. die methode BucketFor in der basisklasse als abstract deklariert ist,
bin ich dazu gezwungen sie selbst zu definieren.

ich hab mich umgeschaut und verschiedene ansätze gefunden dieses problem aber jedoch nur mit
berechnungen für hashes zu lösen. ich habe bereits 2 hash methoden probiert, dennoch scheiterts entweder
an der hashmethode selbst "Fehler bei Bereichsüberprüfung" oder der erstellte hash beisst sich mit
Buckets auch wieder der selbe fehler. im zweiten fall, dachte ich mir, wird der hash ohne fehler erstellt also
schalte ich die bereichsüberprüfung im compiler ab. gedacht getan, und schon flattert eine access violation auf den schirm.
folglich bereichsüberprüfung wieder angeschaltet.

schlussendlich hab ich nachgeschaut was es mit buckets auf sich hat bzw. wie funktionierts.
da konnte ich erkennen, der hash nur die erste schicht in dem ganzen konstrukt ist um die ein zu speicherndes item zu kategorisieren.
es folgt unterhalb der kategorisierung eine weitere liste.

verstehe ich was falsch, oder bedienen sich programmier dieser buckets und benutzen die weiteren listen überhaupt nicht um items nach string zu hashen?

hint: kurioserweise ist der zweite hash direkt von thashedstringlist kopiert worden mit einer änderung das nach der wirkliche hasherstellung benutzt wird und nicht (hash mod length(buckets)) das wurde von mir entfernt.


und es folgt sogleich der stinkende code.

was mach ich falsch? gibt sowas schon in der art?

vorhaben ich möchte in der in diesem bucket die reference oder speicheradresse meiner klasseninstanzen speichern die über ihren namen angesprochen werden können !

der nachfolgende code benutzt die von mir geänderte hashmethode aus thashedstringlist

vielen dank

Delphi-Quellcode:

function TStringBucketList.FindItem(AItem: Pointer; out ABucket,
  AIndex: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  ABucket := BucketFor(AItem);
  with Buckets[ABucket] do  /// <<<------------------------ hier tritt der fehler auf
    for I := 0 to Count - 1 do
      if string(Items[I].Item) = string(AItem) then
      begin
        AIndex := I;
        Result := True;
        Break;
      end;
end;

Delphi-Quellcode:

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.