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(APersistent,
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
