Von TStringList abgeleitete Klasse inkl. Objecten speichern

[idefix2]

Das Problem sind vor allem geschachtelte withs (und die Implementierung einer Methode entspricht schon einem impliziten with). Da sind mir schon Fehler passiert, bei denen ich endlos vor dem Code gesessen bin und gesucht habe, weil ein Bezeichner mit dem falschen with erweitert worden ist, das ist die Einsparung von etwas Codetext nicht wert. Wenn man einem Record oder einer Klasse ein neues Feld (oder Property oder Methode) mit dem gleichen Namen wie in einer anderer Klasse hinzufügt, kann sich das auf irgendwelche geschachtelte withs irgendwo im Code auswirken, an die man überhaupt nicht denkt. Viel Spass.

[xZise]

Moin,

Zitat von idefix2:

[...](und die Implementierung einer Methode entspricht schon einem impliziten with)[...]

Das wichtigste hast du vergessen: nicht abschaltbarens! Das heißt da weißt du immer, dass da ein with-Block ist. Bei den normalen hingegen nicht, aber das muss selber sehen. Ich zum Beispiel bin auch drüber gestolpert.

MfG
Fabian

[himitsu]

Ich hab's jetzt noch nicht getestet, aber theoretisch dürfte es funktionieren.

- die Objekte müssen von TComponent abgeleitet sein (ich dachte eigentlich, daß es auch Stream-Lese/Schreib-Methoden gibt, welche direkt TComponent nutzen )
- die Stringliste muß Besitzer (Owner) der Objekte sein
- und die verwendeten Objekt-Klassen müssen von Stream.ReadComponent gefunden werden können

- ein Vorteil ist, daß es zu einer normalen Stringliste kompatibel sein dürfte, da diese die nachfolgenden Objekte nicht als Text erkannt und damit ignoriert werden.
Nur beim Auslesen von UTF-8 könnte es Problemchen geben, da das normale TStrings und Co. seit Delphi 2009, die Datei komplett ausließt, versucht umzukodieren (also inklusive der Objektdaten) und erst dann den Text daraus ausließt ... beim Umkodieren könnten die Objekte allerdings als ungültiges UTF-8 erkannt werden.

Delphi-Quellcode:

type
  // must be owns the objects
  // objects to be derived from TComponent wearer
  TSavedStringList = class(TStringList)
  protected
    procedure PutObject (Index: Integer; AObject: TObject); override;
    procedure InsertItem(Index: Integer; const S: String; AObject: TObject); override;
    procedure AddStrings(Strings: TStrings); override;
    procedure SetOwnsObject(Value: Boolean);
  public
    constructor Create;                       overload;
    constructor Create(OwnsObjects: Boolean); overload;
    function  AddObject    (                const S: String; AObject: TObject): Integer; override;
    procedure InsertObject (Index: Integer; const S: String; AObject: TObject);          override;
    property  OwnsObjects: Boolean write SetOwnsObject;
    procedure LoadFromStream(Stream: TStream; Encoding: TEncoding); override;
    procedure SaveToStream  (Stream: TStream; Encoding: TEncoding); override;
  end;

procedure TSavedStringList.PutObject(Index: Integer; AObject: TObject);
  begin
    if Assigned(AObject) and not (AObject is TComponent) then
      raise Exception.Create('the objects must be persitent');
    inherited;
  end;

procedure TSavedStringList.InsertItem(Index: Integer; const S: String; AObject: TObject);
  begin
    if Assigned(AObject) and not (AObject is TComponent) then
      raise Exception.Create('the objects must be persitent');
    inherited;
  end;

procedure TSavedStringList.AddStrings(Strings: TStrings);
  var
    S: String;
  begin
    BeginUpdate;
    try
      for S in Strings do AddObject(S, nil);
    finally
      EndUpdate;
    end;
  end;

procedure TSavedStringList.SetOwnsObject(Value: Boolean);
  begin
    if not Value then
      raise Exception.Create('must be owns the objects');
    inherited OwnsObjects := Value;
  end;

constructor TSavedStringList.Create;
  begin
    inherited;
  end;

constructor TSavedStringList.Create(OwnsObjects: Boolean);
  begin
    if not OwnsObjects then
      raise Exception.Create('must be owns the objects');
    inherited Create;
  end;

function TSavedStringList.AddObject(const S: String; AObject: TObject): Integer;
  begin
    if Assigned(AObject) and not (AObject is TComponent) then
      raise Exception.Create('the objects must be persitent');
    inherited;
  end;

procedure TSavedStringList.InsertObject(Index: Integer; const S: String; AObject: TObject);
  begin
    if Assigned(AObject) and not (AObject is TComponent) then
      raise Exception.Create('the objects must be persitent');
    inherited;
  end;

procedure TSavedStringList.LoadFromStream(Stream: TStream; Encoding: TEncoding);
  var
    Size, i, i2, i3, i4: LongInt;
    Buffer, EndMarker: TBytes;
    Data: TStream;
  begin
    BeginUpdate;
    try
      Size := Stream.Size - Stream.Position;
      SetLength(Buffer, Size);
      Stream.ReadBuffer(Buffer[0], Size);

      Size := TEncoding.GetBufferEncoding(Buffer, Encoding);
      EndMarker := Encoding.GetBytes(#0);
      i := Size;
      i2 := Length(Buffer);
      if Length(EndMarker) = 1 then begin
        while i < i2 do
          if Buffer[i] <> EndMarker[0] then Inc(i) else Break;
      end else if Length(EndMarker) = 2 then begin
        Dec(i2);
        while i < i2 do
          if PWord(@Buffer[i])^ <> PWord(@EndMarker[0])^ then Inc(i, 2) else Break;
      end else begin
        i3 := Length(EndMarker);
        Dec(i2, i3 - 1);
        while i < i2 do
          if not CompareMem(@Buffer[i], @EndMarker[0], i3) then Inc(i, i3) else Break;
      end;
      SetTextStr(Encoding.GetString(Buffer, Size, i - Size));
      Data := TMemoryStream.Create;
      try
        i2 := 0;
        i3 := Count;
        Size := Length(Buffer) - 3;
        while (i < Size) and (i2 < i3) do begin
          i4 := PLongWord(@Buffer[i])^;
          inc(i, 4);
          Data.Size := 0;
          Data.WriteBuffer(Buffer[i], i4);
          inc(i, i4);
          PutObject(i2, Data.ReadComponent(nil));
          Inc(i2);
        end;
      finally
        Data.Free;
      end;
    finally
      EndUpdate;
    end;
  end;

procedure TSavedStringList.SaveToStream(Stream: TStream; Encoding: TEncoding);
  var
    EndMarker: TBytes;
    Data: TStream;
    i, i2: LongInt;
  begin
    inherited;
    if not Assigned(Encoding) then Encoding := TEncoding.Default;
    EndMarker := Encoding.GetBytes(#0);
    Data := TMemoryStream.Create;
    try
      Stream.WriteBuffer(EndMarker[0], Length(EndMarker));
      for i := 0 to Count - 1 do begin
        Data.Size := 0;
        if not (Objects[i] is TComponent) then
          raise Exception.Create('the objects must be persitent');
        Data.WriteComponent(TComponent(Objects[i]));
        i2 := Data.Size;
        Stream.WriteBuffer(i2, 4);
        Stream.CopyFrom(Data, i2);
      end;
    finally
      Data.Free;
    end;
  end;

Hätte gerne noch die Objekte direkt als TComponent deklariert (nicht als TObject gelassen), aber dieses läßt sich nachträglich leider nicht mehr ändern ordentlich, vorallem wenn man direkt von TStringList ableiten möchte.
Bei Verwendung der Generics, wäre dieses gegangen, aber dann wäre es kein TStrings-Nachfolger mehr.

[Namenloser]

Kleine Frage zu deinem Code, himitsu: Wenn du sowieso nur Nachkommen von TPersistent erlaubst, wieso steht dann überall TObject? Spar dir doch die Manuelle Typ-Prüfung und deklarier den Parameter doch gleich als TPersistent.

[edit]Ah, ich sehe, die Methoden sind als override deklariert. Alles klar.[/edit]