Solved

Creating class objects from an xml document

Posted on 2008-10-23
24
1,267 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:2266180
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 37

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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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 37

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:2266180
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 37

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:2266180
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
 
LVL 28

Expert Comment

by:2266180
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:2266180
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 37

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:2266180
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:2266180
2266180 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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…

856 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