Von TStringList abgeleitete Klasse inkl. Objecten speichern

[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.