[RESUELTO] Guardar estructura de memoria (clases) a disco

[Neftali [Germán.Estévez]]

Buenas a todos.

Pues ya están las pruebas realizadas y la verdad con bastante buen resultado (al menos para lo que yo pretendía).
La explicación más extensa (con todo el código incluido y el ejemplo) la he añadido a una entrada en mi blob(Persistencia de una estructura de clases), donde está explicada con todos los detalles. De todas formas, ya que aquí salió la pregunta es lógico que explique los resultados.

La conclusión en pocas palabras es: ¡¡¡QUE SI SE PUEDE!!!

Como ya comenté se trataba de intentar guardar y restaurar el contenido de una estructura de clases en memoria sin tener que programar nada sobre las propias clases, para realizar este Backup/restore. La solución que intentaba probar, era la de utilizar los métodos que Delphi usa para guardar el contenido de un formulario en disco (en formato del DFM).

La clave está en la utilización de las clases TCollection y TCollectionItem para las clases basadas en listas (que era lo que más dificultad se me antojaba que tendría).
Tal y como comento en la entrada del blog, he tenido que modificar algo la definición de las clases (manteniendo la misma estructura) para conseguir que el proceso funcionara.

• Alguna de las clases han pasado a derivar de TCollectionItem y otras de TCollection, básicamente para cambiar las lista con la que anteriormente trabajaba por colecciones. Ha afectado muy poco a la implementación, ya que sólo he tenido que cambiar algun método de acceso.
• Las propiedades definidas en las clases que queremos almacenar hay que pasarlas de la sección public a la sección published.
• La clase principal deriva ahora de TComponent para poder añadirle “persistencia”.
• Como ya he comentado, algunos pequeños cambios en la implementación, necesarios para adecuar código a los cambios de definición, pero que no han sido nada importantes.
• Por último añadir el registro de las clase utilizando el procedimiento RegisterClass.

Os adjunto cómo ha quedado la definición definitiva de las clases.

Código Delphi [-]
  TTrackData = class;
  TPointInfo = class;
  TTrack = class;

  {Clase para encapsular la información de un punto.}
  TPointInfo = class(TCollectionItem)
  private
    FEle: string;
    FLon: string;
    FLat: string;
    FTime: string;
    FLatF: Double;
    FLonF: Double;
  public
    // constructor de la clase
    constructor Create(ACol:TCollection; ALat, ALon, AEle, ATime: string;
                       ALatF, ALonF : Double); overload; virtual;

    function _debug(TS:TStrings):string; virtual;
  published
    property Lat:string read FLat write FLat;
    property Lon:string read FLon write FLon;
    property Ele:string read FEle write FEle;
    property Time:string read FTime write FTime;

    property LatF : Double read FLatF write FLatF;
    property LonF : Double read FLonF write FLonF;
  end;

  {: Clase para encapsular la información de un WayPoint.}
  TWayPoint = class(TPointInfo)
  private
    FNombre: string;
    FDesc: string;
    FSimbolo: string;
  public
    // constructor de la clase
    constructor Create(ATrack:TTrackData;
                       AWPNombre, AWPDesc:string;
                       ASimbolo:string;
                       ALat, ALon, AEle, ATime: string;
                       ALatF, ALonF: Double); overload;

    function _debug(TS:TStrings):string; override;
  published
    property Nombre:string read FNombre write FNombre;
    property Desc:string read FDesc write FDesc;
    property Simbolo:string read FSimbolo write FSimbolo;
  end;


  {: Clase para almacenar una lista de puntos.}
  TPointList = Class(TCollection)
  private
    function GetPoint(index: integer): TPointInfo;
  public
    procedure AddPoint(pointInfo:TPointInfo); overload;
    procedure AddPoint(ALat, ALon, AEle, ATime: string;
                       ALatF, ALonFouble); overload;
    property Point[index:integer]:TPointInfo read GetPoint;
  published
    procedure _debug(TS:TStrings);
    procedure _debugCount(TS:TStrings);

  end;

  TTrack = class(TCollectionItem)
  private
    FTrackPoints: TPointList;
    FPaintColor: Integer;
    FPaintWidth: Integer;
    FTrackName: string;
  public
    // constructor de la clase
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure _debug(TS:TStrings);
  published
    property TrackPoints:TPointList read FTrackPoints write FTrackPoints;
    property TrackName:string read FTrackName write FTrackName;
    property PaintWidth:Integer read FPaintWidth write FPaintWidth;
    property PaintColor:Integer read FPaintColor write FPaintColor;
  end;
  {: Clase para encapsular datos de un segmento que forma un track.}
  TTrackList = class (TCollection)
  private
  public
    constructor Create(ItemClass: TCollectionItemClass);
  end;

  {: Clase para encapsular los Waypoints de un Track.}
  TWayPointList = class (TCollection)
  private
  public
    procedure _debug(TS:TStrings);
  end;

  {: Clase para encapsular toda la información de un track.}
  TTrackData = class(TComponent)
  private
    FVersion: string;
    FXsi: string;
    FMaxLon: string;
    FMaxLat: string;
    FCreator: string;
    FHRef: string;
    FTime: string;
    FMinLon: string;
    FMinLat: string;
    FText: string;
    FTrackList: TTrackList;
    FWayPointList: TWaypointList;
  public
    // Limpiar el contenido de la clase
    procedure Clear;
    // constructor de la clase
    constructor Create(AOwner: TComponent); override;
    destructor Destroy();
  published
    // Datos
    property Creator:string read FCreator write FCreator;
    property Version:string read FVersion write FVersion;
    property Xsi:string read FXsi write FXsi;
    property HRef:string read FHRef write FHRef;
    property Text:string read FText write FText;
    property Time:string read FTime write FTime;
    property MinLat:string read FMinLat write FMinLat;
    property MinLon:string read FMinLon write FMinLon;
    property MaxLat:string read FMaxLat write FMaxLat;
    property MaxLon:string read FMaxLon write FMaxLon;

    // Lista de tracks
    property TrackList:TTrackList read FTrackList write FTrackList;
    // Lista de WayPoints
    property WayPointList:TWaypointList read FWayPointList write FWayPointList;
  end;

Utilizando un par de procedimientos extraídos de la propia ayuda de embarcadero, que los muestra como código de ejemplo de la clase TMemoryStream, me ha bastado para realizar las dos accciones (Guardar y Restaurar).

Código Delphi [-]
function ComponentToStringProc(Component: TComponent): string;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;

function StringToComponentProc(Value: string): TComponent;
var
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result:= BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;

Con los cambios en las clases y un par de líneas como estas:

Código Delphi [-]
  // convertir la clase (TTrackData) a texto
  Str := ComponentToStringProc(td1)

Y para restaurar el contenido basta con esta:

Código Delphi [-]
  // Restaurar el contenido a un objeto de la clase TTrackData
  td2 := TTrackData(StringToComponentProc(Str));

Con estas líneas he conseguido generar con unos cuantos datos de ejemplo, un árbol como este:

Código Delphi [-]
//---------------------------------------------------------------------------------------------------
object TTrackData
  Creator = '-Neftal'#237'- German'
  Version = 'v.1.0'
  HRef = 'http://neftali.clubdelphi.com'
  Text = 'Importaci'#243'n de tracks'
  Time = '01/01/2013 08:00:00'
  TrackList = <
    item
      TrackPoints = <
        item
          Lat = '2.11'
          Lon = '4.23'
          Ele = '120'
        end
        item
          Lat = '2.111'
          Lon = '4.333'
          Ele = '120'
          Time = '01/01/2013 08:00:00'
          LatF = 2.111
          LonF = 4.333
        end
        item
          Lat = '2.234'
          Lon = '4.123'
          Ele = '125'
          Time = '02:01/2013 08:00:05'
          LatF = 2.234
          LonF = 4.123
        end>
      TrackName = 'Track 1 -sendero-'
      PaintWidth = 3
      PaintColor = 255
    end
    item
      TrackPoints = <
        item
          Lat = '2.90'
          Lon = '4.55'
          Ele = '320'
        end
        item
          Lat = '2.333'
          Lon = '4.444'
          Ele = '180'
          Time = '11/01/2013 07:00:00'
          LatF = 2.333
          LonF = 4.444
        end
        item
          Lat = '2.666'
          Lon = '4.666'
          Ele = '185'
          Time = '12:01/2013 07:00:05'
          LatF = 2.666
          LonF = 4.666
        end>
      TrackName = 'Track 2 -pista forestal-'
      PaintWidth = 3
      PaintColor = 32768
    end>
  WayPointList = <
    item
      Lat = '2.12'
      Lon = '4.23'
      Nombre = 'waypoint1'
      Desc = 'Waypoint 1 -Inicio-'
    end
    item
      Lat = '2.65'
      Lon = '4.45'
      Nombre = 'waypoint2'
      Desc = 'Waypoint 2 -Final-'
    end>
end
//---------------------------------------------------------------------------------------------------

Nada desdeñable, para haberlo hecho sin ninguna línea de código en las clases.

LA CONCLUSIÓN: Bueno, a parte de que me daba "mandra" generar la implementación (no era esa la verdadera razón de no hacerlo) pues he satisfecho la curiosidad de ver que se podían realizar esta operaciones sin ninguna línea de código extra en las clases. También es importante conocer que el hecho de añadir nuevas propiedades a las clases (si se hace correctamente) implica que el procedimiento sigue funcionando sin ningún cambio, lo que hace que sea un método totalmente flexible.

Otra cuestión a discutir sería si vale la pena la modificación de las clases o la sobrecarga que aporta a estas, el hecho de cambiar la estructura, pero como digo, eso es otro tema a discutir.

Un saludo.