Inicio > Delphi, OOP, RTTI > Persistencia de una estructura de clases.

Persistencia de una estructura de clases.

Share Button

core_data_image_1Esta entrada nace de una necesidad, la que he intentado explicar en el título, pero que tal vez, por la falta de espacio ha quedado “parca” y poco clara. Se trata de una estructura de clases almacenada en memoria y que utilizo en una de mis aplicaciones. Llegado a este punto tengo la necesidad de “respaldar” esta estructura  en disco, para posteriormente, desde este mismo programa o desde otro, poder recuperarla. Lo que comúnmente podemos llamar como un backup/restore.

Se trata de una estructura jerárquica de clases, en la que unas incluyen a otras y en la que además podemos encontrar listas de elementos. En una clase podemos encontrar propiedades de tipos simples (string, cadena), propiedades con objetos de otras clases y listas que almacenan objetos de otras clases.


Se verá más claro con un ejemplo. Pensad en una estructura de clases como la que se muestra a continuación:

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
type
 
TTrackData = class;
TPointInfo = class;
TSegmentList = class;
 
{Clase para encapsular la información de un punto.}
TPointInfo = class(TObject)
private
  FEle: string;
  FLon: string;
  FLat: string;
  FTime: string;
  FLatF: Double;
  FLonF: Double;
  FTrack:TSegmentList;
public
  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;
 
  property Track:TSegmentList read FTrack write FTrack;
 
  constructor Create(ATrack:TSegmentList;
                     ALat, ALon, AEle, ATime: string;
                     ALatF, ALonF:Double); overload; virtual;
end;
 
{: Clase para encapsular la información de un WayPoint.}
TWayPoint = class(TPointInfo)
private
  FNombre: string;
  FDesc: string;
  FSimbolo: string;
 
public
  property Nombre:string read FNombre write FNombre;
  property Desc:string read FDesc write FDesc;
  property Simbolo:string read FSimbolo write FSimbolo;
 
  constructor Create(ATrack:TTrackData; AWPNombre, AWPDesc:string;
                     ASimbolo:string; ALat, ALon, AEle, ATime: string;
                     ALatF, ALonF:Double); overload;
end;
 
{: Clase para las opciones de "pintado" de una lista de puntos.}
TPaintOptions = record
  Width:Integer;
  Color:TColor;  
end;
 
{: Clase para almacenar una lista de puntos.}
TPointList = Class(TList)
private
  FPaintOptions: TPaintOptions;
  function GetPoint(index: integer): TPointInfo; // Segment
public
  procedure AddPoint(pointInfo:TPointInfo); overload;
  procedure AddPoint(ATrack:TSegmentList;
                     ALat, ALon, AEle, ATime: string;
                     ALatF, ALonF:Double); overload;
 
  property Point[index:integer]:TPointInfo read GetPoint;
  property PaintOptions:TPaintOptions read FPaintOptions write FPaintOptions;
End;
 
{: Clase para encapsular datos de puntos de un track.}
TTrack = class (TObject)
  private
    FTrackPoints: TPointList;
    FTrackName: string;
  public
    constructor Create(AOwner: TComponent); override;
    procedure _debug(TS:TStrings);
  published
    //: Lista de puntos del track
    property TrackPoints:TPointList read FTrackPoints write FTrackPoints;
    //: Nombre del track
    property TrackName:string read FTrackName write FTrackName;
  end;

Como se puede ver, hay varias clases implicadas en la estructura, algún record y listas de elementos, ya sea utilizando TList o TStringList para las que almacenan junto al elemento un identificativo de tipo string.

La primera idea ha sido volcar el contenido a un fichero XML o JSON utilizando alguno de los muchos interfaces y clases que existen. No debería haber mayor problema en hacer eso. Basta con codificar el SaveToFile y el LoadFromFile correspondiente en cada una de las clases y debería funcionar sin mayores problemas que lo farragoso de codificar las clases y los recorridos de las listas.

Antes de empezar a codificar, me he parado a pensar si no habría alguna forma de ahorrarme todo ese trabajo de codificación. La idea de un DFM se me ha venido a la cabeza. Al final, es algo similar. Se trata de clases (en el caso de un formularios son componentes) que están “anidadas” y que dentro de algunas de ellas podemos encontrar listas de elementos (por ejemplos las columnas de los DBGrid) que a su vez son otras clases. La idea bien merecía dedicarle un poco de tiempo, así que he abierto este hilo en el ClubDelphi  para obtener ideas y sugerencias sobre el tema. Y de esta inquietud surge esta entrada.

Después de leer algunas ideas similares a las comentadas antes sobre los recorridos, mi enfoque ahora ya estaba claro. Se trataba de intentar conseguir esto a través de los métodos que se utilizan para trabajar con Streams (persistencia) y a través de RTTI.

En la propia ayuda/referencia de delphi (RAD Studio) he encontrado estos 2 métodos de la clase TMemoryStream que permiten, utilizando ReadComponent y WriteComponent, convertir un Componente a String y viceversa.

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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;

A partir de aquí, el planteamiento era cómo modificar (porque estaba claro que había que modificarlas) las estructura de las clases para adecuarlas a poder utilizar estos métodos de forma eficaz. Lo primero, tal como indicaban en el hilo Al González y Román, es que para poder utilizar estos métodos debemos añadir posibilidades de “persistencia” a las clases de la estructura anterior. TComponent y TPersistent serían dos de las clases que nos permiten hacer eso. TComponent la más conocida (y que deriva de la otra) y TPersistent la básica, tal como explica la propia ayuda de Delphi.

“The TPersistent class defined in the Classes unit of the VCL and CLX is declared in the {$M+} state, so any class derived from TPersistent will have RTTI generated for its published sections.”

La información de RTTI es la “poción mágica” que posibilita el poder generar los DFM o el poder visualizar las propiedades de los objetos en el Inspector de Objetos del IDE. Y es jústamente lo que necesitamos para que todo esto tenga posibilidades de éxito.

Para probar el planteamiento a ver si hay posible solución voy a empezar con alguna de las clases finales. La clase TWaypoint, que a su vez deriva de TPointInfo. No poseen ninguna complicación (aunque TPointInfo posee una referencia a otra clase, pero por ahora no se usa y no la tendremos en cuenta), así que no debería haber problemas si la teoría funciona. El único cambio a realizar es que voy a derivar TPointInfo de TComponent, en lugar de TObject. Además la mayoría de clases poseen un método _debug, que me permite ver el contenido de cada objeto y que me será muy útil para comprobar si el objeto creado corresponde con el original.

Ahora las clases quedarán así:

 

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
  {Clase para encapsular la información de un punto.}
  TPointInfo = class(TComponent)
  private
    ...
  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;
    property Track:TSegmentList read FTrack write FTrack;
    ...
    function _debug(TS:TStrings):string; virtual;
  end;
 
  {: Clase para encapsular la información de un WayPoint.}
  TWayPoint = class(TPointInfo)
  private
    ...
  published
    property Nombre:string read FNombre write FNombre;
    property Desc:string read FDesc write FDesc;
    property Simbolo:string read FSimbolo write FSimbolo;
    ...
    function _debug(TS:TStrings):string; override;
  end;

Como ya hemos comentado, vamos a hacer uso de RTTI (internamente los métodos comentados la usan), por lo tanto es indispensable que las propiedades que nos interesa “respaldar” pasen a ser Published. De ahí que también haya cambiado la sección public por published en las definiciones.

Para probarlo he realizado un pequeño programa que muestra 2 paneles. A la izquierda el resultado de convertir las clases en texto, y a la derecha, una vez recuperado y convertido de nuevo el string en componente, el _debug de ese componente. De esta forma podré comprobar si el resultado recuperado se asemeja al original. El código es muy básico, sólo posee la llamada  los 2 métodos de conversión y las líneas para mostrar el resultado en los memos.

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm1.Button2Click(Sender: TObject);
var
  way, way2:TWayPoint;
begin
  // Creamos y rellenamos un objeto de la clase
  way := TWayPoint.Create(nil, 'Way1', 'Waypoint 1 -Sendero-', 'Icon1', 
                          '2.3455678', '4.123456', '123' ,
                          '01/01/2013 10:10:10', 2.3455678, 4.123456);
  // Convertimos el objeto a string (Memo1 para el componente original)
  Memo1.Lines.Add(ComponentToStringProc(way));
  // Recuperamos desde el original y creamos de nuevo el componente/clase
  way2 := TWayPoint(StringToComponentProc(Memo1.Lines.Text));
  // Hacemos el debug del componente creado para comprobar (memo2)
  way2._debug(Memo2.Lines);
end;

Una vez ejecutado el programa el resultado ha sido el de la imagen inferior (izquierda); A priori el primer paso se ha realizado con éxito, aunque el segundo (la restauración) ha fallado, obteniendo un error de “Class not found”. Fallo mío. Está claro que para usar RTTI y para que sea posible generar la nueva instancia de la nueva clase, ésta debe estar registrada. Es el mismo error que obtenemos cuando intentamos utilizar la función GetClass de Delphi, sobre una clase no registrada. Basta con añadir la línea necesaria para registrarla y la cosa cambia (como se ve en la imagen de la derecha)…

RESULTADO

Como podemos ver en la imagen de la derecha, los valores del objeto recuperado son los correctos. De forma que la recuperación se ha realizado con éxito. +1

El siguiente “escollo” era gestionar las propiedades de tipo “Lista”. La propiedad Segment de una de las clases que utilizo está definida como TPointList que a su vez es una lista de TPointInfo (una lista de puntos) que actualmente deriva de TList.

De forma similar a como hemos hecho antes con las clases que hemos transformado en derivadas de TComponent, ahora se trata de utilizar TCollection y TCollectionItem, para obtener ventajas similares y ver si utilizando los mismos métodos podemos almacenar y recuperar las estructura de clases. Algunos cambios que he tenido que realizar son los siguientes:

  • La clase TPointInfo ahora ha pasado a derivar de TCollectionItem y será unos de los elementos de nuestras listas de puntos.
  • La clase TPointList pasa de derivar de TList a derivar de TCollection.
  • Como hemos hecho anteriormente las propiedades definidas como public que nos interesan pasan a la sección published.
  • La clase TTrack al igual que hicimos antes pasa a derivar de TComponent para poder añadirle “persistencia”.
  • Algunos pequeños cambios en la implementación, necesarios para adecuar código al cambios de definición, pero que no han sido nada importantes .
  • Registrar la clase TTrack al igual que hicimos anteriormente con TWayPoint.

Una vez realizados los cambios he lanzado el siguiente código, que crea e inicializa con datos 1 objeto de la clase TTrack y sigue los mismo pasos que hemos realizado anteriormente. Volcar el contenido a un string y posteriormente recuperarlo sobre otro objeto de la clase.

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.Button3Click(Sender: TObject);
var
  tr1, tr2:TTrack;
  po:TPaintOptions;
begin
  // crear un objeto TTrack
  tr1 := TTrack.Create(nil);
  // Rellenar la lista de puntos (TCollection)
  tr1.TrackPoints.AddPoint(nil, '2.345677', '4.123450', '123', '01/01/2013 10:10:10', 2.345677, 4.123450);
  tr1.TrackPoints.AddPoint(nil, '2.345678', '4.123460', '130', '01/01/2013 10:10:15', 2.345678, 4.123460);
  tr1.TrackPoints.AddPoint(nil, '2.345679', '4.123470', '134', '01/01/2013 10:10:20', 2.345679, 4.123470);
  // Asignar valores a PaintOptions (record)
  tr1.TrackPoints.PaintOptions.Width := 3;  
  list.TrackPoints.PaintOptions.Color := clNavy;
  // Asignar prop. TrackName
  tr1.TrackName := 'Track de ejemplo';
  // Volcar el contenido a String (Memo1 para el componente original)
  Memo1.Lines.Add(ComponentToStringProc(tr1));
 
  // recuperar el contenido y generar las clases
  tr2 := TTrack(StringToComponentProc(Memo1.Lines.Text));
  // debug del elemento creado (Memo2 para el objeto generado)
  tr2._debug(Memo2.lines);
end;

El resultado ha sido bastante parecido al esperado y además bastante aceptable.

Imagen335

Podemos ver en la imagen que a la hora de convertir el objeto, hemos “perdido” la información definida en el record TPaintOptions.  Para solventarlo basta convertir el record en una clase  (como hemos hecho con las otras), o en mi caso, pasar las dos propiedades a la clase, puesto que el hecho de que estuvieran dentro de un record era una simple cuestión “organizativa” y no “funcional”.

Por último, he completado el proceso con a estructura de clases completa y el resultado ha sido el esperado.

Os adjunto la estructura completa de clases tal y como ha quedado finalmente; Como podéis ver, no es algo simple, sino que se incluyen varios niveles. Lo que más me gusta de este método es que es independiente de la estructura de las clases. Es decir, si yo añado varias propiedades nuevas (y siempre que mantenga los normas que he comentado al crear las clases), sin ningún cambio el código seguirá grabando y recuperando el contenido de las clases sin problemas.

 

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
  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;
  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, ALonF:Double); overload;
    property Point[index:integer]:TPointInfo read GetPoint;
  published
    procedure _debug(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);
    procedure _debug(TS:TStrings);
  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
    procedure _debug(TS:TStrings);
    // 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;

La última prueba que he realizado con datos de ejemplo, es la que podéis ver en la imagen inferior, donde se ve la estructura completa de las clases.

result

La conclusión es que modificando levemente las clases originales hemos conseguido hacer un Backup/Restore sin necesidad de programar las correspondientes operaciones. Tal vez no sea

Os adjunto el ejemplo que incluye tanto los fuentes como la units con la estructura de clases completa. El ejemplo con los datos y en un fichero diferente el ejemplo compilado (Delphi 6).

<Código fuente del ejemplos -sources->
<Ejemplo compilado EXE>

Share Button
Categories: Delphi, OOP, RTTI Tags: , ,
  1. viernes, 8 de marzo de 2013 a las 19:38 | #1

    Como siempre una excelente publicación, muy ilustrativa y con tu gran estilo. Muchas gracias Gremán.

    Saludos

  2. sábado, 9 de marzo de 2013 a las 10:10 | #2

    Excelente, Germán.
    :-)

    Ilustrativo y práctico. Y por supuesto didáctico.

  3. sábado, 9 de marzo de 2013 a las 13:46 | #3

    Excelente artículo Gremán :-)

  4. Neftalí
    sábado, 9 de marzo de 2013 a las 15:33 | #4

    Gracias por vuestros comentarios.
    La verdad es que ya tenía ganas de volver a escribir de nuevo en el blog.

    Un saludo.

  5. Antonio Escobar Tizón
    miércoles, 13 de marzo de 2013 a las 14:50 | #5

    Me parece muy interesante sobre todo para la reflexion y obtener un listado de propiedade en tiempo de ejecución, pero para tener persistencia de datos yo he combinado un patron singleton y las clases que hereden de TXmlObject y TXmlObjectList para poder volcar a disco la estructura de clase a disco.

  6. Neftalí
    miércoles, 13 de marzo de 2013 a las 16:22 | #6

    @Antonio Escobar Tizón
    Hay muchas más formas de hacer esto, entre ellas la que tú comentas.

    Un saludo.

  7. sábado, 15 de junio de 2013 a las 17:19 | #7

    Hola, muy interesante. Esta técnica la estoy usando para persistir mis clases pero con una diferencia, las clases no conocen sobre la serialización, en su lugar tengo otras clases que se encargan de serializar estos objetos. De esta manera puedo tener un serializador a XML, otro a texto, etc.Permitanme hacer otra observación, no soy muy partidario hacer que una clase herede de TList, en su lugar contaría con un atributo privado (o protegido) que sea la propia TList, y mi clase que cuente con métodos para acceder adecuadamente. De esta manera podría cambiar la implementacion interna de esta clase sin afectar al resto de los objetos, como sucedió con TPointList. Es solo una observación.Saludos

  8. Alejandro Noya
    lunes, 8 de mayo de 2017 a las 03:44 | #8

    Ya había visto este tema antes pero nunca lo he necesitado. Ahora que lo necesito quiero bajar los archivos del código fuente y da error.

    ¿Se podrían volver a subir?

  9. lunes, 8 de mayo de 2017 a las 07:36 | #9

    @Alejandro Noya
    Hola Alejandro.
    En el último cambio del blog se perdieron algunos enlaces.
    Ya está corregido y deberías poder bajar los ficheros sin problemas.

    Un saludo.

  1. Sin trackbacks aún.
What is 28 + 7 ?
Please leave these two fields as-is:
IMPORTANTE! Para continuar, debes contestar la pregunta anterior (para evitar SPAM) :-)