Solved

Creating class objects from an xml document

Posted on 2008-10-23
24
1,258 Views
Last Modified: 2012-08-13
I am interested to see if anyone knows of a generic solution to creating objects from an xml document.
I have a base object which all my objects inherit from, and currently they can all save themselves as xml with their class type as a node heading, ie TMyObject.
What I want is the ability to go backwards now and create the objects from the xml document, but obviously you cannot create an object directly just from a string. Anyone got an optional idea on a method or techinique I could use to do this?
0
Comment
Question by:mikelittlewood
  • 7
  • 7
  • 5
  • +2
24 Comments
 
LVL 28

Expert Comment

by:ciuly
ID: 22785805
why not use the SOAP api? save objects to xml and load them back. sure, the framework is too big for what you want, but it does what you want, it's there in delphi so use it.
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 22786638
creating objects from a string =

read string from a file
read object from string

or read form from string that's read from dfm file

i'm still wondering when Delphi will put the .dfm in XML format
0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 22786873
I'm assuming Ciuly that you need to have the objects created to load them?
I want an xml file to be able to create the correct object it should be loading as well as loading it.
0
 
LVL 1

Expert Comment

by:chgtj001
ID: 22787000
XML Data Binding can be used to generate a class from a xml file. You can create object by using NewFoo,LoadFoo methods provided by the class. It's quite easy to bind a object with xml. The limitation is performance. And you can not use your base object.
0
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 42 total points
ID: 22787203
what about something like this

you would have to implement  following yourself ...

constructor CreateFromXML(aFileName: string);

Basically you would call it like

type
  RXMLObject = record
    xName: string;
    xClass: TDBRootClass;
  end;

const
  MaxXMLObjects = 2;
  XMLObjects: Array[1..MaxXMLObjects] of RXMLObject =
  ((xName: '*'; xClass: TDBROOT),
   (xName: 'FORM'; xClass: TForm),
   (xName: 'TTestObject'; xClass: TTestObject));

function ClassTypeFromFile(aFileName: string): TDBRootClass;
var I: Integer;
  ObjName: string;
begin
  Result := TDBRoot;
  // Open file and look for the Object designator
  // AssignFile(F, ...);
  //    I assume you would know how to do this
  //   ObjName := ReadLn(F);
  // finally
  //   CloseFile(F);
  // end;
  for I := 1 to MaxXmlObjects do
    if SameText(ObjName, XmlObjects[I].xClass) then
    begin
      Result := XMLObjects[I];
      Break;
    end;
end;

var aObject: TDBRoot;

  aObject := DBRootStorage(ClassTypeFromFile(aFileName), aFileName);

aObject.CallProc;

type

  TDbRoot = class(TObject)

  public

    constructor CreateFromXML(aFileName: string); virtual;

  end;
 

  TDBRootClass = class of TDBRoot;
 

  TDBRootStorageItem = class(TCollectionItem)

  private

    fDBRoot: TDBRoot;

    fDBRootClassName: string;

    fFileName: string;

  public

    property DBRoot: TDBRoot read fDBRoot write fDBRoot;

    property DBRootClassName: string read fDBRootClassName write fDBRootClassName;

  end;
 

  TDBRootStorage = class(TCollection)

  public

    function Add(DBRootClass: TDBRootClass; aFileName: string): TDBRoot;

  end;
 

function DBRootStorage(DBRootClass: TDBRootClass; aFileName: string): TDBRoot;
 

implementation
 

var

  impDBRootStorage: TDBRootStorage;
 

function DBRootStorage(DBRootClass: TDBRootClass; aFileName: string): TDBRoot;

begin

  if impDBRootStorage = nil then

    impDBRootStorage := TDBRootStorage.Create(TDBRootStorageItem);

  Result := impDBRootStorage.Add(DBRootClass, aFileName);

end;
 

function TDBRootStorage.Add(DBRootClass: TDBRootClass; aFileName: string): TDBRoot;

var I: Integer;

  item: TDBRootStorageItem;

begin

  Result := nil;

  for I := Count-1 downto 0 do

    if SameText(TDBRootStorageItem(Items[I]).DBRootClassName, DBRootClass.ClassName) and 

      SameText(TDBRootStorageItem(Items[I]).FileName, aFileName) then 

        Delete(I);

  if Result = nil then

  begin

    item := TDBRootStorageItem(inherited Add);

    item.DBRootClassName := DBRootClass.ClassName;

    item.Filename := aFileName;

    item.DBRoot := DBRootClass.CreateFromXml(aFileName);

    Result := item.DBRoot;

  end;

end;

Open in new window

0
 
LVL 28

Expert Comment

by:ciuly
ID: 22787640
actually geert, for this kind of approach you would use a solution like the one provided by the tpersitent delphi streaming mechanism: registerclass ;) (which will add teh class to a list).

>> I'm assuming Ciuly that you need to have the objects created to load them?

no. you never used soap? then look around here: http://delphi.about.com/od/webservices/Developing_Web_Services_with_Delphi.htm
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 22788533
ciuly,
i'm an "old" fashioned programmer :)

i'll go read your link too now ;)
0
 
LVL 28

Expert Comment

by:ciuly
ID: 22788888
I wrote my own framework for this (serialization) using RTTI. supports both xml and binary and is extendable to any format. I also made about 90% of it usable from FPC (free pascal). but it's for my own use only for now, as many other usefull stuff. I was planning to come up with some kind of package and sell it for a few bucks, but people don't seem to be interested. obviously there are free alternatives and that's probably the reason why.
what I want to say is that I almost wanted to make it available for free in this questions, but when I saw that it's only 125 points ... well, I changed my mind :D
so, long story short, would any of you guys pay say ... 5$ for something like this? or less? or more?
(getting a little off-topic, I know :P )
0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 22811988
I'll keep this question open for now and let you know what road I go down.
0
 
LVL 3

Expert Comment

by:huferry
ID: 22937617
Is it a native Delphi or Delphi .Net?
In .Net you can use the standard XmlSerializer on System.Xml.Serialization.
0
 
LVL 3

Assisted Solution

by:huferry
huferry earned 41 total points
ID: 22937662
There is a possibility though... with limitation:
- the object should be a descendant of TPersistent
- you should reigster the class somewhere in the initialization so that you can create it from string. See in help: procedure RegisterClass(AClass: TPersistentClass)
- I think all the classes should have the same way of creation, the most common is a constructor without arguments.
- When you're about to create the object, you can use function FindClass(const ClassName: string): TPersistentClass. This will only work if you register the class first using RegisterClass.
- those functions can be found in unit Classes.
// example
 

type
 

  TMyObject = class(TPersistent)

  ..

  class function CreateByName(AClassName: string): TMyObject;

  end;
 

  TBook = class(TMyObject)

  ..

  end;
 

  TKeyboard = class(TMyObject)

  ..

  end;
 

..

..

function TMyObject.CreateByName(AClassName: string): TMyObject;

var

  myObjClass: TPersistentClass;

  myObj: TPersistent;

begin

  Result := nil;

  myObjClass := FindClass('TKeyboard');

  if Assigned(myObjClass) then

  begin

    myObj := myObjClass.Create;

    if myObj is TMyObject then

      Result := myObj as TMyObject

    else

      myObj.Free;

  end;

end;
 

initialization

  RegisterClass(TBook);

  RegisterClass(TKeyboard);

end;
 

... in some other unit...
 

var

  obj: TMyObject;

begin

  obj := TMyObject.CreateByName('TKeyboard');

  if Assigned(obj) then

  begin

    ..

    ..

  end;

end;

Open in new window

0
 
LVL 3

Expert Comment

by:huferry
ID: 22937702
On another tought, I like this solution more...
it's less dependent on TPersistent, but still, you have to register the classes...


type

  TMyObject = class;
 

  TMyObjectClass = class of TMyObject;
 

  TMyObjectClassArray = array of TMyObjectClass;
 

  TMyObject = class

  private

    class var FClasses: TMyObjectClassArray;

  public

    class procedure RegisterClass(AClass: TMyObjectClass); static;

    class function CreateByName(AClassName: string): TMyObject; static;

  end;
 

  TBook = class(TMyObject)

  end;
 

  TKeyboard = class(TMyObject)

  end;
 

implementation
 

uses

  SysUtils,

  StrUtils;
 

{ TMyObject }
 

class function TMyObject.CreateByName(AClassName: string): TMyObject;

var

  MyClass: TMyObjectClass;

begin

  Result := nil;

  for MyClass in FClasses do

  begin

    if SameText(AClassName, MyClass.ClassName) then

    begin

      Result := MyClass.Create;

      Break;

    end;

  end;

end;
 

class procedure TMyObject.RegisterClass(AClass: TMyObjectClass);

begin

  SetLength(FClasses, Length(FClasses)+1);

  FClasses[Length(FClasses)-1] := AClass;

end;
 

initialization

  TMyObject.RegisterClass(TBook);

  TMyObject.RegisterClass(TKeyboard);
 

end.

Open in new window

0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 28

Expert Comment

by:ciuly
ID: 22939083
did you try serializing that? you'll notice it doens't work. because in order to use serialization you must enable rtti fro that specific class and it's descendants. that is done by usiong the $M switch, which is off by default (RTTI gives some overhead). TPersistent has it already that's why people suggest extending from there.
0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 22950282
So would the first example by huferry be the right way to do it if it has to depend on TPersistent?
0
 
LVL 28

Expert Comment

by:ciuly
ID: 22950773
yes, it is one way to do it. but that code only handles the registration and creation, not loading. for that you will still need to use the stream's read/writecomponent methods (if going with delphi's component streaming mechanism) or RTTI if going for something xml, as you want it.
there are many sites that deal with delphi and rtti on the net, all you need to do is google :)
http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm
http://delphi.about.com/od/oopindelphi/a/delphirtti.htm
just to name a couple.
0
 
LVL 3

Expert Comment

by:huferry
ID: 22950903
well, you don't have actually to depend on TPersistent. After you are able to create an instance of a descendant of TMyObject like.. in my example TBook, you can pass the XML to the object to be deserialize.

I include a rough example how to do this... I hope you'll get  the idea...
type

  

  TMyObject = class

  protected

    procedure DeserializeData(AXMLNode: IXMLNode); virtual; abstract;

    ...

  public

    class function Deserialize(AXml: string): TMyObject;

  end;
 

  TBook = class(TMyObject)

  private

    FTitle: string;

  protected

   procedure DeserializeData(AXMLNode: IXMLNode); override;

   ..

   

  end;
 

..

..

class function TMyObject.Deserialize(AXml: string): TMyObject;

var

  MyClassName: string;

  MyNode: IXmlNode;

begin

  // get the class name some how

  MyClassName := GetClassName(AXml);
 

  // use the method of the previous example

  Result := CreateByName(MyClassName);
 

  if Assigned(Result) then

  begin

    // convert it to xml node somehow

    MyNode := GetNode(AXml);

    Result.DeserializeData(MyNode);

  end;

end;
 

...
 

procedure TBook.DeserializeData(AXmlNode: IXmlNode); 

begin

  inherited;

  // get the value somehow...

  FTitle := GetPropertyValue(AXmlNode, 'Title');

end;

Open in new window

0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 22951164
now there is a sample with a lot of somehow
i'm really intrested in seeing those somehows translated to code
...
0
 
LVL 28

Expert Comment

by:ciuly
ID: 22952433
>> i'm really intrested in seeing those somehows translated to code

that's what RTTI is for, in case I wasn't so obvious the last time.
0
 
LVL 3

Expert Comment

by:huferry
ID: 22957937
here comes the some hows...
Unzip the attached file.. rename .jpg into .zip.
Unzip again the file, then you'll have the complete program.
unit uMyClass;
 

interface
 

uses

  XmlDoc,

  XmlIntf;
 

type
 

  TXmlProperty = class

  private

    FNode: IXMLNode;

  public

    constructor Create(ANode: IXmlNode);

    function GetClassName: string;

    function GetChildValue(AChildName: string): string;

  end;
 

  TMyClass = class;
 

  TMyClassClass = class of TMyClass;
 

  TMyClassClassArray = array of TMyClassClass;
 

  TMyClass = class

  private

    class var FClasses: TMyClassClassArray;

    class function CreateByName(AClassName: string): TMyClass; static;

  protected

    procedure DeserializeData(AXmlProp: TXmlProperty); virtual; abstract;

  public

    class procedure RegisterClass(AClass: TMyClassClass); static;

    class function Deserialize(ANode: IXMLNode): TMyClass; overload; static;

    class function Deserialize(AXml: string): TMyClass; overload; static;

  end;
 

  TBook = class(TMyClass)

  private

    FAuthor: string;

    FTitle: string;

  protected

    procedure DeserializeData(AXmlProp: TXmlProperty); override;

  public

    property Title: string read FTitle;

    property Author: string read FAuthor;

  end;
 

implementation
 

{ TMyClass }
 

class function TMyClass.CreateByName(AClassName: string): TMyClass;

var

  MyClass: TMyClassClass;

begin

  Result := nil;

  for MyClass in FClasses do

  begin

    if MyClass.ClassName = AClassName then

    begin

      Result := MyClass.Create;

      Break;

    end;

  end;

end;
 

class function TMyClass.Deserialize(ANode: IXMLNode): TMyClass;

var

  Prop: TXmlProperty;

begin

  Result := nil;

  Prop := TXmlProperty.Create(ANode);

  try

    Result := CreateByName(Prop.GetClassName);

    if Assigned(Result) then

      Result.DeserializeData(Prop);

  finally

    Prop.Free;

  end;

end;
 

class function TMyClass.Deserialize(AXml: string): TMyClass;

var

  XmlDoc: IXMLDocument;

begin

  Result := nil;

  XmlDoc := TXMLDocument.Create(nil);

  XmlDoc.XML.Text := AXml;

  XmlDoc.Active := True;

  Result := Deserialize(XmlDoc.ChildNodes.First);

end;
 

class procedure TMyClass.RegisterClass(AClass: TMyClassClass);

begin

  SetLength(FClasses, Length(FClasses)+1);

  FClasses[Length(FClasses)-1] := AClass;

end;
 

{ TXmlProperty }
 

constructor TXmlProperty.Create(ANode: IXmlNode);

begin

  inherited Create;

  FNode := ANode;

end;
 

function TXmlProperty.GetChildValue(AChildName: string): string;

begin

  Result := FNode.ChildValues[AChildName];

end;
 

function TXmlProperty.GetClassName: string;

begin

  Result := FNode.NodeName;

end;
 

{ TBook }
 

procedure TBook.DeserializeData(AXmlProp: TXmlProperty);

begin

  FAuthor := AXmlProp.GetChildValue('Author');

  FTitle := AXmlProp.GetChildValue('Title');

end;
 

initialization

  TMyClass.RegisterClass(TBook);
 

end.

Open in new window

xml-serial.zip
0
 
LVL 3

Expert Comment

by:huferry
ID: 22959126
RTTI works only with published read/write properties. Sometime you also want to serialize some private members or read-only properties.
0
 
LVL 28

Assisted Solution

by:ciuly
ciuly earned 42 total points
ID: 22960087
that's what the delphi streaming mechanism does, no? you can define your own stuff to be serialized/deserialized.
here is a simple (I hope) article on the subject: http://www.delphi3000.com/articles/article_2969.asp?SK=

there is no sense in reinventig the wheel. I would say that SOAP is what the asker is looking for (since it's xml). or delphi's streaming mechanism, but that's in another format.
if both are too complex or unacceptable, then the easy way out is RTTI (which underlies both methods above). if this is not enough (as huferry mentiones, and which happens in rare cases) then beside this RTTI part (which covers most aspects), one can use the suggestions of huferry.
0
 
LVL 3

Expert Comment

by:huferry
ID: 22985488
I found this:

http://www.simdesign.nl/xml.html

you can store,read and create any TPresistent to/from XML.
The component is not free though.
0
 
LVL 15

Author Comment

by:mikelittlewood
ID: 24501066
Sorry been a while since I saw this thread, forgot.
Going to spend a little time reading what has been written.

And sorry huferry, I should have said it was standard delphi not .net
0
 
LVL 15

Author Closing Comment

by:mikelittlewood
ID: 31509121
This got me started.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now