Delphi: сохранение массива объектов в файл. (Сериализация)

Хотя я согласен с Дэвидом в том, что JSON сегодня будет правильным выбором для постоянных бизнес-объектов и контейнеров, я хотел бы опубликовать здесь код, чтобы сделать это с помощью TCollection и TCollectionItem. Это старый способ, с которым Delphi использовался с самого начала, для потоковой передачи свойств компонента в файлы dfm.

Но здесь есть оговорка. Я тестировал этот код, и он не работает ... не потому, что он сломан (я использовал аналогичный код в течение многих лет, чтобы сохранить бизнес-объекты), но потому что TSphere не поддерживает интерфейс TPersistent Assign и AssignTo. Для этого свойства элемента коллекции должны быть либо простыми типами данных и записями, либо правильными реалиями TPersistent. И TSphere не является ни тем, ни другим.

Во всяком случае, вот код:

Интерфейс

Type
  TNode = Class(TCollectionItem)
  Private
    FSphere       : TSphere;
    FID           : String;
    FNodeType     : String;
    FTotalDistance: integer;
    Procedure SetSphere(Const Value: TSphere);
  Public
    Constructor Create(Collection: TCollection); Override;
    Destructor Destroy; Override;
    Procedure Assign(Source: TPersistent); Override;
  Published
    Property Sphere       : TSphere Read FSphere Write SetSphere;
    Property ID           : String Read FID Write FID;
    Property NodeType     : String Read FNodeType Write FNodeType;
    Property TotalDistance: integer Read FTotalDistance Write FTotalDistance; // used in Dijkstras algorithm
  End;

Type
  TNodes = Class(TCollection)
  Private
    Function GetItem(Index: integer): TNode;
    Procedure SetItem(Index: integer; Value: TNode);
  Public
    Constructor Create; Reintroduce;
    Function Add: TNode;
    Procedure LoadFromFile(Const Filename: String);
    Procedure LoadFromStream(S: TStream);
    Procedure SaveToFile(Const Filename: String);
    Procedure SaveToStream(S: TStream);
    Property Items[Index: integer]: TNode Read GetItem Write SetItem; Default;
  End;

Type
  TNodesWrapper = Class(TComponent)
  Private
    FCollection: TNodes;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  Published
    Property Collection: TNodes Read FCollection Write FCollection;
  End;

и реализация

{ TNode }

Procedure TNode.Assign(Source: TPersistent);
Begin
  If Source Is TNode Then Begin
    If Assigned(Collection) Then
      Collection.BeginUpdate;
    Try
      Sphere        := TNode(Source).Sphere;
      ID            := TNode(Source).ID;
      NodeType      := TNode(Source).NodeType;
      TotalDistance := TNode(Source).TotalDistance;
    Finally
      If Assigned(Collection) Then
        Collection.EndUpdate;
    End;
  End
  Else
    Inherited;
End;

Constructor TNode.Create(Collection: TCollection);
Begin
  Inherited;
  FSphere := TSphere.Create(Nil);
  // Set default values here
End;

Destructor TNode.Destroy;
Begin
  FreeAndNil(FSphere);
  Inherited;
End;

Procedure TNode.SetSphere(Const Value: TSphere);
Begin
  FSphere.Assign(Value);
End;

{ TNodes }

Function TNodes.Add: TNode;
Begin
  Result := TNode(Inherited Add);
End;

Constructor TNodes.Create;
Begin
  Inherited Create(TNode);
End;

Function TNodes.GetItem(Index: integer): TNode;
Begin
  Result := TNode(Inherited GetItem(Index));
End;

Procedure TNodes.LoadFromFile(Const Filename: String);
Var
  S: TFileStream;
Begin
  S := TFileStream.Create(Filename, fmOpenRead);
  Try
    LoadFromStream(S);
  Finally
    S.Free;
  End;
End;

Procedure TNodes.LoadFromStream(S: TStream);
Var
  Wrapper: TNodesWrapper;
  SBin   : TMemoryStream;
Begin
  SBin    := TMemoryStream.Create;
  Wrapper := TNodesWrapper.Create(Nil);
  Try
    ObjectTextToBinary(S, SBin);
    SBin.Position := 0;
    SBin.ReadComponent(Wrapper);
    Assign(Wrapper.Collection);
  Finally
    Wrapper.Free;
    SBin.Free;
  End;
End;

Procedure TNodes.SaveToFile(Const Filename: String);
Var
  S: TStream;
Begin
  S := TFileStream.Create(Filename, fmCreate);
  Try
    SaveToStream(S);
  Finally
    S.Free;
  End;
End;

Procedure TNodes.SaveToStream(S: TStream);
Var
  Wrapper: TNodesWrapper;
  SBin   : TMemoryStream;
Begin
  SBin    := TMemoryStream.Create;
  Wrapper := TNodesWrapper.Create(Nil);
  Try
    Wrapper.Collection.Assign(Self);
    SBin.WriteComponent(Wrapper);
    SBin.Position := 0;
    ObjectBinaryToText(SBin, S);
  Finally
    Wrapper.Free;
    SBin.Free;
  End;
End;

Procedure TNodes.SetItem(Index: integer; Value: TNode);
Begin
  Inherited SetItem(Index, Value);
End;

{ TNodesWrapper }

Constructor TNodesWrapper.Create(AOwner: TComponent);
Begin
  Inherited;
  FCollection := TNodes.Create;
End;

Destructor TNodesWrapper.Destroy;
Begin
  FreeAndNil(FCollection);
  Inherited;
End;

TCollections все еще используются, хотя некоторые из этого кода могут показаться странными для тех, кто использует общие контейнеры ... большая часть его связана с приведением типов и привязыванием одного класса TCollectionItem к его конкретному классу TCollection.

Магия происходит в методах Stream ReadComponent и WriteComponent. К сожалению, поскольку TCollection не является TComponent, он должен быть завернут в TComponent ... и для этого нужен TNodesWrapper.

Это может показаться странным и сложным, но большая часть этого может быть абстрагирована в потоке потомков TCollection общего назначения, который добавляет возможность Load и Save to File / Stream / String. И поэтому большая часть этого кода может быть скрыта под капотом.

И ... Повторяю ... это работает только в том случае, если свойства, которые вы хотите сохранить, по сути являются устойчивыми ... и TSphere нет. Поэтому я теперь задаюсь вопросом, как сохраняются формы FireMonkey 3D, поскольку я еще не разработал 3D-приложения.

Не используйте массивы и статические размерные / связанные вещи вообще! Примените одно правило ответственности. Создавайте сериализаторы для своих объектов. В этом случае вы можете изменить свое мнение и создать любое количество сериализаторов для любых форматов. Ваш код становится более гибким, изменчивым и проверяемым.

TSphere = class
  // Entity. Just fields with getter/setter methods
end;

TContext = TDictionary<string><TObject>;

CONST_ctxkey_Factory = 'factory';

IStream = interface (IInvokable )
  procedure load( var data_; size_ : cardinal );
  procedure store( var data_; size_ : cardinal );
end;

ISerializer = interface ( TInvokable )
  procedure load( ctx_ : TContext );
  procedure store( ctx_ : TContext );
end;

TSerializer = class ( TInterfaceObject, ISerializer )
  protected
    // Attributes
    fObject : TObject;
    fStream : IStream;

  public
    constructor create( object_ : TObject; stream_ : IStream );

    // Realized methods (ISerializer)
    procedure load( ctx_ : TContext ); virtual; abstract;
    procedure store( ctx_ : TContext ); virtual; abstract;        
end;

TSphereSerializer_XML = class ( TSerializer )
  public
    // Overriden methods
    procedure load( ctx_ : TContext ); override;
    procedure store( ctx_ : TContext ); override;      
end;

TSpheresMainSerializer_BIN = class ( TSerializer )
  public
    // Overriden methods
    procedure load( ctx_ : TContext ); override;
    procedure store( ctx_ : TContext ); override;
end;

TSpheresMainSerializer_BIN.store( ctx_ : TContext );
var
  spheres : TSphereList;
  sf : TSerializerContext;
  sph : TSphere;
  iSe : ISerializer;
begin
  spheres := TSphereList( fObject );
  sf := ctx_.items[CONST_ctxkey_Factory];
  fStream.write( version_number, sizeOf( cardinal ) );
  fStream.write( spheres.count, sizeOf( cardinal ) );
  for sph in shperes_ do
  begin
    iSe := sf.createShpereSerializer( sph );
    iSe.store( ctx );
  end;
end;

TSphereSerializer_BIN = class ( TSerializer )
  public
    // Overriden methods
    procedure load( ctx_ : TContext ); override;
    procedure store( ctx_ : TContext ); override;
end;

TSphereList = TList<TSphere>;

TSerializerFactory = class
  public
    // It creates serializers for XML format
    function createContext : TContext; virtual;
    function createSpheresMainSerializer( spheres_ : TSphereList; stream_ : IStream ) : ISerializer; virtual; abstract;
    function createSphereSerializer( sphere_ : TSphere; stream_ : IStream ) : ISerializer; virtual; abstract;
end;

TSerializerFactory_BIN = class ( TSerializerFactory )
  public
    // It creates serializers for binary format
    function createSpheresMainSerializer( spheres_ : TSphereList; stream_ : IStream ) : ISerializer; override;
    function createSphereSerializer( sphere_ : TSphere; stream_ : IStream ) : ISerializer; override;
end;

function TSerializerFactory_BIN.createSpheresMainSerializer( spheres_ : TSphereList; stream_ : IStream ) : ISerializer; 
begin
  result := TSpheresMainSerializer_BIN.create( TObject( spheres_ ), stream_ );
end;

function TSerializerFactory_BIN.createSphereSerializer( sphere_ : TSphere; stream_ : IStream ) : ISerializer; 
begin
  result := TSphereSerializer_BIN.create( sphere_, stream_ );
end;

Формат выходного файла следующей процедуры зависит от TSerializerFactory, переданного как параметр (sf_):

procedure saveSpheresToStream( spheres_ : TSphereList; stream_ : IStream; sf_ : TSerializerFactory );
var
  ctx : TContext;
  iSe : ISerializer;
begin
  try
    ctx := sf_.createContext;
    ctx.add( CONST_ctxkey_Factory, sf_ );
    try
      iSe := sf_.createSpheresMainSerializer( spheres_, stream_ );
      iSe.store( ctx );
    finally
      ctx.free;
    end;
end;

Я знаю, что он был слишком толстым, слишком длинным для первого взгляда ... но, возможно, полезным! :)