This soultion will not but if rewriten thwen it can handel a better suport for records. Its now ordered (by indexed name) but it can be changed to use nodes.
TJanXml is a opensource XML parcer in Delphi made by Jan Verhoeven He is a Ducth man who inspired me sometime ago to make opensource my self. Theres nothing special about it than that its fast. It's a DOM parcer and it cant handel all types correctly (like encoding and decoding) but for some purposes it was still great to use. Theres no reason that you cant rebuild this to the XMLParcer in Lazarus. All do I have noticed the new unit for the XML parcer are better then the default installed with laz latest full install. Met vriendelijke groet, Pieter Valentijn Delphidreams http://www.delphidreams.nl -----Oorspronkelijk bericht----- Van: George Lober [mailto:[EMAIL PROTECTED] Verzonden: maandag 19 maart 2007 20:17 Aan: [email protected] Onderwerp: Re: [lazarus] XML and Record type Interesting. I have to mention that the main reason for my question is that I want to use XML for data storage, because I can see XML being able to withstand changes in the data format. So that brings up the question in my mind, how would the example code handle addition or removal of record elements? Would that be a problem? BTW is there anything special about the TjanXMLNode type ? Regards, George Pieter Valentijn wrote: > I think if you need a dynamic way to extract data use Tpersistent + to > store the data. If you need 1 to manny use TCollection. > (http://www.delphi3000.com/articles/article_1844.asp?SK=) > > I wrote a article on how to get data from and to the GUI > http://www.delphi3000.com/articles/article_1846.asp?SK= > This shows how to use RTTI I think this all works in Lazarus. > > Something like this is also implemeted in the RTTI tab of Lazarus. > Streaming object to a XML File (and retrieving them) should not be > hard to implement based on the RTTI routines. > > So all you need to do is to create at least a TPersistant with your > fields published that can be read by RTTI and so iterated in e general > function. > > Heres some code I found on how to make XML form a object. > You will need to rewrite it im sure. > > procedure TXMLBaseParcer.MakeXmlFromPersistent(APersistent: TPersistent; > Parentname: string; ABaseNode: TjanXMLNode); > var > PropList: PPropList; > PropCount: Integer; > ClassTypeInfo: PTypeInfo; > ClassTypeData: PTypeData; > i, EnumCount, CollectionCount: integer; > Propname: string; > ANode, AddedNode: TjanXMLNode; > begin > if APersistent = nil then exit; > AddedNode := nil; > ClassTypeInfo := APersistent.ClassInfo; > ClassTypeData := GetTypeData(ClassTypeInfo); > PropCount := ClassTypeData.PropCount - 1; > > // reserveer geheugen > GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); > // Error trap > try > // Vul de prop list > GetPropInfos(APersistent.ClassInfo, PropList); > if Parentname <> '' then > ANode := ABaseNode.SelectSingleNode(UnderscoresToName(Parentname)) > else > ANode := ABaseNode; > if ANode <> nil then > for i := 0 to PropCount do > begin > > Propname := Parentname + '_' + PropList[i]^.Name; > if Propname[1] = '_' then Propname[1] := ' '; > Propname := trim(Propname); > > > case PropList[i]^.PropType^.Kind of > tkString, tkLString, > tkWString, tkWChar, > tkChar: > begin > if (APersistent is tcomponent) and (PropList[i]^.Name = > 'Name') then > AddedNode := nil > else > AddedNode := ANode.AddNode(PropList[i]^.Name, > GetStrProp(APersistent, PropList[i])); > end; > > tkInteger, > tkEnumeration: > begin > if (PropList[i]^.PropType^.Name = 'Boolean') then > begin > if GetOrdProp(APersistent, PropList[i]) = 0 then > AddedNode := ANode.AddNode(PropList[i]^.Name, > false) > else > AddedNode := ANode.AddNode(PropList[i]^.Name, > true); > > end > else > AddedNode := ANode.AddNode(PropList[i]^.Name, > GetOrdProp(APersistent, PropList[i])); > end; > tkFloat: > begin > if (PropList[i]^.PropType^.Name = 'TDateTime') then > begin > AddedNode := ANode.AddNode(PropList[i]^.Name, > VarFromDateTime(GetFloatProp(APersistent, > PropList[i]))) > end > > else > AddedNode := ANode.AddNode(PropList[i]^.Name, > GetFloatProp(APersistent, PropList[i])); > > end; > tkClass: > begin > if GetObjectProp(APersistent, PropList[i]) is > TPersistent then > begin > AddedNode := ANode.AddNode(PropList[i]^.Name, > ''); > if GetObjectProp(APersistent, PropList[i]) is > TCollection then > begin > for CollectionCount := 0 to > TCollection(GetObjectProp(APersistent, PropList[i])).Count - 1 do > begin > AddedNode.AddNode('OBJ' + > IntToStr(CollectionCount), null); > > MakeXmlFromPersistent(TPersistent(TCollection(GetObjectProp(APersisten > t, > PropList[i])).Items[CollectionCount]), Propname + '_' + 'OBJ' + > IntToStr(CollectionCount), ABaseNode); > end; > end; > > MakeXmlFromPersistent(TPersistent(GetObjectProp(APersistent, > PropList[i])), Propname, ABaseNode); > end; > end; > tkArray: > begin > > end; > > end; // end case > if TypeInfo and (AddedNode <> nil) then > begin > case PropList[i]^.PropType^.Kind of > > tkString, tkLString, > tkWString, tkWChar, > tkChar: AddedNode.AddAttribute('Type', 'String'); > > tkInteger: AddedNode.AddAttribute('Type', 'Number'); > tkEnumeration: > begin > AddedNode.AddAttribute('Type', 'Enum'); > for EnumCount := > GetTypeData(PropList[i]^.PropType^).MinValue to > GetTypeData(PropList[i]^.PropType^).MaxValue do > > AddedNode.AddAttribute(GetEnumName(PropList[i]^.PropType^, EnumCount), > IntToStr(EnumCount)); > end; > > tkFloat: > begin > if (PropList[i]^.PropType^.Name = 'TDateTime') then > AddedNode.AddAttribute('Type', 'Date') > else > AddedNode.AddAttribute('Type', 'Float'); > > end; > > tkClass: > begin > if GetObjectProp(APersistent, PropList[i]) is > TCollection then > AddedNode.AddAttribute('Type', 'Collection') > else > AddedNode.AddAttribute('Type', 'Class'); > end; > end; > end; > end; // end i > finally > FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); > end; > end; > > procedure TXMLBaseParcer.SetXmlToPersistent(APersistent: TPersistent; > Parentname: string; ABaseNode: TjanXMLNode); > var > PropList: PPropList; > PropCount, CollCount, NummerNode: Integer; > ClassTypeInfo: PTypeInfo; > ClassTypeData: PTypeData; > i: integer; > TempString: string; > Propname: string; > ANode: TjanXMLNode; > ADate: TDate; > begin > if APersistent = nil then exit; > ClassTypeInfo := APersistent.ClassInfo; > ClassTypeData := GetTypeData(ClassTypeInfo); > PropCount := ClassTypeData.PropCount - 1; > // reserveer geheugen > GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); > // Error trap > try > // Vul de prop list > GetPropList(APersistent.ClassInfo, tkAny, PropList); > > for i := 0 to PropCount do > begin > > Propname := Parentname + '_' + PropList[i]^.Name; > if Propname[1] = '_' then Propname[1] := ' '; > Propname := trim(Propname); > ANode := ABaseNode.SelectSingleNode(UnderscoresToName(Propname)); > try > if (Anode <> nil) then > case PropList[i]^.PropType^.Kind of > tkString, tkLString, > tkWString, tkWChar, > tkChar: > begin > if (APersistent is tcomponent) and (PropList[i]^.Name > = > 'Name') then > else if (assigned(PropList[i]^.SetProc)) then > SetStrProp(APersistent, PropList[i], > VarToStr(Anode.Value)); > end; > > tkInteger, > tkEnumeration: > begin > if (VarToStr(ANode.Value) = 'True') or > (VarToStr(ANode.Value) = 'False') then > // if vartype(ANode.Value) = varBoolean then > begin > if (assigned(PropList[i]^.SetProc)) then > if ANode.Value = true then > SetOrdProp(APersistent, PropList[i], 1) > else > SetOrdProp(APersistent, PropList[i], 0); > end > else > begin > Tempstring := VarToStr(ANode.Value); > if Tempstring <> '' then > begin > if (assigned(PropList[i]^.SetProc)) then > SetOrdProp(APersistent, PropList[i], > StrToInt(Tempstring)); > end; > end; > end; > tkFloat: > begin > if VarToStr(ANode.Value) <> '' then > if (assigned(PropList[i]^.SetProc)) then > if (PropList[i]^.PropType^.Name = 'TDateTime') then > begin > ADate := VarToDateTime(ANode.Value); > SetFloatProp(APersistent, PropList[i], ADate); > end > else > begin > SetFloatProp(APersistent, PropList[i], > StrTOFLoat(VarToStr(ANode.Value))); > end; > end; > tkClass: > begin > if GetObjectProp(APersistent, PropList[i]) is > TPersistent then > begin > if GetObjectProp(APersistent, PropList[i]) is > TCollection then > begin > with GetObjectProp(APersistent, PropList[i]) as > TCollection do > begin > if fMapCollections then > begin > NummerNode := 0; > for CollCount := 0 to Count - 1 do > begin > if ANode.SelectSingleNode('OBJ' + > IntToStr(NummerNode)) <> nil then > begin > SetXmlToPersistent(Items[Collcount], > Propname + '_' + 'OBJ' + IntToStr(NummerNode), ABaseNode); > Inc(NummerNode); > end; > end; > end > else // no map collections > begin > clear; > NummerNode := 0; > if UseBeterCollectionSupport then > begin > //if ANode.SelectSingleNode(PropList[i]^.Name) > <> nil then > > for CollCount := 0 to ANode.Nodes.Count - 1 do > begin > if > Uppercase(TJanXmlNode(ANode.Nodes[CollCount]).Name) = > Uppercase(PropList[i]^.PropType^.Name) then > begin > SetXmlToPersistent(Add, '' , > ANode.indexNode[CollCount]); > end; > end; > end else > begin > for CollCount := 0 to ANode.Nodes.Count - 1 do > begin > if ANode.SelectSingleNode('OBJ' + > IntToStr(NummerNode)) <> nil then > begin > SetXmlToPersistent(Add, Propname + '_' + > 'OBJ' + IntToStr(NummerNode), ABaseNode); > Inc(NummerNode); > end; > end; > end; // alternate collection add > end > end; // end with > end; //end is collection > > SetXmlToPersistent(TPersistent(GetObjectProp(APersistent, > PropList[i])), Propname, ABaseNode); > end; > end; > tkArray: > begin > Showmessage('Set array ' + PropList[i]^.Name); > end; > > end; // end case > except > on e: Exception do > > end; > > end; > finally > FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); > end; > end; > > > > > > > Met vriendelijke groet, > Pieter Valentijn > > Delphidreams > http://www.delphidreams.nl > _________________________________________________________________ To unsubscribe: mail [EMAIL PROTECTED] with "unsubscribe" as the Subject archives at http://www.lazarus.freepascal.org/mailarchives _________________________________________________________________ To unsubscribe: mail [EMAIL PROTECTED] with "unsubscribe" as the Subject archives at http://www.lazarus.freepascal.org/mailarchives
