用DELPHI的RTTI实现对象的XML持久化
2006-02-04 13:59:28 来源:WEB开发网 闂傚倸鍊搁崐鎼佸磹閹间礁纾归柟闂寸绾惧綊鏌熼梻瀵割槮缁炬儳缍婇弻鐔兼⒒鐎靛壊妲紒鐐劤缂嶅﹪寮婚悢鍏尖拻閻庨潧澹婂Σ顔剧磼閻愵剙鍔ょ紓宥咃躬瀵鎮㈤崗灏栨嫽闁诲酣娼ф竟濠偽i鍓х<闁绘劦鍓欓崝銈囩磽瀹ュ拑韬€殿喖顭烽幃銏ゅ礂鐏忔牗瀚介梺璇查叄濞佳勭珶婵犲伣锝夘敊閸撗咃紲闂佺粯鍔﹂崜娆撳礉閵堝洨纾界€广儱鎷戦煬顒傗偓娈垮枛椤兘骞冮姀銈呯閻忓繑鐗楃€氫粙姊虹拠鏌ュ弰婵炰匠鍕彾濠电姴浼i敐澶樻晩闁告挆鍜冪床闂備浇顕栭崹搴ㄥ礃閿濆棗鐦遍梻鍌欒兌椤㈠﹤鈻嶉弴銏犵闁搞儺鍓欓悘鎶芥煛閸愩劎澧曠紒鈧崘鈹夸簻闊洤娴烽ˇ锕€霉濠婂牏鐣洪柡灞诲妼閳规垿宕卞▎蹇撴瘓缂傚倷闄嶉崝搴e垝椤栫偛桅闁告洦鍨扮粻鎶芥倵閿濆簼绨藉ù鐘荤畺濮婃椽妫冨☉娆愭倷闁诲孩鐭崡鎶芥偘椤曗偓瀹曞爼顢楁径瀣珫婵犳鍣徊鍓р偓绗涘洤绠查柛銉墮閽冪喖鏌i弬鎸庢喐闁荤喎缍婇弻娑⑩€﹂幋婵囩亪濡炪値鍓欓悧鍡涒€旈崘顔嘉ч幖绮光偓鑼嚬缂傚倷绶¢崰妤呭箰閹间焦鍋╅柣鎴f绾偓闂佺粯鍔曠粔闈浳涢崘顔兼槬闁逞屽墯閵囧嫰骞掗幋婵愪紑閻庤鎸风粈渚€鍩為幋锔藉亹闁圭粯甯╂导鈧紓浣瑰劤瑜扮偟鍒掑▎鎾宠摕婵炴垶鐭▽顏堟煙鐟欏嫬濮囨い銉︾箞濮婃椽鏌呴悙鑼跺濠⒀傚嵆閺岀喖鎼归锝呯3闂佹寧绻勯崑娑㈠煘閹寸姭鍋撻敐搴樺亾椤撴稒娅婇柡灞界У濞碱亪骞忕仦钘夊腐闂備焦鐪归崐鏇㈠箠閹邦喗顫曢柟鎯х摠婵挳鏌涢幘鏉戠祷闁告挸宕—鍐Χ閸℃浠搁梺鑽ゅ暱閺呮盯鎮鹃悜钘壩ㄧ憸澶愬磻閹剧粯鏅查幖绮瑰墲閻忓秹姊虹紒妯诲鞍婵炲弶锕㈡俊鐢稿礋椤栨氨鐤€闂傚倸鐗婄粙鎰姳閼测晝纾藉ù锝堟閻撴劖鎱ㄥΟ绋垮婵″弶鍔欓獮妯兼嫚閼碱剦妲伴梻浣稿暱閹碱偊宕愭繝姣稿洭寮舵惔鎾存杸濡炪倖姊婚妴瀣啅閵夛负浜滄い鎾跺仜濡插鏌i敐鍥у幋妤犵偞甯¢獮瀣籍閳ь剟鎮楁繝姘拺閻熸瑥瀚崕妤呮煕濡 鍋撻悢鎻掑緧婵犵數濮烽弫鍛婃叏閻戣棄鏋侀柛娑橈攻閸欏繑銇勯幘鍗炵仼缁炬儳顭烽弻鐔煎礈瑜忕敮娑㈡煃闁垮鐏﹂柕鍥у楠炴帡宕卞鎯ь棜缂傚倸鍊风粈渚€藝闁秴鏋佸┑鐘虫皑瀹撲線鏌涢埄鍐姇闁稿﹦鍏橀弻娑樷攽閸℃浼€濡炪倖姊归崝鏇㈠煘閹达附鍊婚柛銉㈡櫇鏍¢梻浣告啞閹稿鎮烽敂鐣屸攳濠电姴娲﹂崵鍐煃閸濆嫬鏆熼柨娑欑矒濮婇缚銇愰幒鎴滃枈闂佸憡鐟ユ鎼佸煝閹炬枼鍫柛顐ゅ枔閸樻悂鏌h箛鏇炰户缁绢厼鐖煎畷鎴﹀箻鐠囪尙鐤€婵炶揪绲介幉锟犲磹椤栫偞鈷戠痪顓炴噹娴滃綊鎮跺☉鏍у姦闁糕斁鍋撳銈嗗笒閸燁偊鎯冨ú顏呯厸濞达絽婀辨晶顏堟煃鐟欏嫬鐏撮柟顔界懇瀵爼骞嬮悩杈敇闂傚倷绀佸﹢杈ㄧ仚闂佺濮ょ划搴ㄥ礆閹烘绫嶉柛顐ゅ枎娴犺櫣绱撴担鍓插創妞ゆ洘濞婇弫鍐磼濞戞艾骞堥梻浣告惈濞层垽宕濆畝鍕€堕柣妯肩帛閻撴洟鏌熼懜顒€濡煎ù婊勫劤閳规垿鏁嶉崟顐℃澀闂佺ǹ锕ラ悧鐘茬暦濠靛鏅濋柍褜鍓熼垾锕傚锤濡も偓閻掑灚銇勯幒宥堝厡缂佺姴澧介埀顒€鍘滈崑鎾斥攽閻樿京绐旈柛瀣殔閳规垿顢欑涵鐑界反濠电偛鎷戠徊鍨i幇鏉跨闁瑰啿纾崰鎾诲箯閻樼粯鍤戦柤绋跨仛濮f劙姊婚崒姘偓鐑芥嚄閼哥數浠氭繝鐢靛仜椤曨參宕楀Ο渚殨妞ゆ劑鍊栫€氭氨鈧懓澹婇崰鏍р枔閵婏妇绡€闁汇垽娼ф牎缂佺偓婢樼粔鐟邦嚕閺屻儱绠甸柟鐑樼箘閸炵敻鏌i悩鐑橆仩閻忓繈鍔岄蹇涘Ψ瑜夐崑鎾舵喆閸曨剙纰嶅┑鈽嗗亝缁诲倿锝炶箛娑欐優闁革富鍘鹃敍婊冣攽閳藉棗鐏犻柟纰卞亰閿濈偛顓奸崶鈺冿紳婵炶揪缍侀ˉ鎾诲礉瀹ュ鐓欑紒瀣仢閺嗛亶鏌i敐鍥у幋妤犵偛顑夐弫鍐焵椤掑倻涓嶅┑鐘崇閸嬶綁鏌涢妷鎴濆暟妤犲洭鎮楃憴鍕碍缂佸鎸抽垾鏃堝礃椤斿槈褔鏌涢埄鍏狀亪妫勫鍥╃=濞达絽澹婇崕鎰版煕閵娿儱顣崇紒顔碱儏椤撳吋寰勭€n亖鍋撻柨瀣ㄤ簻闁瑰搫绉堕ˇ锔锯偓娈垮枛閻忔繈鍩為幋锕€鐓¢柛鈩冾殘娴狀垶姊洪崨濠庣劶闁告洦鍙庡ú鍛婁繆閵堝繒鍒伴柛鐕佸灦瀹曟劙宕归锝呭伎濠碘槅鍨抽崢褎绂嶆ィ鍐╁€垫慨妯煎亾鐎氾拷

之前我一直是用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了--虽然有好用的工具,但能省点事终归是好的。
更多精彩
赞助商链接