omnixmlpersistent.pas

OmniXML源码

  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)
    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: WideString);
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: String): 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: String; var Value: WideString): 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: WideString;
  begin
    if InternalReadText(Element, PPropInfo(PropInfo)^.Name, Text) then
      Value := XMLStrToRealDef(Text, 0)
    else
      Value := 0;
    SetFloatProp(Instance, PropInfo, Value)
  end;

  procedure ReadDateTimeProp;
  var
    Value: TDateTime;
    Text: WideString;
  begin
    if InternalReadText(Element, 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: WideString;
  begin
    if InternalReadText(Element, PPropInfo(PropInfo)^.Name, Value) then
      SetStrProp(Instance, PropInfo, Value)
    else
      SetStrProp(Instance, PropInfo, '');
  end;

  procedure ReadOrdProp;
  var
    Value: WideString;
    IntValue: Integer;
    BoolValue: Boolean;
  begin
    if InternalReadText(Element, 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: SetOrdProp(Instance, PropInfo, Ord(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: WideString;
    IntValue: Int64;
  begin
    if InternalReadText(Element, 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: WideString;
    begin
      Strings.Clear;

      Count := GetNodeAttrInt(PropNode, StringS_COUNT_NODENAME, 0);
      for i := 0 to Count 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, 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
  if (PPropInfo(PropInfo)^.SetProc <> nil) and (PPropInfo(PropInfo)^.GetProc <> nil) then begin
    PropType := PPropInfo(PropInfo)^.PropType^;
    case PropType^.Kind of
      tkInteger, tkChar, tkEnumeration, tkSet: ReadOrdProp;
      tkString, tkLString, tkWString: 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.