How does the Spring4D [inject] attribute function internally? - delphi

I'm trying to create a minimal example, that does the same thing as the Spring4D [inject] Attribute. It's supposed to automatically resolve my TOrderAdapter.FDetailsAdapter, which I want to manually instantiate inside a Factory unit (not like the Spring4D container works, registering interfaces from the outside first). The Factory should hand out any desired interfaces requested with [inject].
It is pretty obvious that the code I have can not work (TOrderAdapter.FDetailsAdapter not being injected, giving me a nil pointer Access Violation on ButtonClick, the first use). Reading through the Spring4D source, I fail to see where this logical piece is, that I'm missing for the desired functionality to work in my example.
program OrderDetails;
uses
Vcl.Forms,
Order.Adapter in 'Order.Adapter.pas',
Details in 'Details.pas',
Details.Adapter in 'Details.Adapter.pas',
Factory.Adapter in 'Factory.Adapter.pas',
Factory in 'Factory.pas',
Order in 'Order.pas',
Order.View in 'Order.View.pas' {OrderForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TOrderForm, OrderForm);
Factory.Adapter.Factory := TFactoryAdapter.Create;
Application.Run;
end.
unit Factory;
uses
Rtti, TypInfo;
type
InjectAttribute = class(TCustomAttribute)
private
fServiceType: PTypeInfo;
fValue: TValue;
public
constructor Create(ServiceType: PTypeInfo); overload;
property ServiceType: PTypeInfo read fServiceType;
property Value: TValue read fValue;
end;
implementation
constructor InjectAttribute.Create(ServiceType: PTypeInfo);
begin
inherited Create;
fServiceType := ServiceType;
end;
end.
unit Factory.Adapter;
uses
Details, Details.Adapter, Order, Order.Adapter;
type
TFactoryAdapter = class
private
FDetailsAdapter: IDetailsAdapter;
FOrderAdapter: IOrderAdapter;
public
constructor Create;
function Inject: IInterface; overload; // unused
end;
var
Factory: TFactoryAdapter;
implementation
constructor TFactoryAdapter.Create;
begin
FDetailsAdapter := TDetailsAdapter.Create;
FOrderAdapter := TOrderAdapter.Create;
end;
function TFactoryAdapter.Inject: IInterface; // unused
begin
Result := FDetailsAdapter;
end;
end.
unit Details.Adapter;
uses
Details, Winapi.Windows, SysUtils;
type
TDetailsAdapter = class(TInterfacedObject, IDetailsAdapter)
private
FID: Integer;
public
procedure SetID(AID: Integer);
function GetID: Integer;
published
property ID: Integer read GetID write SetID;
end;
implementation
procedure TDetailsAdapter.SetID(AID: Integer);
begin
FID := AID;
OutputDebugString(PWideChar('OrderDetail ID set to ' + IntToStr(FID)));
end;
function TDetailsAdapter.GetID: Integer;
begin
Result := FID;
end;
end.
unit Order.Adapter;
uses
Order, Order.View, Details, Factory,
Vcl.Forms;
type
TOrderAdapter = class(TInterfacedObject, IOrderAdapter)
private
[inject]
FDetailsAdapter: IDetailsAdapter;
public
constructor Create;
procedure ButtonClick(Sender: TObject);
end;
var
OrderForm: TOrderForm;
implementation
constructor TOrderAdapter.Create;
begin
OrderForm.Button1.OnClick := ButtonClick;
end;
procedure TOrderAdapter.ButtonClick(Sender: TObject);
begin
FDetailsAdapter.ID := 5;
end;
end.

The container uses RTTI to collect the members that have this attribute and injects the correct services into them.

Related

Misleading memory leak on mocked method using Spring4D

I have a class TMyClass, on which I inject interface IFileManager. In this interface there is a method GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream). This method fills AStream depend from ACompanyId. Everything works fine on real code, but when I run unit tests for class TMyClass and mocked IFileManager via framework Spring4D, FastMM reports for memory leak 13-20 bytes: TIndexWrapper x 1. I used last Spring4D version 1.26 from repository(branch main/master)
unit Unit1.pas
interface
DUnitX.TestFramework,
Spring.Mocking;
type
IFileManager = interface (IInvokable)
procedure GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream);
end;
TMyClass = class
strict private
FFileManager: IFileManager;
public
constructor Create(const AFileManager: IFileManager);
procedure GenerateInvoice(const ACompanyId: System.Integer);
end;
[TestFixture]
TMyClassTests = class
strict private
FMockStream: TStream;
FMyClass: TMyClass;
FFileManager: Mock<IFileManager>;
procedure SetupFileManagerMock();
procedure InitMockStream(const AMockFile: string);
public
[Setup]
procedure Setup();
[TearDown]
procedure TearDown();
[TestCase('Test invoice generation', '2|invoice_2023.xls', '|')]
procedure TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
end;
implementation
uses
System.Classes,
Spring;
constructor TMyClass.Create(const AFileManager: IFileManager);
begin
Guard.CheckNotNull(AFileManager, 'AFileManager');
inherited Create();
Self.FFileManager := AFileManager;
end;
procedure TMyClass.GenerateInvoice(const ACompanyId: System.Integer);
begin
var sTmpFile := Self.GetTempInvoiceFile(ACompanyId);
var fs := TFileStream.Create(sTmpFile, fmCreate);
try
Self.FFileManager.GetComparyWorkbook(ACompanyId, fs);
// Do some operations with stream
finally
fs.Free();
end;
end;
procedure TMyClassTests.Setup();
begin
Self.FMockStream := nil;
Self.FMyClass := TMyClass.Create(Self.FFileManager);
end;
procedure TMyClassTests.TearDown();
begin
Self.FMyClass.Free();
Self.FMockStream.Free();
end;
procedure TMyClassTests.InitMockStream(const AMockFile: string);
begin
Self.FMockStream := TFileStream.Create(AMockFile, fmOpenRead);
end;
procedure TMyClassTests.SetupFileManagerMock();
begin
Self.FFileManager.Setup.Executes(
function(const callInfo: TCallInfo): TValue
begin
callInfo.Args[1].AsType<TStream>.CopyFrom(Self.FMockStream);
end)
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
end;
procedure TMyClassTests.TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
begin
Self.InitMockStream(AMockFile);
Self.SetupFileManagerMock();
Assert.WillNotRaiseAny(
procedure
begin
Self.FMyClass.GenerateInvoice(ACompanyId);
end
);
end;
The issue is that you are using this construct which is redundant:
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
Either pass Args.Any to When or use individual Arg matching on the parameters.
Passing Args.Any causes the mock internally to ignore the individual parameter matching. That causes the temporarily constructed object for the parameter matching to be leaked which is not trivial to be fixed.
Update: I was able to fix the memory leak in develop branch

Interface reference counting in Delphi Supports function

I have class THuman which implements interface ICanTalk.
But whenever I try to check if human can talk, Supports function destroys object instance, despite the reference in the code.
What did I misunderstood?
procedure TForm1.Button1Click(Sender: TObject);
var
Obj:TInterfacedObject;
begin
Obj:=THuman.Create('Great guy');
// if Supports(Obj, ICanTalk) then //Object destroyed here if uncommented
(Obj as ICanTalk).TalkTo(Memo1.Lines);
end;
Implementation
ICanTalk = interface
['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
procedure TalkTo(List:TStrings);
end;
THuman = class(TInterfacedObject, ICanTalk)
private
FName: string;
public
procedure TalkTo(List:TStrings);
property Name:string read FName;
constructor Create(const AName:string);
end;
constructor THuman.Create(const AName: string);
begin
FName:=AName;
end;
procedure THuman.TalkTo(List: TStrings);
begin
List.Add(Name+' says Hello World!');
end;
This is expected. When you read the documentation about the Supports function, you found this:
Warning
With the exception of the overload that checks whether a TClass implements an interface, all the other versions of Supports will extract an interface reference either from an object or from another interface reference, causing the reference count of the underlying object to be incremented, and then will release the interface upon exit (decrementing the reference count). For objects that have a reference count of zero, this will result in the object destruction.
var
Obj: TInterfacedObject;
begin
Obj := TInterfacedObject.Create;
if Supports(Obj, IInterface) then { ... at this point Obj will be freed }
end;
You wrote,
despite the reference in the code(in visible area)
No, there is no reference. You declared Obj as TInterfacedObject (a class instance variable -- not an interface variable), and so there is no reference counting.
If you instead use an interface-typed variable, it will use reference counting:
var
Obj: IInterface;
This behavior really annoyed me. Why did Embarcadero not declare the internal variable as [unsafe]. In the following example, the object is only released with FreeAndNil. Alternatively, you can use TInterfacedPersistent instead of TInterfacedObject. Then you always have to release the object yourself.
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
ICanTalk = interface
['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
procedure TalkTo;
end;
THuman = class(TInterfacedObject, ICanTalk)
public
destructor Destroy; override;
private
FName: string;
public
procedure TalkTo;
end;
procedure THuman.TalkTo;
begin
end;
destructor THuman.Destroy;
begin
inherited;
end;
var
o : THuman;
[unsafe]
intf : IInterface;
begin
try
o := THuman.Create;
Supports(o, ICanTalk, intf);
Intf := nil; //Didn't call destructor cause of [unsafe]!
FreeAndNil(o); //Call destructor!
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Throwing thread in a unit in Delphi

I'm making a unit in which I throw a thread with BeginThread with a variable that is defined in the class.
Code:
unit practica;
interface
uses Windows;
type
TTest = class
private
public
probando: integer;
procedure iniciar_thread;
procedure load_now;
end;
implementation
procedure TTest.load_now;
begin
Sleep(probando);
end;
procedure TTest.iniciar_thread;
begin
BeginThread(nil, 0, #TTest.load_now, nil, 0, PDWORD(0)^);
end;
end.
Form :
procedure TForm1.testClick(Sender: TObject);
test:TTest;
begin
test := TTest.Create();
test.probando := 1000;
test.iniciar_thread;
end;
When compiling get no error, but when you run the function I get this:
Exception EAccessViolation in module test.exe
System Error. Code5
Runtime error 217
As I solve this?
You cannot use a non-static class method as the thread procedure for BeginThread(). Look at the declaration of BeginThread():
type
TThreadFunc = function(Parameter: Pointer): Integer;
function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
var ThreadId: TThreadID): Integer;
As you can see, it is expecting a stand-alone function, not a class method. Even if it did, your class method doesn't even have the correct signature anyway.
Try something more like this instead:
unit practica;
interface
type
TTest = class
private
FThread: Integer;
public
probando: integer;
procedure iniciar_thread;
procedure load_now;
end;
implementation
uses
Windows;
procedure TTest.load_now;
begin
Sleep(probando);
end;
function MyThreadFunc(Parameter: Pointer): Integer;
begin
TTest(Parameter).load_now;
end;
procedure TTest.iniciar_thread;
var
ThreadId: TThreadID;
begin
FThread := BeginThread(nil, 0, MyThreadFunc, Self, 0, ThreadId);
end;
end.
And don't forget to terminate your thread, CloseHandle() the thread handle returned by BeginThread(), and Free() your TTest object when you are done using everything.
Typically, you shouldn't use BeginThread() directly. You should derive a class from TThread instead:
unit practica;
interface
type
TTest = class
public
probando: integer;
procedure iniciar_thread;
end;
implementation
uses
Classes, Windows;
type
TMyThread = class(TThread)
private
FTest: TTest;
protected
procedure Execute; override;
public
constructor Create(ATest: TTest);
end;
constructor TMyThread.Create(ATest: TTest);
begin
inherited Create(False);
FreeOnTerminate := True;
FTest := ATest;
end;
procedure TMyThread.Execute;
begin
Sleep(FTest.probando);
end;
procedure TTest.iniciar_thread;
begin
TMyThread.Create(Self);
end;
end.

How to properly make an interface support iteration?

How can I expose this TList from an interface, as either IEnumerator or IEnumerator<IFungibleTroll>? I am using Delphi XE.
Here's how far I got:
unit FungibleTrollUnit;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics,
Controls, Forms,
Generics.Collections;
type
IFungibleTroll = interface
['{03536137-E3F7-4F9B-B1F5-2C8010A4D019}']
function GetTrollName:String;
function GetTrollRetailPrice:Double;
end;
TFungibleTrolls = class (TInterfacedObject,IEnumerable<IFungibleTroll>)
protected
FTrolls:TList<IFungibleTroll>;
public
// IEnumerable
function GetEnumerator:IEnumerator<IFungibleTroll>;//
// function GetEnumerator:IEnumerator; overload;
// find/search app feature requires searching.
// this
function FindSingleItemByName(aName:String;patternMatch:Boolean):IFungibleTroll;
function FindMultipleItemsByName(aName:String;patternMatch:Boolean):IEnumerable<IFungibleTroll>;
function FindSingleItemByIdentifier(anIdentifer:String):IFungibleTroll;// use internal non-visible identifier to find an app.
constructor Create;
property Trolls:TList<IFungibleTroll> read FTrolls; // implements IEnumerable<IFungibleTroll>;??
private
end;
implementation
{ TFungibleTrolls }
constructor TFungibleTrolls.Create;
begin
FTrolls := TList<IFungibleTroll>.Create;
end;
function TFungibleTrolls.FindMultipleItemsByName(aName: String;
patternMatch: Boolean): IEnumerable<IFungibleTroll>;
begin
end;
function TFungibleTrolls.FindSingleItemByIdentifier(
anIdentifer: String): IFungibleTroll;
begin
end;
function TFungibleTrolls.FindSingleItemByName(aName: String;
patternMatch: Boolean): IFungibleTroll;
begin
end;
function TFungibleTrolls.GetEnumerator: IEnumerator<IFungibleTroll>;
begin
result := FTrolls.GetEnumerator;
end;
//function TFungibleTrolls.GetEnumerator: IEnumerator;
//begin
// result := FTrolls.GetEnumerator; // type IEnumerator<IFungibleTroll> or IEnumerator?
//end;
end.
I get stuck in one of three errors that I can't figure out how to solve:
[DCC Error] FungibleTrollUnit.pas(26): E2252 Method 'GetEnumerator' with identical parameters already exists
-or-
[DCC Error] FungibleTrollUnit.pas(19): E2291 Missing implementation of interface method IEnumerable.GetEnumerator
-or-
[DCC Error] FungibleTrollUnit.pas(19): E2291 Missing implementation of interface method IEnumerable.GetEnumerator
It seems I must declare two forms of GetEnumerator, if I declare TFungibleTrolls to implement IEnumerable, but I can't seem to figure out how to do it, either with overloads, or without overloads, or using a "method resolution clause", like this:
function IEnumerable.GetEnumerator = GetPlainEnumerator; // method resolution clause needed?
function GetEnumerator:IEnumerator<IFungibleTroll>;
function GetPlainEnumerator:IEnumerator;
This probably seems like a pretty basic use of IEnumerable, and making an Interface support iteration, and yet, I'm stuck.
Update: It seems when I try to do this without first declaring a List<T>, I am falling into a crack caused by the fact that IEnumerable<T> inherits from IEnumerable, and yet, instead of a single get enumerator method, my class must provide multiple ones, and because my class is not a generic, it can't "map itself" to IEnumerable's requirements directly unless I use a generic List<T> declaration. Marjan's sample works, when compiled into a project (.dproj+.dpr) but not when built into a package (.dproj+.dpk) and compiled in the IDE. It works fine from the command line, in a package, but not in the IDE, in a package.
Not an answer to your question directly (still working on that), but this is what I did to get an "interfaced enumerator", ie and interfaced class that supports iteration:
IList<T> = interface(IInterface)
[...]
function GetEnumerator: TList<T>.TEnumerator;
function Add(const Value: T): Integer;
end;
type
TBjmInterfacedList<T> = class(TBjmInterfacedObject, IList<T>)
strict private
FList: TList<T>;
function GetEnumerator: TList<T>.TEnumerator;
strict protected
function Add(const Value: T): Integer;
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TBjmInterfacedList<T>.Create;
begin
inherited;
FList := TList<T>.Create;
end;
destructor TBjmInterfacedList<T>.Destroy;
begin
FreeAndNil(FList);
inherited;
end;
function TBjmInterfacedList<T>.GetEnumerator: TList<T>.TEnumerator;
begin
Result := FList.GetEnumerator;
end;
function TBjmInterfacedList<T>.Add(const Value: T): Integer;
begin
Result := FList.Add(Value);
end;
And then you can do stuff like:
ISite = interface(IInterface)
...
end;
ISites = interface(IList<ISite>);
...
end;
var
for Site in Sites do begin
...
end;
with implementing classes like:
TSite = class(TBjmInterfacedObject, ISite)
...
end;
TSites = class(TBjmInterfacedList<ISite>, ISites)
...
end;
Update
Example project source uploaded to
http://www.bjmsoftware.com/delphistuff/stackoverflow/interfacedlist.zip
If you really want to make a class that implements IEnumerable<T>, you can do it like this:
unit uGenericEnumerable;
interface
uses SysUtils, Classes, Generics.Collections;
type TGenericEnumerator<T> = class(TInterfacedObject, IEnumerator, IEnumerator<T>)
private
FList: TList<T>;
FIndex: Integer;
protected
function GenericGetCurrent: T;
public
constructor Create(AList: TList<T>);
procedure Reset;
function MoveNext: Boolean;
function GetCurrent: TObject;
function IEnumerator<T>.GetCurrent = GenericGetCurrent;
property Current: T read GenericGetCurrent;
end;
type TNonGenericEnumerable = class(TInterfacedObject, IEnumerable)
protected
function GetNonGenericEnumerator: IEnumerator; virtual; abstract;
public
function IEnumerable.GetEnumerator = GetNonGenericEnumerator;
end;
type TGenericEnumerable<T> = class(TNonGenericEnumerable, IEnumerable<T>)
private
FList: TList<T>;
public
constructor Create;
destructor Destroy; override;
function GetNonGenericEnumerator: IEnumerator; override;
function GetEnumerator: IEnumerator<T>;
property List: TList<T> read FList;
end;
implementation
{ TGenericEnumerator<T> }
constructor TGenericEnumerator<T>.Create(AList: TList<T>);
begin
inherited Create;
FList := AList;
FIndex := -1;
end;
procedure TGenericEnumerator<T>.Reset;
begin
FIndex := -1;
end;
function TGenericEnumerator<T>.MoveNext: Boolean;
begin
if FIndex < FList.Count then
begin
Inc(FIndex);
Result := FIndex < FList.Count;
end
else
begin
Result := False;
end;
end;
function TGenericEnumerator<T>.GenericGetCurrent: T;
begin
Result := FList[FIndex];
end;
function TGenericEnumerator<T>.GetCurrent: TObject;
begin
// If T has not been constrained to being a class, raise an exception instead of trying to return an object.
raise Exception.Create('Cannot use this as a non-generic enumerator');
// If T has been constrained to being a class, return GenericGetCurrent.
// Result := GenericGetCurrent;
end;
{ TGenericEnumerable<T> }
constructor TGenericEnumerable<T>.Create;
begin
inherited Create;
FList := TList<T>.Create;
end;
destructor TGenericEnumerable<T>.Destroy;
begin
FList.Free;
end;
function TGenericEnumerable<T>.GetEnumerator: IEnumerator<T>;
begin
Result := TGenericEnumerator<T>.Create(FList);
end;
function TGenericEnumerable<T>.GetNonGenericEnumerator: IEnumerator;
begin
Result := GetEnumerator;
end;
end.
Now, your FungibleTrollUnit will look something like this:
unit FungibleTrollUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Generics.Collections,
uGenericEnumerable;
type
IFungibleTroll = interface
['{03536137-E3F7-4F9B-B1F5-2C8010A4D019}']
function GetTrollName:String;
function GetTrollRetailPrice:Double;
end;
IFungibleTrolls = interface(IEnumerable<IFungibleTroll>)
['{090B45FB-2925-4BFC-AE97-5D3F54E1C575}']
function GetTrolls: TList<IFungibleTroll>;
function FindSingleItemByName(aName:String):IFungibleTroll;
function FindMultipleItemsByName(aName:String):IEnumerable<IFungibleTroll>;
property Trolls:TList<IFungibleTroll> read GetTrolls;
end;
TFungibleTrolls = class (TGenericEnumerable<IFungibleTroll>, IFungibleTrolls, IEnumerable<IFungibleTroll>)
public
function GetTrolls: TList<IFungibleTroll>;
function FindSingleItemByName(aName: String): IFungibleTroll;
function FindMultipleItemsByName(aName: String): IEnumerable<IFungibleTroll>;
property Trolls:TList<IFungibleTroll> read GetTrolls;
private
end;
implementation
uses StrUtils;
{ TFungibleTrolls }
function TFungibleTrolls.GetTrolls: TList<IFungibleTroll>;
begin
Result := List;
end;
function TFungibleTrolls.FindMultipleItemsByName(aName: String): IEnumerable<IFungibleTroll>;
var FilteredTrolls: TGenericEnumerable<IFungibleTroll>;
var Troll: IFungibleTroll;
begin
FilteredTrolls := TGenericEnumerable<IFungibleTroll>.Create;
for Troll in List do
begin
if Troll.GetTrollName = aName then
FilteredTrolls.List.Add(Troll);
end;
Result := IEnumerable<IFungibleTroll>(FilteredTrolls);
end;
function TFungibleTrolls.FindSingleItemByName(aName: String): IFungibleTroll;
var Troll: IFungibleTroll;
begin
Result := nil;
for Troll in List do
begin
if Troll.GetTrollName = aName then
Result := Troll;
break;
end;
end;
end.
Note that the implementation of IEnumerable does not work, but IEnumerable<T> does work.
This is because, unless T is constrained, you cannot convert a T to a TObject.
If T is a string or an integer, for example, then the IEnumerator does not have a TObject to return.
If T is constrained to be a class, you can get the implementation of IEnumerable to work.
If you constrain T to be an IInterface, you could get IEnumerable to work (Delphi 2010 and after (cast GenericGetCurrent to an IInterface, then to a TObject)), but I doubt if that is an advantage.
I would rather use it without the constraints, and do without being able to iterate everything as TObjects.
TGenericEnumerable<T>.GetEnumerator can't use FList.GetEnumerator because TList<T>.GetEnumerator does not return an IEnumerator<T>
Even though you can implement TGenericEnumerable<T> without defining TNonGenericEnumerable, like this:
type TGenericEnumerable<T> = class(TInterfacedObject, IEnumerable, IEnumerable<T>)
private
FList: TList<T>;
protected
function GenericGetEnumerator: IEnumerator<T>;
public
constructor Create;
destructor Destroy; override;
function GetEnumerator: IEnumerator;
function IEnumerable<T>.GetEnumerator = GenericGetEnumerator;
property List: TList<T> read FList;
end;
the disadvantage of doing this is that if you try to iterate using the TGenericEnumerable<T> object, rather than the interface, GetEnumerator will be non-generic and you can only iterate TObjects.
Usual caveats about mixing references to an interface and its underlying object. If you refer to an object both as an object type and as an IEnumerable<....>, then when the interface reference count goes back to zero, the object will be freed even if you still have a reference to it as an object. (That's why I defined IFungibleTrolls; so that I could refer to the collection as an interface).
You can make alternative implementations of TGenericEnumerator<T>; for example, it could contain a reference to a list, an index and a selection predicate, which are all supplied in the constructor.

Save/Load TObject(TPersistent) to XML

everybody.
I'm trying to save my class:
TA= class(TPersistent)
private
FItems: TObjectList<TB>;
FOnChanged: TNotifyEvent;
public
constructor Create;
destructor Destroy; override;
...
procedure Delete(Index: Integer);
procedure Clear;
procedure SaveToFile(const FileName: string);
...
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
to file using the following code:
var
Storage: TJvAppXMLFileStorage;
begin
Storage := TJvAppXMLFileStorage.Create(nil);
try
Storage.WritePersistent('', Self);
Storage.Xml.SaveToFile(FileName);
finally
Storage.Free;
end;
but file is always empty.
What am I doing the wrong way?
It looks like TJvCustomAppStorage does not support Generics in properties. The code makes no use of extended RTTI and the call to TJvCustomAppStorage.GetPropCount returns 0.
This leads to another question - Are there Delphi object serialization libraries with support for Generics??
My test code:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, Generics.Collections, JvAppXmlStorage;
type
TA = class(TPersistent)
private
FItems: TObjectList<TPersistent>;
public
constructor Create;
published
property
Items: TObjectList < TPersistent > read FItems write FItems;
end;
{ TA }
constructor TA.Create;
begin
FItems := TObjectList<TPersistent>.Create;
end;
var
Storage: TJvAppXMLFileStorage;
Test: TA;
begin
Test := TA.Create;
Test.Items.Add(TPersistent.Create);
Storage := TJvAppXMLFileStorage.Create(nil);
try
Storage.WritePersistent('', Test);
WriteLn(Storage.Xml.SaveToString);
ReadLn;
finally
Storage.Free;
end;
end.
I'm not sure but if TJvAppXMLFileStorage uses RTTI then I think you have to publish the properties that you want to save / load.

Resources