AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Von TStringList abgeleitete Klasse inkl. Objecten speichern

Von TStringList abgeleitete Klasse inkl. Objecten speichern

Ein Thema von Schwedenbitter · begonnen am 8. Jul 2010 · letzter Beitrag vom 9. Jul 2010
Antwort Antwort
Seite 2 von 2     12
idefix2

Registriert seit: 17. Mär 2010
Ort: Wien
1.027 Beiträge
 
RAD-Studio 2009 Pro
 
#11

AW: Von TStringList abgeleitete Klasse inkl. Objecten speichern

  Alt 9. Jul 2010, 11:25
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.
  Mit Zitat antworten Zitat
Benutzerbild von xZise
xZise

Registriert seit: 3. Mär 2006
Ort: Waldbronn
4.303 Beiträge
 
Delphi 2009 Professional
 
#12

AW: Von TStringList abgeleitete Klasse inkl. Objecten speichern

  Alt 9. Jul 2010, 11:44
Moin,
[...](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
Fabian
Eigentlich hat MS Windows ab Vista den Hang zur Selbstzerstörung abgewöhnt – mkinzler
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.017 Beiträge
 
Delphi 12 Athens
 
#13

AW: Von TStringList abgeleitete Klasse inkl. Objecten speichern

  Alt 9. Jul 2010, 12:30
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu ( 9. Jul 2010 um 16:06 Uhr)
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#14

AW: Von TStringList abgeleitete Klasse inkl. Objecten speichern

  Alt 9. Jul 2010, 15:46
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]
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:33 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz