Permalink
Find file
5e405ea Dec 12, 2013
on.pokorny@gmail.com FPC + ARC support
771 lines (693 sloc) 24 KB
(*******************************************************************************
* The contents of this file are subject to the Mozilla Public License Version *
* 1.1 (the "License"); you may not use this file except in compliance with the *
* License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ *
* *
* Software distributed under the License is distributed on an "AS IS" basis, *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License. *
* *
* The Original Code is mr_Storage_XML.pas *
* *
* The Initial Developer of the Original Code is Miha Remec, *
* http://www.MihaRemec.com/ *
* *
* Contributor(s): *
* Miha Vrhovnik, Primoz Gabrijelcic, John *
*******************************************************************************)
unit OmniXMLPersistent;
interface
{$I OmniXML.inc}
{$IFDEF OmniXML_HasZeroBasedStrings}
{$ZEROBASEDSTRINGS OFF}
{$ENDIF}
// if you want to use MS XML parser, uncomment (in your program!!!)
// the following compiler directive {.$DEFINE USE_MSXML}
uses
Classes, SysUtils,
{$IFDEF VCL} Controls, {$ENDIF}
TypInfo,
{$IFDEF HAS_UNIT_VARIANTS} Variants, {$ENDIF}
OEncoding, OmniXML, OmniXML_Types,
{$IFDEF USE_MSXML} OmniXML_MSXML, {$ENDIF}
OmniXMLUtils;
type
TPropsFormat = (pfAuto, pfAttributes, pfNodes);
EOmniXMLPersistent = class(Exception);
{$IFDEF VisualCLX}
TTime = type TDateTime;
TDate = type TDateTime;
{$ENDIF}
type
TOmniXMLWriter = class
protected
Doc: IXMLDocument;
procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo;
Element: IXMLElement; WriteDefaultValues: Boolean);
procedure InternalWriteText(Root: IXMLElement; Name, Value: XmlString);
procedure WriteCollection(Collection: TCollection; Root: IXMLElement);
public
PropsFormat: TPropsFormat;
constructor Create(Doc: IXMLDocument; const PropFormat: TPropsFormat = pfAuto);
class procedure SaveToFile(const Instance: TPersistent; const FileName: string;
const PropFormat: TPropsFormat = pfAuto; const OutputFormat: TOutputFormat = ofNone);
class procedure SaveXML(const Instance: TPersistent; var XML: XmlString;
const PropFormat: TPropsFormat = pfAuto; const OutputFormat: TOutputFormat = ofNone);
procedure Write(Instance: TPersistent; Root: IXMLElement;
const WriteRoot: Boolean = True; const CheckIfEmpty: Boolean = True;
const WriteDefaultValues: Boolean = False);
end;
TOmniXMLReader = class
protected
function FindElement(const Root: IXMLElement; const TagName: XmlString): IXMLElement;
procedure ReadProperty(Instance: TPersistent; PropInfo: Pointer; Element: IXMLElement);
function InternalReadText(Root: IXMLElement; Name: XmlString; var Value: XmlString): Boolean;
procedure ReadCollection(Collection: TCollection; Root: IXMLElement);
public
PropsFormat: TPropsFormat;
constructor Create(const PropFormat: TPropsFormat = pfAuto);
class procedure LoadFromFile(Instance: TPersistent; FileName: string); overload;
class procedure LoadFromFile(Collection: TCollection; FileName: string); overload;
class procedure LoadXML(Instance: TPersistent; const XML: XmlString); overload;
procedure Read(Instance: TPersistent; Root: IXMLElement; const ReadRoot: Boolean = False);
end;
var
DefaultPropFormat: TPropsFormat = pfNodes;
implementation
{$IFDEF UNICODE}
const
CP_ACP = 0; // default to ANSI code page
CP_RawByteString = $FFFF; // codepage of RawByteString string type
{$ENDIF} // UNICODE
const
COLLECTIONITEM_NODENAME = 'o'; // do not change!
PROP_FORMAT = 'PropFormat'; // do not change!
StringS_COUNT_NODENAME = 'Count'; // do not change!
StringS_PREFIX = 'l'; // do not change!
var
PropFormatValues: array[TPropsFormat] of string = ('auto', 'attr', 'node');
function IsElementEmpty(Element: IXMLElement; PropsFormat: TPropsFormat): Boolean;
begin
Result := ((PropsFormat = pfAttributes) and (Element.Attributes.Length = 0)) or
((PropsFormat = pfNodes) and (Element.ChildNodes.Length = 0));
end;
procedure CreateDocument(var XMLDoc: IXMLDocument; var Root: IXMLElement;
RootNodeName: XmlString);
begin
XMLDoc := CreateXMLDoc;
Root := XMLDoc.CreateElement(RootNodeName);
XMLDoc.DocumentElement := Root;
end;
procedure Load(var XMLDoc: IXMLDocument; var XMLRoot: IXMLElement;
var PropsFormat: TPropsFormat);
var
i: TPropsFormat;
PropFormatValue: XmlString;
begin
// set root element
XMLRoot := XMLDoc.documentElement;
PropsFormat := pfNodes;
if XMLRoot = nil then
Exit;
PropFormatValue := XMLRoot.GetAttribute(PROP_FORMAT);
for i := Low(TPropsFormat) to High(TPropsFormat) do begin
if SameText(PropFormatValue, PropFormatValues[i]) then begin
PropsFormat := i;
Break;
end;
end;
end;
procedure LoadDocument(const FileName: string; var XMLDoc: IXMLDocument;
var XMLRoot: IXMLElement; var PropsFormat: TPropsFormat);
begin
XMLDoc := CreateXMLDoc;
{ TODO : implement and test preserveWhiteSpace }
XMLDoc.preserveWhiteSpace := True;
XMLDoc.Load(FileName);
Load(XMLDoc, XMLRoot, PropsFormat);
end;
{ TOmniXMLWriter }
class procedure TOmniXMLWriter.SaveToFile(const Instance: TPersistent;
const FileName: string; const PropFormat: TPropsFormat = pfAuto;
const OutputFormat: TOutputFormat = ofNone);
var
XMLDoc: IXMLDocument;
Root: IXMLElement;
Writer: TOmniXMLWriter;
begin
if Instance is TCollection then
CreateDocument(XMLDoc, Root, Instance.ClassName)
else
CreateDocument(XMLDoc, Root, 'data');
Writer := TOmniXMLWriter.Create(XMLDoc, PropFormat);
try
if Instance is TCollection then
Writer.WriteCollection(TCollection(Instance), Root)
else
Writer.Write(Instance, Root);
finally
Writer.Free;
end;
{$IFNDEF USE_MSXML}
XMLDoc.Save(FileName, OutputFormat);
{$ELSE}
XMLDoc.Save(FileName);
{$ENDIF}
end;
class procedure TOmniXMLWriter.SaveXML(const Instance: TPersistent; var XML: XmlString;
const PropFormat: TPropsFormat; const OutputFormat: TOutputFormat);
var
XMLDoc: IXMLDocument;
Root: IXMLElement;
Writer: TOmniXMLWriter;
begin
if Instance is TCollection then
CreateDocument(XMLDoc, Root, Instance.ClassName)
else
CreateDocument(XMLDoc, Root, 'data');
Writer := TOmniXMLWriter.Create(XMLDoc, PropFormat);
try
if Instance is TCollection then
Writer.WriteCollection(TCollection(Instance), Root)
else
Writer.Write(Instance, Root);
finally
Writer.Free;
end;
XML := XMLDoc.XML;
end;
constructor TOmniXMLWriter.Create(Doc: IXMLDocument; const PropFormat: TPropsFormat = pfAuto);
begin
Self.Doc := Doc;
if PropFormat <> pfAuto then
PropsFormat := PropFormat
else
PropsFormat := DefaultPropFormat;
Doc.DocumentElement.SetAttribute(PROP_FORMAT, PropFormatValues[PropsFormat]);
end;
procedure TOmniXMLWriter.InternalWriteText(Root: IXMLElement; Name, Value: XmlString);
var
PropNode: IXMLElement;
begin
case PropsFormat of
pfAttributes: Root.SetAttribute(Name, Value);
pfNodes:
begin
PropNode := Doc.CreateElement(Name);
PropNode.Text := Value;
Root.appendChild(PropNode);
end;
end;
end;
procedure TOmniXMLWriter.WriteCollection(Collection: TCollection; Root: IXMLElement);
var
i: Integer;
begin
for i := 0 to Collection.Count - 1 do
Write(Collection.Items[i], Root, True, False);
end;
procedure TOmniXMLWriter.WriteProperty(Instance: TPersistent; PropInfo: PPropInfo;
Element: IXMLElement; WriteDefaultValues: Boolean);
var
PropType: PTypeInfo;
procedure WriteStrProp;
var
Value: XmlString;
begin
if PropType^.Kind = tkWString then
Value := GetWideStrProp(Instance, PropInfo)
else
Value := GetStrProp(Instance, PropInfo);
if Value <> '' then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), Value);
end;
procedure WriteOrdProp;
var
Value: Longint;
begin
Value := GetOrdProp(Instance, PropInfo);
if WriteDefaultValues or (Value <> PPropInfo(PropInfo)^.Default) then begin
case PropType^.Kind of
tkInteger: InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLIntToStr(Value));
tkChar:
begin
{$IFDEF UNICODE}
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), Char(Value));
{$ELSE}
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), UTF8Decode(AnsiToUtf8(Char(Value))));
{$ENDIF} // UNICODE
end;
tkWChar: InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), WideChar(Value));
tkSet: InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name),
GetSetProp(Instance, PPropInfo(PropInfo), True));
tkEnumeration:
begin
if PropType = System.TypeInfo(Boolean) then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLBoolToStr(Boolean(Value)))
else if PropType^.Kind = tkInteger then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLIntToStr(Value))
// 2003-05-27 (mr): added tkEnumeration processing
else if PropType^.Kind = tkEnumeration then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), GetEnumName(PropType, Value));
end;
end;
end;
end;
procedure WriteFloatProp;
var
Value: Real;
begin
Value := GetFloatProp(Instance, PropInfo);
if Value <> 0 then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLRealToStr(Value));
end;
procedure WriteDateTimeProp;
var
Value: TDateTime;
begin
Value := VarAsType(GetFloatProp(Instance, PropInfo), varDate);
if Value <> 0 then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLDateTimeToStrEx(Value));
end;
procedure WriteInt64Prop;
var
Value: Int64;
begin
Value := GetInt64Prop(Instance, PropInfo);
if Value <> 0 then
InternalWriteText(Element, XmlString(PPropInfo(PropInfo)^.Name), XMLInt64ToStr(Value));
end;
procedure WriteObjectProp;
var
Value: TObject;
PropNode: IXMLElement;
procedure WriteStrings(const Strings: TStrings);
var
i: Integer;
begin
SetNodeAttrInt(PropNode, StringS_COUNT_NODENAME, Strings.Count);
for i := 0 to Strings.Count - 1 do begin
if Strings[i] <> '' then
InternalWriteText(PropNode, StringS_PREFIX + IntToStr(i), Strings[i]);
end;
end;
begin
Value := TObject(GetOrdProp(Instance, PropInfo));
if (Value <> nil) and (Value is TPersistent) then begin
PropNode := Doc.CreateElement(XmlString(PPropInfo(PropInfo)^.Name));
// write object's properties
Write(TPersistent(Value), PropNode, False, True, WriteDefaultValues);
if Value is TCollection then begin
WriteCollection(TCollection(Value), PropNode);
if not IsElementEmpty(PropNode, pfNodes) then
Element.AppendChild(PropNode);
end
else if Value is TStrings then begin
WriteStrings(TStrings(Value));
Element.AppendChild(PropNode);
end
else if not IsElementEmpty(PropNode, PropsFormat) then
Element.AppendChild(PropNode);
end;
end;
begin
if (PPropInfo(PropInfo)^.GetProc <> nil) then begin
PropType := {$IFDEF FPC}@{$ENDIF}PPropInfo(PropInfo).PropType{$IFNDEF FPC}^{$ENDIF};
case PropType^.Kind of
tkInteger, tkChar, tkWChar, tkEnumeration, tkSet: WriteOrdProp;
tkString, tkLString, tkWString {$IFDEF UNICODE}, tkUString {$ENDIF}: WriteStrProp;
tkFloat:
if (PropType = System.TypeInfo(TDateTime)) or (PropType = System.TypeInfo(TTime))
or (PropType = System.TypeInfo(TDate)) then
WriteDateTimeProp
else
WriteFloatProp;
tkInt64: WriteInt64Prop;
tkClass: WriteObjectProp;
end;
end;
end;
procedure TOmniXMLWriter.Write(Instance: TPersistent; Root: IXMLElement;
const WriteRoot: Boolean; const CheckIfEmpty: boolean; const WriteDefaultValues: Boolean);
var
PropCount: Integer;
PropList: PPropList;
i: Integer;
PropInfo: PPropInfo;
Element: IXMLElement;
begin
PropCount := GetTypeData(Instance.ClassInfo)^.PropCount;
if PropCount = 0 then
Exit;
if Instance is TCollectionItem then
Element := Doc.CreateElement(COLLECTIONITEM_NODENAME)
else if WriteRoot then
Element := Doc.CreateElement(Instance.ClassName)
else
Element := Root;
GetMem(PropList, PropCount * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);
for i := 0 to PropCount - 1 do begin
PropInfo := PropList^[I];
if PropInfo = nil then
Break;
if IsStoredProp(Instance, PropInfo) then
WriteProperty(Instance, PropInfo, Element, WriteDefaultValues)
end;
finally
FreeMem(PropList, PropCount * SizeOf(Pointer));
end;
if WriteRoot then begin
if CheckIfEmpty and IsElementEmpty(Element, PropsFormat) then
Exit
else begin
if Root <> nil then
Root.appendChild(Element)
else
Doc.documentElement := Element;
end;
end;
end;
{ TOmniXMLReader }
class procedure TOmniXMLReader.LoadXML(Instance: TPersistent; const XML: XmlString);
var
XMLDoc: IXMLDocument;
XMLRoot: IXMLElement;
Reader: TOmniXMLReader;
PropsFormat: TPropsFormat;
begin
XMLDoc := CreateXMLDoc;
{ TODO : implement and test preserveWhiteSpace }
XMLDoc.preserveWhiteSpace := True;
XMLDoc.LoadXML(XML);
Load(XMLDoc, XMLRoot, PropsFormat);
Reader := TOmniXMLReader.Create(PropsFormat);
try
if Instance is TCollection then
Reader.ReadCollection(TCollection(Instance), XMLRoot)
else
Reader.Read(Instance, XMLRoot, True);
finally
Reader.Free;
end;
end;
class procedure TOmniXMLReader.LoadFromFile(Instance: TPersistent; FileName: string);
var
XMLDoc: IXMLDocument;
XMLRoot: IXMLElement;
Reader: TOmniXMLReader;
PropsFormat: TPropsFormat;
begin
// read document
LoadDocument(FileName, XMLDoc, XMLRoot, PropsFormat);
Reader := TOmniXMLReader.Create(PropsFormat);
try
if Instance is TCollection then
Reader.ReadCollection(TCollection(Instance), XMLRoot)
else
Reader.Read(Instance, XMLRoot, True);
finally
Reader.Free;
end;
end;
class procedure TOmniXMLReader.LoadFromFile(Collection: TCollection; FileName: string);
var
XMLDoc: IXMLDocument;
XMLRoot: IXMLElement;
Reader: TOmniXMLReader;
PropsFormat: TPropsFormat;
begin
// read document
LoadDocument(FileName, XMLDoc, XMLRoot, PropsFormat);
Reader := TOmniXMLReader.Create(PropsFormat);
try
Reader.ReadCollection(Collection, XMLRoot);
finally
Reader.Free;
end;
end;
constructor TOmniXMLReader.Create(const PropFormat: TPropsFormat = pfAuto);
begin
if PropFormat = pfAuto then
raise EOmniXMLPersistent.Create('Auto PropFormat not allowed here.');
PropsFormat := PropFormat;
end;
function TOmniXMLReader.FindElement(const Root: IXMLElement; const TagName: XmlString): IXMLElement;
var
i: Integer;
begin
Result := nil;
if Root = nil then
Exit;
i := 0;
while (Result = nil) and (i < Root.ChildNodes.Length) do begin
if (Root.ChildNodes.Item[i].NodeType = ELEMENT_NODE)
and (CompareText(Root.ChildNodes.Item[i].NodeName, TagName) = 0) then
Result := Root.ChildNodes.Item[i] as IXMLElement
else
Inc(i);
end;
end;
function TOmniXMLReader.InternalReadText(Root: IXMLElement; Name: XmlString; var Value: XmlString): Boolean;
var
PropNode: IXMLElement;
AttrNode: IXMLNode;
begin
case PropsFormat of
pfAttributes:
begin
AttrNode := Root.Attributes.GetNamedItem(Name);
Result := AttrNode <> nil;
if Result then
Value := AttrNode.NodeValue;
end;
pfNodes:
begin
PropNode := FindElement(Root, Name);
Result := PropNode <> nil;
if Result then
Value := PropNode.Text;
end;
else
Result := False;
end;
end;
procedure TOmniXMLReader.ReadCollection(Collection: TCollection; Root: IXMLElement);
var
i: Integer;
Item: TCollectionItem;
begin
Collection.Clear;
if Root = nil then
Exit;
for i := 0 to Root.ChildNodes.Length - 1 do begin
if Root.ChildNodes.Item[i].NodeType = ELEMENT_NODE then begin
if Root.ChildNodes.Item[i].NodeName = COLLECTIONITEM_NODENAME then begin
Item := Collection.Add;
Read(Item, Root.ChildNodes.Item[i] as IXMLElement, False);
end;
end;
end;
end;
procedure TOmniXMLReader.ReadProperty(Instance: TPersistent; PropInfo: Pointer;
Element: IXMLElement);
var
PropType: PTypeInfo;
procedure ReadFloatProp;
var
Value: Extended;
Text: XmlString;
begin
if InternalReadText(Element, XmlString(PPropInfo(PropInfo)^.Name), Text) then
Value := XMLStrToRealDef(Text, 0)
else
Value := 0;
SetFloatProp(Instance, PropInfo, Value)
end;
procedure ReadDateTimeProp;
var
Value: TDateTime;
Text: XmlString;
begin
if InternalReadText(Element, XmlString(PPropInfo(PropInfo)^.Name), Text) then begin
if XMLStrToDateTime(Text, Value) then
SetFloatProp(Instance, PropInfo, Value)
else
raise EOmniXMLPersistent.CreateFmt('Error in datetime property %s', [PPropInfo(PropInfo)^.Name]);
end
else
SetFloatProp(Instance, PropInfo, 0); // 2004-02-02
end;
procedure ReadStrProp;
var
Value: XmlString;
{$IFDEF UNICODE}
TypeData: PTypeData;
CP: Word;
RBS: RawByteString;
{$ENDIF} // UNICODE
begin
if not InternalReadText(Element, XmlString(PPropInfo(PropInfo)^.Name), Value) then
Value := '';
case PropType^.Kind of
tkWString: SetWideStrProp(Instance, PropInfo, Value);
{$IFDEF UNICODE}
tkLString:
begin
TypeData := GetTypeData(PropType);
CP := TypeData^.CodePage;
case CP of
CP_ACP: SetAnsiStrProp(Instance, PropInfo, AnsiString(Value)); // default code page
CP_UNICODE: SetUnicodeStrProp(Instance, PropInfo, Value); // Unicode code page
else
// convert to valid codepage using RawByteString
RBS := UTF8Encode(Value);
if CP <> CP_RawByteString then
SetCodePage(RBS, CP, True);
SetAnsiStrProp(Instance, PropInfo, RBS);
end;
end;
{$ENDIF} // UNICODE
else
SetStrProp(Instance, PropInfo, Value);
end;
end;
procedure ReadOrdProp;
var
Value: XmlString;
IntValue: Integer;
BoolValue: Boolean;
begin
if InternalReadText(Element, XmlString(PPropInfo(PropInfo)^.Name), Value) then begin
case PropType^.Kind of
tkInteger:
if XMLStrToInt(Value, IntValue) then
SetOrdProp(Instance, PropInfo, XMLStrToIntDef(Value, 0))
else
raise EOmniXMLPersistent.CreateFmt('Invalid integer value (%s).', [Value]);
tkChar:
begin
{$IFDEF UNICODE}
SetOrdProp(Instance, PropInfo, Ord(Char(Value[1])));
{$ELSE}
SetOrdProp(Instance, PropInfo, Ord(Char(Utf8ToAnsi(UTF8Encode(Value))[1])));
{$ENDIF} // UNICODE
end;
tkWChar: SetOrdProp(Instance, PropInfo, Cardinal(Value[1]));
tkSet: SetSetProp(Instance, PropInfo, Value);
tkEnumeration:
begin
if PropType = System.TypeInfo(Boolean) then begin
if XMLStrToBool(Value, BoolValue) then
SetOrdProp(Instance, PropInfo, Ord(BoolValue))
else
raise EOmniXMLPersistent.CreateFmt('Invalid boolean value (%s).', [Value]);
end
else if PropType^.Kind = tkInteger then begin
if XMLStrToInt(Value, IntValue) then
SetOrdProp(Instance, PropInfo, IntValue)
else
raise EOmniXMLPersistent.CreateFmt('Invalid enum value (%s).', [Value]);
end
// 2003-05-27 (mr): added tkEnumeration processing
else if PropType^.Kind = tkEnumeration then
SetEnumProp(Instance, PropInfo, Value);
end;
end;
end
else
SetOrdProp(Instance, PropInfo, PPropInfo(PropInfo)^.Default)
end;
procedure ReadInt64Prop;
var
Value: XmlString;
IntValue: Int64;
begin
if InternalReadText(Element, XmlString(PPropInfo(PropInfo)^.Name), Value) then begin
if XMLStrToInt64(Value, IntValue) then
SetInt64Prop(Instance, PropInfo, IntValue)
else
raise EOmniXMLPersistent.CreateFmt('Invalid int64 value (%s).', [Value]);
end
else
SetFloatProp(Instance, PropInfo, 0)
end;
procedure ReadObjectProp;
var
Value: TObject;
PropNode: IXMLElement;
procedure ReadStrings(const Strings: TStrings);
var
i: Integer;
Count: Integer;
Value: XmlString;
begin
Strings.Clear;
Count := GetNodeAttrInt(PropNode, StringS_COUNT_NODENAME, 0);
for i := 0 to Count - 1 do
Strings.Add('');
for i := 0 to Strings.Count - 1 do begin
if InternalReadText(PropNode, StringS_PREFIX + IntToStr(i), Value) then
Strings[i] := Value;
end;
end;
begin
Value := TObject(GetOrdProp(Instance, PropInfo));
if (Value <> nil) and (Value is TPersistent) then begin
PropNode := FindElement(Element, XmlString(PPropInfo(PropInfo)^.Name));
Read(TPersistent(Value), PropNode);
if Value is TCollection then
ReadCollection(TCollection(Value), PropNode)
else if Value is TStrings then
ReadStrings(TStrings(Value));
end;
end;
begin
PropType := PPropInfo(PropInfo)^.PropType^;
if (PPropInfo(PropInfo)^.GetProc <> nil) and
((PropType^.Kind = tkClass) or (PPropInfo(PropInfo)^.SetProc <> nil)) and
(IsStoredProp(Instance, PPropInfo(PropInfo))) then
begin
case PropType^.Kind of
tkInteger, tkChar, tkWChar, tkEnumeration, tkSet: ReadOrdProp;
tkString, tkLString, tkWString {$IFDEF UNICODE}, tkUString {$ENDIF}: ReadStrProp;
tkFloat:
if (PropType = System.TypeInfo(TDateTime)) or (PropType = System.TypeInfo(TTime))
or (PropType = System.TypeInfo(TDate)) then
ReadDateTimeProp
else
ReadFloatProp;
tkInt64: ReadInt64Prop;
tkClass: ReadObjectProp;
end;
end;
end;
procedure TOmniXMLReader.Read(Instance: TPersistent; Root: IXMLElement; const ReadRoot: Boolean);
var
PropCount: Integer;
PropList: PPropList;
i: Integer;
PropInfo: PPropInfo;
begin
if ReadRoot then
Root := FindElement(Root, Instance.ClassName);
if Root = nil then
Exit;
PropCount := GetTypeData(Instance.ClassInfo)^.PropCount;
if PropCount > 0 then begin
GetMem(PropList, PropCount * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);
for i := 0 to PropCount - 1 do begin
PropInfo := PropList^[I];
if PropInfo = nil then
Break;
ReadProperty(Instance, PropInfo, Root);
end;
finally
FreeMem(PropList, PropCount * SizeOf(Pointer));
end;
end;
end;
end.