猛禽,能发你"用DELPHI的RTTI实现对象的XML持久化"用的代码给我伐:)

　
RTTI来实现Object的XML持久化,SOAP实现就是用RTTI来实现Object到SOAP数据（就是XML）的转换...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 Bind 方法创建一个实例来用。
毕竟，一个项目中，能有多少个“配置”文件呢？
用最显而易见的方法比较合适我。同时，5也很佩服猛禽的钻研精神。
有个场景适合用这样的技术，用类似wincontrl的数据对象举例，我有n种不同的数据对象
对这些数据对象进行相同的操作，回使得代码简单很多。

调试易

猛禽,能发你"用DELPHI的RTTI实现对象的XML持久化"用的代码给我伐:)

解决方案 »