Serializacja klas cz1. cz.2 i cz.3

Zbiór 3 artykułów o serializacji klas w Delphi mojego autorstwa bazujący na mechanizmach używanych przez VCL. Obecnie (od Delphi 2010) serializacja jest możliwa w dużo bardziej prosty i oczywisty sposób o którym postaram się wkrótce napisać, jednak warto poznać ta "Old Schoolową" technikę. Wrzucam wszystkie 3 części:

najważniejsze procedury z dtxUtils używane w dalszym kodzie, bardzo przydatne podczas serializacji klas w Delphi

function ComponentToString(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;

procedure StringToComponent(Value: string; Comp: TComponent);
var
 StrStream:TStringStream;
 BinStream: TMemoryStream;
begin
 StrStream := TStringStream.Create(Value);
 try
   BinStream := TMemoryStream.Create;
   try
     ObjectTextToBinary(StrStream, BinStream);
     BinStream.Seek(0, soFromBeginning);
     BinStream.ReadComponent(Comp);
   finally
     BinStream.Free;
   end;
 finally
   StrStream.Free;
 end;
end;

{$WARNINGS OFF}
procedure SaveComponent(AFile: string; AComponent: TComponent;
  AText: boolean = true);
var
  f: TFileStream;
  m: TMemoryStream;
begin
  if AText then
  try
    m := TMemoryStream.Create;
    m.WriteComponent(AComponent);
    m.Seek(0, soFromBeginning);

    f := TFileStream.Create(AFile, fmCreate);
    ObjectBinaryToText(m, f);
  finally
    m.Free;
    f.Free;
  end else
  try
    f := TFileStream.Create(AFile, fmCreate);
    f.WriteComponent(AComponent);
  finally
    f.Free;
  end;
end;
{$WARNINGS ON}

{$WARNINGS OFF}
procedure LoadComponent(AFile: string; AComponent: TComponent;
  AText: boolean = true);
var
  f: TFileStream;
  m: TMemoryStream;
begin
  if AText then
  try
    f := TFileStream.Create(AFile, fmOpenRead);
    m := TMemoryStream.Create;

    ObjectTextToBinary(f, m);
    m.Seek(0, soFromBeginning);
    m.ReadComponent(AComponent);
  finally
    m.Free;
    f.Free;
  end else
  try
    f := TFileStream.Create(AFile, fmOpenRead);
    f.ReadComponent(AComponent);
  finally
    f.Free;
  end;
end;
{$WARNINGS ON}

Część 1

(*******************************************************************************
  Serializacja klas w Delphi cz.1

  DaThoX 2004-2008 

  Maciej Izak (hnb.code[at]gmail[dot]com)


  Serializacja – w programowaniu komputerów proces przekształcania obiektów,
    tj. instancji określonych klas, do postaci szeregowej, czyli w strumień
    bajtów, z zachowaniem aktualnego stanu obiektu. Serializowany obiekt może
    zostać utrwalony w pliku dyskowym, przesłany do innego procesu lub innego
    komputera poprzez sieć. Procesem odwrotnym do serializacji jest
    deserializacja. Proces ten polega na odczytaniu wcześniej zapisanego
    strumienia danych i odtworzeniu na tej podstawie obiektu klasy wraz z jego
    stanem bezpośrednio sprzed serializacji.

  Powyższa definicja pochodzi z wikipedii
  (http://pl.wikipedia.org/wiki/Serializacja)

  Serjalizacja w Delphi wygląda dużo bardziej estetycznie niż w innych językach
  i moim zdaniem jest znacznie prostsza. Zresztą nie bedę się zbytnio rozpisywał
  :) - przejdźmy do kodu

(******************************************************************************)

program Lesson_01;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes, // <- podstawowe klasy z których bedziemy dziedziczyć
  Dialogs,
  dtxUtils // <- napisałem procedury ułatwiające serializację klas
  ;

{-------------------------------------------------------------------------------
  Generalnie sprawa jest prosta. Każda klasa którą chcemy zapisywać do pliku musi
  dziedziczyć z TComponent. Oczywiście jeśli posiadamy odpowiednio duża wiedzę
  możemy się pokusić o napisanie własnych klas do zapisu klas do pliku ale po co?

  TComponent jest świetną klasą, zwartą i dzielącą/łączącą wszystko w jedną całość.
  Możemy przyjąć że TComponent to Np. TGracz
{------------------------------------------------------------------------------}

type
  // wrsja gracza 1 :) - później omówimy kolejne możliwości serializacji
  // i nie chcę by ten tutek stracił czytelność
  TPlayer1 = class(TComponent)
  private
    FName: string; // nazwa
    FRememberPasswd: boolean; // możemy nie chcieć zapamiętywać hasła do pliku
                              //by go ktoś nie przechwycił
    FPasswd: string; // hasło
  public
    // ---
  protected
    // ---
  published
    // zapis odbywa się dzięki property
    property Name: string read FName write FName;
    // kolejność property ma OGROMNE znaczenie. Przypuśćmy że pole
    //
    //  property RememberPasswd
    //
    // byłoby za
    //
    //  property Passwd
    //
    // wtedy zawartość Passwd mogłaby zostać nie wczytana ponieważ na końcu jej
    // deklaracji mamy dyrektywę "stored" i nazwę pola "FRememberPasswd" co
    // oznacza:
    //
    //    "zainicjalizuj właściwość Passwd tylko jeśli pole FRememberPasswd
    //     ma wartość true"
    //
    // !!!oczywiście za stored możemy umieśćić funkcję (która zostanie wywołana
    // podczas odczytu/zapisu)!!!
    //
    // Z tego wniosek, że za późno zinicjalizowalibyśmy wartość pola
    // FRememberPasswd i przez to nie wczytalli hasła :(
    property RememberPasswd: boolean read FRememberPasswd write FRememberPasswd;
    property Passwd: string read FPasswd write FPasswd stored FRememberPasswd;
  end;

{-------------------------------------------------------------------------------
  Zaletą serializacji klas w delphi jest to że struktura klasy może się
  !zmieniać! co w przypadku plików binarnych niosłoby ze sobą szereg zmian.

  ZALETĄ zapisu przez property jest fakt że możemy za read/write wstawić metody
  odczytu i zapisu co w połączeniu ze stored daje nam ogromne mozliwości!
{------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
  Na chwilę obecną zanim omówimy bardziej zaawansowane aspekty serializacji w
  Delphi sprawdźmy czy faktycznie działa...
{------------------------------------------------------------------------------}

var
  Player: TPlayer1;
  c: char;
begin
  Player := TPlayer1.Create(nil);

  Write('Podaj swoj nick : ');
  ReadLn(Player.FName);

  Write('Podaj haslo : ');
  ReadLn(Player.FPasswd);

  Write('Zapamietac twoje haslo na pozniej (T/N)? : ');
  ReadLn(c);
  Player.FRememberPasswd := UpCase(c) = 'T';

  // przekształcamy obiekt w tekst :)
  // zapisem zajmiemy się w nastepnej części
  WriteLn(sLineBreak,

    ComponentToString(Player)

  );

  // zakończ ...
  ReadLn;
  Player.Free;
end.

Część 2

(*******************************************************************************
  Serializacja klas w Delphi cz.2

  DaThoX 2004-2008

  Maciej Izak (hnb.code[at]gmail[dot]com)

  Na dzisiejszej lekcji zajmiemy się obsługą zapisu przypisanej metody do pola
  (Delphi umożliwia zapamiętanie jaką metodę przypisaliśmy polu typu
  proceduralnego obiektowego)

  Poznamy także procedury umozliwiajace odczyt/zapis klasy z/do pliku
(******************************************************************************)
program Lesson_02;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes, // <- podstawowe klasy z których bedziemy dziedziczyć
  Dialogs,
  dtxUtils; // <- napisałem procedury ułatwiające serializację klas
{-------------------------------------------------------------------------------
  Na dole w głównym bloku begin ... end. znajduje się opis zapisu i odczytu klas
  z jak i do pliku ...

  ------------------------------------------------------------------------------
  /// Funkcje pomocnicze z dtxUtils.pas                                      ///
  ------------------------------------------------------------------------------

  --- 
   1  procedure StringToComponent(Value: string; Comp: TComponent);
  ---
  ------------------------------------------------------------------------------
  Konwertuje dane z łańcucha znaków na dane do obiektu i inicjalizuje
  jego dane. Przekazywana klasa Comp musi być wczesniej stworzona.


  ---
   2  function ComponentToString(Component: TComponent): string;
  ---
  ------------------------------------------------------------------------------
  Konwertuje komponent na łańcuch


  --- 
   3  procedure SaveComponent(AFile: string; AComponent: TComponent;
  ---   AText: boolean = true);
  ------------------------------------------------------------------------------
  Zapisuje komponent do pliku tekstowego. Parametr AText ustawia czy ma być
  to w postaci czytelnej dla człowieka (tekstowej) czy też binarnej.
  Wersja binarna zajmuje nieco mniej miejsca.


  ---
   4  procedure LoadComponent(AFile: string; AComponent: TComponent;
  ---   AText: boolean = true);
  ------------------------------------------------------------------------------
  Robi dokładnie to co SaveComponent tylko w drugą stronę

  ------------------------------------------------------------------------------
  /// Funkcje i typy pomocnicze z "Classes.pas"                              ///
  ------------------------------------------------------------------------------

  ---
   1  type
  ---   TStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
  ------------------------------------------------------------------------------
  Typ mówiący o tym w jakiej postaci zapisaliśmy obiekt (binarna/tekstowa)


  ---
   2  procedure ObjectBinaryToText(Input, Output: TStream); overload;
  --- procedure ObjectBinaryToText(Input, Output: TStream;
        var OriginalFormat: TStreamOriginalFormat); overload;
      procedure ObjectTextToBinary(Input, Output: TStream); overload;
      procedure ObjectTextToBinary(Input, Output: TStream;
        var OriginalFormat: TStreamOriginalFormat); overload;
  ------------------------------------------------------------------------------
  Funkcje konwertujące obiekt w postaci binarnej do tekstowej (i odwrotnie)
  operujące na strumieniach


  ---
   3  procedure ObjectResourceToText(Input, Output: TStream); overload;
  --- procedure ObjectResourceToText(Input, Output: TStream;
        var OriginalFormat: TStreamOriginalFormat); overload;
      procedure ObjectTextToResource(Input, Output: TStream); overload;
      procedure ObjectTextToResource(Input, Output: TStream;
        var OriginalFormat: TStreamOriginalFormat); overload;
  ------------------------------------------------------------------------------
  Funkcje konwertujące postać tekstową do zasobów i odwrotnie


  ---
   4  function TestStreamFormat(Stream: TStream): TStreamOriginalFormat;
  ---
  ------------------------------------------------------------------------------
   Funkcja sprawdzająca jakiego typu są dane zserializowanego obiektu

{------------------------------------------------------------------------------}
type
  // "typ" naszej procedury
  TOnPrint = procedure of object;

  // wrsja gracza 2 :) - zawiera wszystko to co zawierała klasa z poprzedniej
  // części + mała nowość :)
  TPlayer2 = class(TComponent)
  private
    FName: string;
    FRememberPasswd: boolean;
    FPasswd: string;
    FOnPrint: TOnPrint;
  public
    // ---
  protected
    // ---
  published
    property Name: string read FName write FName;
    property RememberPasswd: boolean read FRememberPasswd write FRememberPasswd;
    property Passwd: string read FPasswd write FPasswd stored FRememberPasswd;

    // tytaj zaczynają się nowości :) ...
    procedure OnPrint1; // mamy dwie procedury do wyboru
    procedure OnPrint2;

    // pole pamiętające nasz wybór (możemy przypisać mu dowolną metodę będacą
    // w sekcji published z klasy w której ów właściwość jest zadeklarowana)
    property OnPrint: TOnPrint read FOnPrint write FOnPrint;
  end;


{ TPlayer2 }

procedure TPlayer2.OnPrint1;
begin
  WriteLn('Wywolano OnPrint1');
end;

procedure TPlayer2.OnPrint2;
begin
  WriteLn('Wywolano OnPrint2');
end;

var
  Player: TPlayer2;
  c: char;
{-------------------------------------------------------------------------------
  Poniżej są zastosowane procedury zapisu odczytu klas do plików i strumieni.
{------------------------------------------------------------------------------}
begin
  Player := TPlayer2.Create(nil);

  Write('Ktora metode chcesz przypisac do property OnPrint (1 lub 2) : ');
  ReadLn(c);
  if c = '1' then
    Player.OnPrint := Player.OnPrint1
  else
    Player.OnPrint := Player.OnPrint2;

  // Wywołujemy property :)
  WriteLn(sLineBreak, 'Za chwile wywolamy metode zapisana w property OnPrint :');
  Player.OnPrint;
  WriteLn;

  WriteLn('Tak wyglada nasza klasa przerobiona na napis :', sLineBreak, sLineBreak,

    ComponentToString(Player)

  );

  // zapisujemy do pliku
  SaveComponent('Player.txt', Player);
  // i zwalniamy
  Player.Free;

  WriteLn(sLineBreak,
    'Klasa zostala zapisany do ''Player.txt'' i zwolniona z pamieci. ',
    'Mozesz otworzyc zapisany plik i go zmodyfikowac - za chwile klasa TPlayer2 ',
    'zostanie utworzona na nowo i wlasnie z ''Player.txt'' zostanie wczytana ',
    'zawartosc klasy. Zmodyfikuj plik jak chcesz i wcisnij [ENTER] by ',
    'zaincjalizowac klase i wywolac property OnPrint.');
  ReadLn;

  // tworzymy obiekt od nowa
  Player := TPlayer2.Create(nil);
  LoadComponent('Player.txt', Player);
  WriteLn('Tak wyglada nasza klasa po wczytaniu z pliku :', sLineBreak, sLineBreak,

    ComponentToString(Player)

  );

  // Wywołujemy property :)
  WriteLn('Za chwile wywolamy metode zapisana w property OnPrint :');
  Player.OnPrint;
  WriteLn;

  // zakończ ...
  ReadLn;
  Player.Free;
end.

Część 3

(*******************************************************************************
  Serializacja klas w Delphi cz.3

  DaThoX 2004-2008

  Maciej Izak (hnb.code[at]gmail[dot]com)

  Na dzisiejszej lekcji dowiemy się jak wpleść w klasę TComponent inne klasy
  nie dziedziczące z TComponent;
(******************************************************************************)

program Lesson_03;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes, // <- podstawowe klasy z których bedziemy dziedziczyć
  Dialogs,
  dtxUtils; // <- napisałem procedury ułatwiające serializację klas

type
  // nasza klasa która chcemy wpleść. Np. gracz ma samochód :)
  //
  // musimy dziedziczyć z TPersistent - ona zapisuje z RTTI naszej klasy
  // właściwości z sekcji published. Moglibyśmy sami napisać taką klasę ale
  // ta jest wystarczająco dobra i nic nie dorzuca do TObject. Czyli zamiast
  // dziedziczyć po TObject (TKlasa = class lub TKlasa = class(TObject))
  // dziedziczymy z TPersistent TKlasa = class(TPersistent)
  TCar = class(TPersistent)
  private
    FName: string;
    FMaxSpeed: single;
  public
    constructor Create(AName: string; AMaxSpeed: single);
  published
    property Name: string read FName write FName;
    property MaxSpeed: single read FMaxSpeed write FMaxSpeed;
  end;

{ TCar }

constructor TCar.Create(AName: string; AMaxSpeed: single);
begin
  inherited Create;
  FName := AName;
  FMaxSpeed := AMaxSpeed;
end;

  // wrsja gracza 3 :) -
  // NOWOŚĆ :D Jeśli klasa ma włączone RTTI to od razu po class(TComponent)
  // mamy do czynienia z sekcją published :)
  // NOWOŚĆ 2 :D
  // sprawdź blok begin ... end. aplikacji. Jeśli nadamy wartość polu name z
  // TComponent nasz obiekt w wersji tekstowej będzie wyglądał inaczej :)...
type
  TPlayer3 = class(TComponent)
  // tu też jest published !!! tylko ciut inne ;) - omówimy później
  //
  //
  private
    FCar: TCar;
  public
    // musim stworzyć i zniszczyć klasę z pola FCar
    constructor Create; reintroduce;
    destructor Destroy; override;
  published
    property Car: TCar read FCar write FCar;
  end;

{ TPlayer3 }

constructor TPlayer3.Create;
begin
  inherited Create(nil);
  FCar := TCar.Create('BMW', 210.6);
end;

destructor TPlayer3.Destroy;
begin
  FCar.Free;
  inherited;
end;

var
  Player: TPlayer3;
  c: char;
begin
  Player := TPlayer3.Create;

  // NADAJEMY Name :D
  Player.Name := 'HNB';

  WriteLn(

    ComponentToString(Player)

  );
  // zakończ ...
  ReadLn;
  Player.Free;
end.

Powodzenia :)! Powyżej zaprezentowane lekcje to tylko niewielki wstęp do całego tematu. Zachęcam do samodzielnego poszerzania wiedzy, albo do czekania na kolejne części :).