用DELPHI的RTTI实现对象的XML持久化

来源：互联网发布：kali linux安装到手机编辑：程序博客网时间：2024/04/25 15:40

去年我花了很多时间尝试用DELPHI进行基于XML的WEB应用开发。起初的设想是很美好的，但结果做出来的东西很简陋。一部分原因就在于XML到Object之间的数据绑定实现太麻烦（另一部分是因为对XSLT不熟，学习它花了很多时间）。

之前我一直是用DELPHI提供的XML Data binding来做的，基本做法是：先用工具（如XMLSPY）做好一个XML Schema(XSD)，然后用XML Data binding生成DELPHI的接口和类。当然，一旦生成好就很方便了，在程序里我只要操作这个接口就好了，其中各个Field都会被变成属性，并且类型也都如我在XSD中的定义。但问题在于程序在开发过程中，总是会有一些变化的，在这种情况下，我就不得不同时开着XMLSPY修改XSD，然后重新用 XML Data binding的Wizard跑一遍，非常的麻烦。

所以当我想到数据集的对象化后，立即想到也可以用RTTI来实现Object的XML持久化--其实DELPHI6开始的SOAP实现就是用RTTI来实现Object到SOAP数据（就是XML）的转换的。显然我已经是非常的后知后觉了，当我在《强大的DELPHI RTTI--兼谈需要了解多种开发语言》一文中说到我的打算时，朋友Lex CHow回复我说他在大约一年前就做过了这方面的工作，我当即跟他要来了他的源码。lexlib是他写的是一个有很多功能的库，看上去结构有点像.net 的基本类库（当然没那么大^O^），Object的XML持久化只是其中的很小的一部分。因为我只需要这一部分，就没必要用这整个一个库这么麻烦，于是参考了lexlib并结合我在《用DELPHI的RTTI实现数据集的简单对象化》中已经实现的部分，做了一个简单的实现：

TMXMLPersistent = class(TObject)    
public        
  class Procedure LoadObjFromXML(aNode : IXMLNode; aObj : TPersistent );        
  class Procedure SaveObjToXML(aNode : IXMLNode; aObj : TPersistent );    
end;
const    
  DefaultFilter : TTypeKinds = [tkInteger, tkChar, tkEnumeration,tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkInt64];
  { TMXMLPersistent }
  class procedure TMXMLPersistent.LoadObjFromXML(aNode: IXMLNode;  aObj: TPersistent);
  Var i : Integer;    
      pList : TMPropList;    
      pInfo : PPropInfo;    
      tmpObj: TObject;begin    
  If ( aObj Is TMDataSetProxy ) Then        
     ( aObj As TMDataSetProxy ).LoadFromXML( aNode )    
  Else    
  Begin        
    pList := TMPropList.Create( aObj );        
    Try            
      For i := 0 To pList.PropCount - 1 Do            
      Begin                
        pInfo := pList.Props[i];                
        If ( pInfo^.PropType^.Kind = tkClass ) Then                
        Begin                    
          tmpObj := TObject( Integer( GetPropValue( aObj, pInfo^.Name ) ) );                    
          If ( Assigned( tmpObj ) AND ( tmpObj Is TPersistent ) ) Then                        
             LoadObjFromXML( aNode.ChildNodes[WideString(pInfo^.Name)],tmpObj As TPersistent );                
          End                
          Else 
          If ( pInfo^.PropType^.Kind In DefaultFilter ) Then                    
              SetPropValue( aObj, pInfo^.Name,String( aNode.ChildNodes[WideString( pInfo^.Name )].Text ) );            
        End;        
     Finally            
       pList.Free;        
     End;    
  End;
end;

class procedure TMXMLPersistent.SaveObjToXML(aNode: IXMLNode;aObj: TPersistent);
Var i : Integer; 
    pList : TMPropList;    
    pInfo : PPropInfo;    
    tmpObj: TObject;
begin    
  If ( aObj Is TMDataSetProxy ) Then        
     ( aObj As TMDataSetProxy ).SaveToXML( aNode )    
  Else    
  Begin        
    pList := TMPropList.Create( aObj );        
    Try            
      For i := 0 To pList.PropCount - 1 Do            
      Begin                
        pInfo := pList.Props[i];                
        If ( pInfo^.PropType^.Kind = tkClass ) Then                
        Begin                    
          tmpObj := TObject( Integer( GetPropValue( aObj, pInfo^.Name ) ) );                    
          If ( Assigned( tmpObj ) AND ( tmpObj Is TPersistent ) ) Then                        
             SaveObjToXML( aNode.AddChild( WideString( pInfo^.Name ) ),tmpObj As TPersistent );                
        End                
        Else 
        If ( pInfo^.PropType^.Kind In DefaultFilter ) Then                    
           aNode.AddChild( WideString( pInfo^.Name ) ).Text :=GetPropValue( aObj, pInfo^.Name );            
      End;        
    Finally            
      pList.Free;        
    End;    
  End;
end;

这个实现应该说是很简单的。主要是三个部分（Load和Save的结构是相似的）：

一是对TMDataSetProxy作特别处理，委托给这个类自己去处理它的实现，因为它与一般的类不同，需要通过ForEach遍历全部记录，这其实就是同时实现数据集的XML持久化。

二是对Class作递归处理，当然只支持从TPersistent派生的class。

三是一般的Field简单地转成String保存，其中借鉴了lexlib的Filter，只处理那些能简单地转成String的数据类型，过滤掉那些可能造成转换出错的类型。

上面的代码中用到的TMPropList见《用DELPHI的RTTI实现数据集的简单对象化》中的实现。

下面是用TMDataSetProxy实现的数据集的XML持久化。免去了需要通过TClientDataSet进行的麻烦，并且采用的是用Node记录字段的方式，.net也是采用这样的方式，与TClientDataSet所用的用Attribute记录字段的方式不同。虽然这样生成的XML文件将会略大一些，但是好处也是显而易见的，特别是我是准备用在Web应用中的，用Node方式记录的XML，在用XSLT时会方便很多。

procedure TMDataSetProxy.LoadFromXML(aNode: IXMLNode);
Var    i, j : Integer;    
       pInfo : PPropInfo;    
       pRow  : IXMLNode;
begin    
  For j := 0 To aNode.ChildNodes.Count - 1 Do    
  Begin        
    FDataSet.Append;        
    pRow := aNode.ChildNodes[j];        
    For i := 0 To FPropList.PropCount - 1 Do        
    Begin            
      pInfo := FPropList.Props[i];            
      If ( pInfo^.PropType^.Kind In DefaultFilter ) Then                
      SetVariant( i,String( pRow.ChildNodes[WideString( pInfo^.Name )].Text ) );        
    End;        
    EndEdit;    
  End;    
    FDataSet.First;
end;

procedure TMDataSetProxy.SaveToXML(aNode: IXMLNode);
Var    i : Integer;    
       pInfo : PPropInfo;    
       pRow  : IXMLNode;
begin    
  While ForEach Do    
  Begin        
    pRow := aNode.AddChild( 'Row' );        
    For i := 0 To FPropList.PropCount - 1 Do        
    Begin            
      pInfo := FPropList.Props[i];            
      If ( pInfo^.PropType^.Kind In DefaultFilter ) Then                
      pRow.AddChild( WideString( pInfo^.Name ) ).Text:= GetVariant( i );        
    End;    
  End;
end;

下面是一个简单的DEMO，其中包括了对数据集的XML持久化。注意Load的时候Employee成员连接的是ADODataSet2，它连接到一个包含了这几个字段的表，各字段类型与Employee表相同，但内容为空，并且去掉了EmployeeID的Identity。Load完成后， Employee表中这几个字段的内容将被复制到此表中。

TDemoCompany = class( TPersistent )    
private        
  FEmployee : TDSPEmployee;        
  FCompany  : String;        
  FCode     : Integer;    
published        
  property Employee : TDSPEmployee Read FEmployee Write FEmployee;        
  property Company  : String       Read FCompany  Write FCompany;        
  Property Code     : Integer      Read FCode     Write FCode;    
End;

procedure TForm1.SaveClick(Sender: TObject);
Var 
  demo : TDemoCompany;
begin    
  demo := TDemoCompany.Create;    
  demo.Employee := TDSPEmployee.Create( ADODataSet1 );    
  demo.Company  := 'Demo company';    
  demo.Code     := 987654;    
  Try        
    XMLDocument1.Active := true;        
    TMXMLPersistent.SaveObjToXML( XMLDocument1.AddChild( 'Demo' ), demo );        
    XMLDocument1.SaveToFile( 'temp.xml' );        
    XMLDocument1.Active := false;    
  Finally        
    demo.Employee.Free;        
    demo.Employee := Nil;        
    demo.Free;    
  End;
end;

procedure TForm1.LoadClick(Sender: TObject);
Var    
  demo : TDemoCompany;
begin    
  demo := TDemoCompany.Create;    
  demo.Employee := TDSPEmployee.Create( ADODataSet2 );    
  Try        
   XMLDocument1.Active := true;        
   XMLDocument1.LoadFromFile( 'temp.xml' );        
   TMXMLPersistent.LoadObjFromXML( XMLDocument1.ChildNodes.Last, demo );        
   XMLDocument1.Active := false;        Edit1.Text := demo.Company;        
   Edit2.Text := IntToStr( demo.Code );        
   While ( demo.Employee.ForEach ) Do        
    With ListView1.Items.Add Do        
    Begin            
      Caption := IntToStr( demo.Employee.EmployeeID );            
      SubItems.Add( demo.Employee.FirstName );            
      SubItems.Add( demo.Employee.LastName );            
      SubItems.Add( FormatDateTime( 'yyyy-mm-dd', demo.Employee.BirthDate ) );        
    End;    
  Finally        
    demo.Employee.Free;        
    demo.Employee := Nil;        
    demo.Free;    
  End;
end;

终于可以告别那个麻烦的XML Data binding了，并且以后也不用写XSD了--虽然有好用的工具，但能省点事终归是好的。