Egyre többször látok a prog.hu-n olyan Win32 natív fejlesztéssel kapcsolatos kérdéseket, hogy XML-be szeretnének eltárolni egyes állapotértékeket, majd ezalapján visszaállítani azokat. Megjegyzem, nagyon szellemes megoldások vannak erre, mint pl. az XML DOM közvetlen manipulálása az XMLDocument osztályon keresztül, vagy sima karakterláncok konkatenációja, esetleg az új Win32-es StringBuilder osztály használata, de személy szerint ezek a módszerek nekem nagyon fapadosnak, illetve körülményesnek tűnnek. Sőt, még ha mindehhez hozzáveszem a Delphi beépített XML Data Binding varázslóját, még akkor sem kielégítő az eredmény. Arról nem is szólva, hogy ez utóbbi esetben totálisan testreszabhatatlan a generált kód, pl. egyesével kell kiegészíteni minden metódus implementációját annak ellenőrzésével, hogy az adott node létezik-e, különben egy szép kivételt fog dobni az alkalmazás, ami nem is lenne gond abban az esetben, ha az XML szerkezete nem változna túl sűrűn az idők folyamán.

A következőkben bemutatom az én megoldásomat, ami nem csinál mást, mint kihasználja azt, ahogy a Delphi becsomagolja SOAP XML formátumba az objektumokat a saját webservice megoldásaihoz. Természetesen ez a módszer csak azon objektumokon fog működni, melyek RTTI információkkal el vannak látva, sőt a TRemotable osztályból kell származzanak. Hangsúly az RTTI információn, ugyanis ezalapján az objektumok published tagjai simán lekérdezhetőek, s pontosan emiatt a teljes objektumgráf szerializálhatóvá válik.

Hogyan?

Először is készítsünk egy egyszerű kis osztályt, ami a TRemotable osztályból származik (InvokeRegistry unit). Megjegyzendő, hogy én ezt még Delphi 2006-al csináltam, így nincsenek generikusok, melyekkel sokkal szebben meglehetne oldani néhány dolgot.

unit Employee;

interface

uses
  SysUtils, { Contnrs, } InvokeRegistry;

type
  TEmployee = class;

  TGender = (geMale, geFemale);

  TEmployeeArray = array of TEmployee;

  TEmployee = class(TRemotable)
  private
    FCreatedOn    : TDateTime;
    FName         : string;
    FGender       : TGender;
    FSalary       : Currency;
    FTag          : Variant;
    FEmployeeArray: TEmployeeArray;
    // FObjectList: TObjectList;
  public
    constructor Create(const Name: string; Gender: TGender;
      const Salary: Currency; const Tag: Variant); reintroduce;
    destructor Destroy; override;

    procedure AddEmployee(Employee: TEmployee);
  published
    property CreatedOn    : TDateTime       read FCreatedOn      write FCreatedOn;
    property Name         : string          read FName           write FName;
    property Gender       : TGender         read FGender         write FGender;
    property Salary       : Currency        read FSalary         write FSalary;
    property Tag          : Variant         read FTag            write FTag;
    property EmployeeArray: TEmployeeArray  read FEmployeeArray  write FEmployeeArray;

    // property ObjectList: TObjectList read FObjectList write FObjectList;
  end;

implementation

//------------------------------------------------------------------------------
// hozzáad egy alkalmazottat a tömbhöz
//
procedure TEmployee.AddEmployee(Employee: TEmployee);
var
  I: Integer;
begin
  // FObjectList.Add(Employee);

  I := Length(FEmployeeArray);
  SetLength(FEmployeeArray, I + 1);
  FEmployeeArray[I] := Employee;
end;

//------------------------------------------------------------------------------
// inicializálja az alkalmazott tulajdonságait
//
constructor TEmployee.Create(const Name: string;
  Gender: TGender; const Salary: Currency; const Tag: Variant);
begin
  // FObjectList := TObjectList.Create;

  FCreatedOn := Now;
  FName      := Name;
  FGender    := Gender;
  FSalary    := Salary;
  FTag       := Tag;
end;

//------------------------------------------------------------------------------
// a tömbben lévő alkamazottakat megsemmisíti
//
destructor TEmployee.Destroy;
var
  Employee: TEmployee;
begin
  for Employee in EmployeeArray do
    Employee.Free;

  // FObjectList.Free;

  inherited;
end;

end.

Ez az egyszerű kis osztály tárolja egy alkalmazott néhány adatát. Látható, hogy kikommenteztem a TObjectList típusú mezőt és az ahhoz tartozó kódot, mivel a beépített konverter osztály (TSOAPDomConv) nem ismeri fel a lista típusú objektumokat, így azokat is tulajdonságaik alapján akarja szerializálni. Ezt elkerülendő, használhatunk dinamikus tömböket. Most rajzoljunk egy Serializer-t, ami képes lesz ennek az osztálynak egy példányát oda-vissza szerializálni:

unit XmlSerializer;

interface

uses
  SysUtils, Forms, ActiveX,
  InvokeRegistry, OPToSOAPDomConv, XmlDoc, XmlIntf, XmlDom;

type
  TXmlSerializer = class
  strict private
    FObjConverter : IObjConverter;
    FXmlNamespace : string;
    FXmlRootNode  : string;
    FXmlObjectNode: string;
  protected
    function _Deserialize(DeserializedObjectType: TClass;
      const Xml: string; IsFileName: Boolean): TObject;
  public
    function Serialize(Obj: TObject): string; overload;
    function Serialize(Obj: TObject; const XmlFileName: string): string; overload;

    function Deserialize(DeserializedObjectType: TClass;
      const XmlContent: string): TObject;      
    function DeserializeFromFile(DeserializedObjectType: TClass;
      const XmlFileName: string): TObject;

    property Converter    : IObjConverter read FObjConverter  write FObjConverter;
    property XmlNamespace : string        read FXmlNamespace  write FXmlNamespace;
    property XmlRootNode  : string        read FXmlRootNode   write FXmlRootNode;
    property XmlObjectNode: string        read FXmlObjectNode write FXmlObjectNode;
  end;

implementation

//------------------------------------------------------------------------------
// létrehoz egy objkektum-példányt XML-ből
//
function TXmlSerializer._Deserialize(DeserializedObjectType: TClass;
  const Xml: string; IsFileName: Boolean): TObject;
var
  XmlDoc  : TXMLDocument;
  Conv    : IObjConverter;
  RootNode: IXMLNode;
begin
  Result := nil;
  
  XmlDoc := TXMLDocument.Create(Application);
  try
    if IsFileName then
      XmlDoc.LoadFromFile(Xml)
    else
      XmlDoc.XML.Text := Xml;

    XmlDoc.Active := True;

    // XML ellenőrzése
    RootNode := XmlDoc.DocumentElement;
    if not Assigned(RootNode) or (RootNode.ChildNodes.Count = 0) then
      raise Exception.Create('Invalid XML format.');       
      
    // konverter
    if Assigned(Converter) then
      Conv := Converter
    else
      Conv := TSOAPDomConv.Create(nil) as IObjConverter;

    RootNode := XmlDoc.DocumentElement.ChildNodes[0];

    // objektum létrehozása
    Result := DeserializedObjectType.Create;
    try
      Conv.InitObjectFromSOAP(Result, RootNode, RootNode);
    except
      FreeAndNil(Result);
      raise;
    end;
  finally
    XmlDoc.Free;
  end;
end;

//------------------------------------------------------------------------------
// létrehoz egy objkektum-példányt XML tartalomból
//
function TXmlSerializer.Deserialize(DeserializedObjectType: TClass;
  const XmlContent: string): TObject;
begin
  Result := _Deserialize(DeserializedObjectType, XmlContent, False);
end;

//------------------------------------------------------------------------------
// létrehoz egy objkektum-példányt XML fájlból
//
function TXmlSerializer.DeserializeFromFile(DeserializedObjectType: TClass;
  const XmlFileName: string): TObject;
begin
  Result := _Deserialize(DeserializedObjectType, XmlFileName, True);
end;

//------------------------------------------------------------------------------
// szerializálja egy objektum published tagjait egy XML fájlba
//
function TXmlSerializer.Serialize(Obj: TObject;
  const XmlFileName: string): string;
var
  RefId      : WideString;
  XmlDoc     : TXMLDocument;
  RootNode   : IXMLNode;
  Conv       : IObjConverter;
  XNamespace : string;
  XRootNode  : string;
  XObjectNode: string;
begin
  Result := EmptyStr;

  XmlDoc := TXMLDocument.Create(Application);
  try
    XmlDoc.Active  := True;
    XmlDoc.Options := XmlDoc.Options + [doNodeAutoIndent];

    // konverter
    if Assigned(Converter) then
      Conv := Converter
    else
      Conv := TSOAPDomConv.Create(nil) as IObjConverter;

    // XML névtér
    if XmlNamespace = EmptyStr then
      XNamespace := SXMLNamespaceURI
    else
      XNamespace := XmlNamespace;

    // gyökérelem
    if XRootNode = EmptyStr then
      XRootNode := 'Root'
    else
      XRootNode := XmlRootNode;

    RootNode := XmlDoc.AddChild(XRootNode);
      
    // az objektumot leíró csomópont az XML-ben
    if XmlObjectNode = EmptyStr then
      XObjectNode := Obj.ClassName
    else
      XObjectNode := XmlObjectNode;

    // szerializáció SOAP XML formátumba
    Conv.ObjInstanceToSOAP(Obj,
      RootNode, RootNode, XObjectNode, XNamespace, [], RefId);
        
    Result := XmlDoc.XML.Text;

    // mentés fájlba
    if XmlFileName <> EmptyStr then
      XmlDoc.SaveToFile(XmlFileName);
  finally
    XmlDoc.Free;
  end;
end;

//------------------------------------------------------------------------------
// szerializálja egy objektum published tagjait XML-be
//
function TXmlSerializer.Serialize(Obj: TObject): string;
begin
  Result:= Serialize(Obj, EmptyStr);
end;

end.

Ennyi az egész. Nem is magyaráznám tovább, mert jól látszik szerintem a lényeg. Teszt:

program Serializer_Test;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Forms,
  ActiveX,
  Variants,
  TypInfo,
  Employee in 'Employee.pas',
  XmlSerializer in 'XmlSerializer.pas';

//------------------------------------------------------------------------------
// egy felsorolás típusú érték nevének lekérdezése az RTTI információk alapján
//
function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
var
  P: PShortString;
begin
  P := @GetTypeData(GetTypeData(TypeInfo).BaseType^).NameList;

  while Value <> 0 do
  begin
    Inc(Integer(P), Length(P^) + 1);
    Dec(Value);
  end;

  Result := P^;
end;

const
  XmlFileName = 'Temp.xml';
var
  Employee : TEmployee;
  Employee_: TEmployee;
begin
  ReportMemoryLeaksOnShutdown := True;

  CoInitialize(nil);

  with TXmlSerializer.Create do
    try
      // szerializáljuk az objektumot SOAP XML formátumba
      Employee := TEmployee.Create('AAAA AAAAAA', geFemale, 10000, Null);
      try
        Employee.AddEmployee(
          TEmployee.Create('BBB BBBBB', geMale  , 100000, 'Variant type'));
        Employee.AddEmployee(
          TEmployee.Create('CCC CCCCC', geFemale, 1000000, 10.5));

        WriteLn(Serialize(Employee, XmlFileName));
      finally
        Employee.Free;
      end;

      // deszerializáljuk az XML-t egy objektum példányba
      Employee := TEmployee(
        DeserializeFromFile(TEmployee, XmlFileName));
      try
        if Assigned(Employee) then
        begin
          WriteLn('CreatedOn: ', DateTimeToStr(Employee.CreatedOn));
          WriteLn('Name     : ', Employee.Name);
          WriteLn('Gender   : ', GetEnumName(TypeInfo(TGender), Ord(Employee.Gender)));
          WriteLn('Salary   : ', Employee.Salary);
          WriteLn('Tag      : ', VarToStrDef(Employee.Tag, 'NULL'));
          WriteLn;

          for Employee_ in Employee.EmployeeArray do
          begin
            WriteLn(#9'CreatedOn: ', DateTimeToStr(Employee_.CreatedOn));
            WriteLn(#9'Name     : ', Employee_.Name);
            WriteLn(#9'Gender   : ', GetEnumName(TypeInfo(TGender), Ord(Employee_.Gender)));
            WriteLn(#9'Salary   : ', Employee_.Salary);
            WriteLn(#9'Tag      : ', VarToStrDef(Employee_.Tag, EmptyStr));
            WriteLn;
          end;
        end;
      finally
        Employee.Free;
      end;
    finally
      Free;
    end;

  CoUninitialize;

  ReadLn;
end.

Az eredmény (Temp.xml):

<Root xmlns:NS1="http://www.w3.org/2000/xmlns/" xmlns:NS2="urn:Employee" xmlns:N=""
  S3="http://www.w3.org/2001/XMLSchema" xmlns:NS4="http://schemas.xmlsoap.org/soap/encoding/">
  <NS1:TEmployee type="NS2:TEmployee">
    <CreatedOn type="NS3:dateTime">2008-11-24T13:44:35.748+01:00</CreatedOn>
    <Name type="NS3:string">AAAA AAAAAA</Name>
    <Gender type="NS2:TGender">geFemale</Gender>
    <Salary type="NS3:double">10000</Salary>
    <Tag nil="true"/>
    <EmployeeArray type="NS4:Array" NS4:arrayType="NS2:TEmployee[2]">
      <item type="NS2:TEmployee">
        <CreatedOn type="NS3:dateTime">2008-11-24T13:44:35.748+01:00</CreatedOn>

        <Name type="NS3:string">BBB BBBBB</Name>
        <Gender type="NS2:TGender">geMale</Gender>
        <Salary type="NS3:double">100000</Salary>
        <Tag type="NS3:string">Variant type</Tag>
        <EmployeeArray type="NS4:Array" NS4:arrayType="NS2:TEmployee[0]"/>
      </item>
      <item type="NS2:TEmployee">
        <CreatedOn type="NS3:dateTime">2008-11-24T13:44:35.748+01:00</CreatedOn>

        <Name type="NS3:string">CCC CCCCC</Name>
        <Gender type="NS2:TGender">geFemale</Gender>
        <Salary type="NS3:double">1000000</Salary>
        <Tag type="NS3:double">10,5</Tag>
        <EmployeeArray type="NS4:Array" NS4:arrayType="NS2:TEmployee[0]"/>
      </item>
    </EmployeeArray>
  </NS1:TEmployee>
</Root>

CreatedOn: 2008.11.24. 13:44:35
Name     : AAAA AAAAAA
Gender   : geFemale
Salary   :  1.00000000000000E+0004
Tag      : NULL

   CreatedOn: 2008.11.24. 13:44:35
   Name     : BBB BBBBB
   Gender   : geMale
   Salary   :  1.00000000000000E+0005
   Tag      : Variant type

   CreatedOn: 2008.11.24. 13:44:35
   Name     : CCC CCCCC
   Gender   : geFemale
   Salary   :  1.00000000000000E+0006
   Tag      : 10,5

Mint látható, tökéletesen használható a módszer elmenteni egy teljes objektumgráf állapotinformációit, majd visszaállítani azt. Vannak persze korlátjai a dolognak, mert nem minden adattípus támogatott (mint pl. lista származékok), de pontosan ezért készíthetünk saját konvertert is, amit megadva az XmlSerializernek (Converter property), a továbbiakban azzal fog dolgozni a beépített TSOAPDomConv (OPToSOAPDomConv unit) helyett. Szerintem ezzel rengeteg időt és fáradságot meglehet spórolni, mivel nekünk csak osztályokat kell gyártanunk, minden mást a Serializer elvégez helyettünk. A forráskód innen letölthető. Mégegy apróság, ne ilyedjünk meg, ha futtatás után egy szép memory leak-re figyelmeztető ablak jelenik meg:

Ez bizony a beépített DateTimeToStr függvény sara... LOL

A cooliris egy böngésző plugin, mely lehetővé teszi képek gyors és látványos keresését a weben:

A plugin ingyen letölthető innen.

(October 27, 2008) At Microsoft PDC2008 in Los Angeles, California, RemObjects Software and Embarcadero Technologies have announced that they will join forces to develop and release Delphi Prism, a next generation development suite for .NET and Mono, based on RemObjects Software's award-winning Oxygene compiler technology.

Delphi Prism will replace both Delphi for .NET and the existing Oxygene product, allowing the two companies to work together on providing one unified solution for managed development.

Kedves fejlesztőközösség!

Az Embarcadero Technologies (korábban CodeGear /Borland/) és a RemObjects a Microsoft PDC 2008-as rendezvényén bejelentették a .NET fényében megújuló új Object Pascal nyelvet, hivatalos nevén: Delphi Prism-et. A Prism lefogja váltani az Embarcadero részéről a régi Delphi .NET-et (ami szinte csak a Win32-vel való kompatibilitás miatt létezett), illetve a RemObjects részéről a legutóbbi "Oxygene" kódnevű Object Pascal .NET compilert. A Prism innovációt jelent mind nyelv, mind eszközök terén.

Delphi Prism és C# különbségek:
Delphi Prism vs C#

Delphi Win32 és Prism közötti különbségek:
Delphi Win32 vs Delphi Prism

Bitwise magazin:
Interjú Marc Hoffmannal, a RemObjects vezető architektjével

Diszkurzus a témáról:
The new Delphi.NET Beta (Prism) & .NET 4.0

Azon felül, hogy mostantól kezdve minden új Microsoft technológia (WinForms, WPF, ASP.NET, LINQ To SQL, Entity Framework, ADO.NET Data Services, stb.) napra készen elérhető lesz, a régi Borlandos adatkezelési megoldások (dbExpress, DataSnap /Midas/, Blackfish SQL, stb.) is átkerülnek natív .NET assemblyk formájában. Az új nyelvnek az ég világon semmi köze nem lesz az idejét múlt VCL-hez, tisztán managelt kódalapra fog épülni. Pontosan ezért a migrációs terheket megpróbálják két új eszközzel levenni a fejlesztők válláról:

1. Oxydizer
   Amely segít átfordítani a Delphi Win32/.NET nyelvi különbségeket a Prismnek megfelelőre.
   
   
2. ShineOn
   Ami a Prismes implementációja a Delphi RTL (Runtime Type Library)-nek.

Hazai beszámoló a Prismről itt:
Delphi Prism (borland.hu)

Végül pedig nem maradt más hátra, mint jelentkezni a Beta tesztre:
Delphi Prism Beta Opportunity

Majd pedig megbeszélni a továbbiakat a devportal-on:
Delphi Prism, te mit gondolsz róla?

Üdvözlök mindenkit a XXI. században!