{ ------------------------------------------------------------- }
{ Purpose : Next Standard 6                                     }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2021. All Rights Reserved.         }
{ ------------------------------------------------------------- }
unit NxXMLDoc6;

interface

uses
  { Standard }
  Classes, Types,
  { XML }
  XMLDoc, XMLIntf,
  { Next Standard 6 }
  NxIntf6, NxTypes6, NxConsts6, NxNodes6;

const
  stXMLOpen = '<?xml version="1.0" encoding="UTF-8"?>';

type
  { INxXMLDocument }

  INxXMLNodeList = interface;

  INxXMLAttribute = interface
    ['{1F70D27B-9253-42CF-91F7-DB1AB32AC69D}']
    { Property Accessors }
    function GetName: WideString;
    function GetValue: Variant;
    procedure SetName(const Value: WideString);
    procedure SetValue(const Value: Variant);
    { Properties }
    property Name: WideString read GetName write SetName;
    property Value: Variant read GetValue write SetValue;
  end;

  INxXMLNode = interface(INxNode)
    ['{95B49BFD-E518-4D83-B889-C15A1C2E6C95}']
    { Property Accessors }
    function GetAsXML: WideString;
    function GetAttributeByName(const AttrName: WideString): Variant;
    function GetAttributeCount: Integer;
    function GetAttributeName(const Index: Integer): string;
    function GetChildNodes: INxXMLNodeList; overload;
    function GetNodeName: WideString;
    function GetText: WideString;
    procedure SetAttributeByName(const AttrName: WideString; const Value: Variant);
    procedure SetNodeName(const Value: WideString);
    procedure SetText(const Value: WideString);
    { Methods }
    function HasAttribute(const Name: WideString): Boolean;
    function IndexOfAttribute(const AttrName: WideString): Integer;
    function IndexOfAttributeValue(const AttrName: WideString): Integer;
    { Properties }
    property AsXML: WideString read GetAsXML;
    property AttributeCount: Integer read GetAttributeCount;
    property AttributeName[const Index: Integer]: string read GetAttributeName;
    property Attributes[const AttrName: WideString]: Variant read GetAttributeByName write SetAttributeByName;
    property ChildNodes: INxXMLNodeList read GetChildNodes;
    property NodeName: WideString read GetNodeName write SetNodeName;
    property Text: WideString read GetText write SetText;
  end;

  INxXMLNodeList = interface
    ['{58EE08F7-4967-4147-843B-74DA90D02073}']
    { Property Accessors }
    function GetCount: Integer;
    function GetNode(const IndexOrName: Variant): INxXMLNode;
    function GetOwnerNode: INxXMLNode;
    { Methods }
    function Add(const Node: INxXMLNode): Integer; overload;
    function Add(const NodeName: WideString): INxXMLNode; overload;
    procedure Clear;
    function IndexOf(const Node: INxXMLNode): Integer;
    function FindNode(const NodeName: WideString): INxXMLNode;
    function Remove(const Node: INxXMLNode): Integer;
    { Properties }
    property Count: Integer read GetCount;
    property Nodes[const IndexOrName: Variant]: INxXMLNode read GetNode; default;
    property OwnerNode: INxXMLNode read GetOwnerNode;
  end;

  { TNxNode }

  TNxNode = class(TInterfacedObject, INxNode, IWeakly)
  private
    { Property Fields }
    FParentNode: IWeakReference;
    FWeakReference: IWeakReference;
    { Property Accessors }
    function GetAbsoluteIndex: Integer;
    function GetChildNodes: INxNodeList;
    function GetCount: Integer;
    function GetHasChildren: Boolean;
    function GetHidden: Boolean;
    function GetLevel: Integer;
    function GetParentNode: INxNode;
    procedure SetIndex(const Value: Integer);
    procedure SetParentNode(const Value: INxNode);
  protected
    { IWeakly }
    function WeakReference: IWeakReference; stdcall;
    { INxObject }
    function ToObject: TObject;
    { INxBase }
    function GetAsBoolean: Boolean; virtual;
    function GetAsDateTime: TDateTime; virtual;
    function GetAsFloat: Double; virtual;
    function GetAsInt64: Int64; virtual;
    function GetAsInteger: Integer; virtual;
    function GetAsString: WideString; virtual;
    function GetAsUTF8String: UTF8String; virtual;
    function GetIsNull: Boolean; virtual;
    procedure SetAsBoolean(const Value: Boolean); virtual;
    procedure SetAsDateTime(const Value: TDateTime); virtual;
    procedure SetAsFloat(const Value: Double); virtual;
    procedure SetAsInt64(const Value: Int64); virtual;
    procedure SetAsInteger(const Value: Integer); virtual;
    procedure SetAsString(const Value: WideString); virtual;
    procedure SetAsUTF8String(const Value: UTF8String); virtual;
    { INxNode }
    procedure DoChildAdd(const Node: INxNode); virtual; abstract;
    function GetChildCount: Integer; virtual;
    function GetChildNode(Index: Integer): INxNode; virtual; abstract;
  public
    constructor Create;
    { Methods }
    procedure AssignValue(Source: INxBase);
    procedure ClearChildren;
    function GetIndex: Integer; virtual; abstract;
    function IndexOf(const Node: INxNode): Integer; virtual; abstract;
    function IsTopLevel: Boolean;
    function NextSibling: INxNode; virtual;
    procedure Release;
    procedure Remove;
    procedure RemoveChild;
    { Properties }
    property AbsoluteIndex: Integer read GetAbsoluteIndex;
    property ChildCount: Integer read GetChildCount;
    property ChildNode[Index: Integer]: INxNode read GetChildNode;
    property ChildNodes: INxNodeList read GetChildNodes;
    property Count: Integer read GetCount;
    property HasChildren: Boolean read GetHasChildren;
    property Index: Integer read GetIndex write SetIndex;
    property Level: Integer read GetLevel;
    property ParentNode: INxNode read GetParentNode write SetParentNode;
  end;

  TNxXMLNodeList = class(TInterfacedObject, INxXMLNodeList)
  private
    FNodes: TInterfaceList;
    FOwnerNode: IWeakReference;
    { Property Accessors }
    function GetCount: Integer;
    function GetNode(const IndexOrName: Variant): INxXMLNode;
    function GetOwnerNode: INxXMLNode;
    procedure SetOwnerNode(const Value: INxXMLNode);
  public
    constructor Create(AOwner: INxXMLNode);
    destructor Destroy; override;
    { Methods }
    function Add(const Node: INxXMLNode): Integer; overload;
    function Add(const NodeName: WideString): INxXMLNode; overload;
    procedure Clear;
    function FindNode(const NodeName: WideString): INxXMLNode;
    function IndexOf(const Node: INxXMLNode): Integer;
    function Remove(const Node: INxXMLNode): Integer;
    { Properties }
    property Count: Integer read GetCount;
    property Nodes[const IndexOrName: Variant]: INxXMLNode read GetNode; default;
    property OwnerNode: INxXMLNode read GetOwnerNode;
  end;

  { TNxXMLNode }

  TNxXMLAttribute = class(TInterfacedObject, INxXMLAttribute)
  private
    { Property Fields }
    FName: WideString;
    FValue: Variant;
    { Property Accessors }
    function GetName: WideString;
    function GetValue: Variant;
    procedure SetName(const Value: WideString);
    procedure SetValue(const Value: Variant);
  public
    constructor Create(const AttributeName: WideString); virtual;
    { Properties }
    property Name: WideString read GetName write SetName;
    property Value: Variant read GetValue write SetValue;
  end;

  TNxXMLNode = class(TNxNode, INxXMLNode)
  private
    FAttributes: TInterfaceList;
    { Property Fields }
    FChildNodes: INxXMLNodeList;
    FNodeName: WideString;
    FText: WideString;
    { Property Accessors }
    function GetAttributeByName(const AttrName: WideString): Variant;
    function GetAttributeCount: Integer;
    function GetAttributeName(const Index: Integer): string;
    function GetNodeName: WideString;
    function GetText: WideString;
    procedure SetAttributeByName(const AttrName: WideString; const Value: Variant);
    procedure SetNodeName(const Value: WideString);
    procedure SetText(const Value: WideString);
  protected
    procedure DoChildAdd(const Node: INxNode); override;
    function GetChildCount: Integer; override;
    function GetChildNode(Index: Integer): INxNode; override;
    function GetChildNodes: INxXMLNodeList; overload;
    { INxBase }
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  public
    constructor Create(ANodeName: WideString = '');
    destructor Destroy; override;
    { Virtual Methods }
    function GetAsXML: WideString; virtual;
    function GetAttribute(const Index: Integer): INxXMLAttribute;
    function GetIndex: Integer; override;
    { Methods }
    function HasAttribute(const Name: WideString): Boolean;
    function IndexOf(const Node: INxNode): Integer; override;
    function IndexOfAttribute(const AttrName: WideString): Integer;
    function IndexOfAttributeValue(const AttrName: WideString): Integer;
    { Properties }
    property AsXML: WideString read GetAsXML;
    property AttributeCount: Integer read GetAttributeCount;
    property Attributes[const AttrName: WideString]: Variant read GetAttributeByName write SetAttributeByName;
    property ChildNodes: INxXMLNodeList read GetChildNodes;
    property NodeName: WideString read GetNodeName write SetNodeName;
    property Text: WideString read GetText write SetText;
  end;

  { TNxXMLDocument }

  TNxXMLParserState = set of (
    ptAttributesReading, ptAttributeReading, ptAttributeValueReading,
    psTagOpening, psTagReading, psTagClosing, ptValueReading);

  TNxXMLDocument6 = class(TComponent)
  private
    FDocumentElement: INxXMLNode;
    FFileHeader: WideString;
    { Property Accessors }
    function GetDocumentElement: INxXMLNode;
    procedure SetDocumentElement(const Value: INxXMLNode);
    function LoadTextFile(const FileName: WideString): WideString;
    function GetStrings: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    { Methods }
    procedure Clear;
    procedure LoadFromFile(const AFileName: WideString);
    procedure LoadFromText(const Text: WideString);
    function ObjectToNode(AObject: TObject; ANodeName: string = 'Object'): INxXMLNode;
    procedure SaveToXML(var XML: WideString);
    procedure SaveToFile(const FileName: WideString; Encoding: TNxEncoding = ekUnicode);
    { Properties }
    property DocumentElement: INxXMLNode read GetDocumentElement write SetDocumentElement;
    property Strings: TStrings read GetStrings;
  published
    property FileHeader: WideString read FFileHeader write FFileHeader;
  end;

  { TNxXMLSerialize }

  TNxProcessObjectEvent = procedure(Sender: TObject) of object;

  TNxXMLSerialize = class
  private
    FSource: TObject;
  protected
    procedure Serialize(Instance: TObject; Node: IXMLNode);
  public
    constructor Create(Source: TObject);
    procedure SaveToXML(FileName: string);
  end;

  { TNxJSONObject }

  TNxJSON6 = class;
  TNxJSONProperty = class;
  TNxJSONArray = class;

  TNxJSONObject = class
  private
    FKey: string;
    FList: TList;
    FOwner: TNxJSON6;
  public
    constructor Create(const AOwner: TNxJSON6; const AKey: string);
    destructor Destroy; override;
    { Methods }
    function AddArray(const AProperty: string = ''): TNxJSONObject;
    function AddObject(const AProperty: string = ''): TNxJSONObject;
    function AddProperty(const AInstance: TObject; const AProperty: string; const AText: string = ''): TNxJSONProperty;
    procedure Clear;
  end;

  { TNxJSONProperty }

  TNxJSONProperty = class(TNxJSONObject)
  private
    FInstance: TObject;
//    FTypeKind: TTypeKind;
  public
    constructor Create(const AOwner: TNxJSON6; const AKey: string; const AInstance: TObject); overload;
  end;

  { TNxJSONArray }

  TNxJSONArray = class(TNxJSONObject)

  end;

  { TNxJSON6 }

  TNxJSON6 = class
  private
    FList: TList;
    FIdentLevel: Integer;
  public
    constructor Create;
    { Methods }
    function AddArray(const AProperty: string = ''): TNxJSONProperty;
    function AddObject(const AProperty: string = ''): TNxJSONProperty;
    function AddProperty(const AInstance: TObject; const AProperty: string = ''): TNxJSONProperty;
    function ToJSON(const AInstance: TObject; const AProperty: string): string;
    procedure SaveToFile(const FileName: WideString; Encoding: TNxEncoding = ekUnicode);
    { Properties }
    property Objects: TList read FList write FList;
  end;

  procedure XMLNodeToObject(Node: INxXMLNode; AObject: TObject);
  procedure LoadProperties(AObject: TObject; AParentNode: INxXMLNode);

implementation

uses
  { Standard }
  Variants, SysUtils, StrUtils, Dialogs, Graphics,
  { TypeInfo }
  TypInfo,
  { Next Standard 6 }
  NxUtils6;

/// <summary>
/// Load Property tags of Node into AObject
/// </summary>
/// <param name="Node">
/// Node with Property child nodes
/// </param>
/// <param name="AObject">
/// Target TObject
/// </param>
procedure XMLNodeToObject(Node: INxXMLNode; AObject: TObject);
var
  i: Integer;
  PropertyNode: INxXMLNode;
  PropName, PropType: string;
  Value: Variant;
begin
  if Assigned(AObject) then
  begin
    for i := 0 to Pred(Node.ChildCount) do
    begin
      PropertyNode := Node.ChildNodes[i];
      if PropertyNode.NodeName = 'Property' then
      begin
        Value := PropertyNode.Text;
        PropName := PropertyNode.Attributes['Name'];
        PropType := PropertyNode.Attributes['Type'];

        if PropType = 'Char' then
        begin
          if Value = '#0' then Value := #0;
        end;
        if PropType = 'TColor' then Value := StringToColor(Value);

        try
          if PropType = 'String' then SetStrProp(AObject, PropName, Value)
          else if PropType = 'Char' then SetStrProp(AObject, PropName, Value)
          else if PropType = 'Float' then SetFloatProp(AObject, PropName, Value)
          else if PropType = 'Integer' then SetPropValue(AObject, PropName, Value)
          else if PropType = 'Enumeration' then SetEnumProp(AObject, PropName, Value)
          else if PropType = 'Set' then SetSetProp(AObject, PropName, Value)
          else SetPropValue(AObject, PropName, Value);
        except
          ShowMessage('Error reading property: ' + PropName);
        end;
      end;
    end;
  end;
end;

procedure LoadProperties(AObject: TObject; AParentNode: INxXMLNode);
var
  TypeKinds: TTypeKinds;

  procedure ReadProperty(const Instance: TObject; ANode: INxXMLNode);
  var
    PropName: string;
    PropValue: Variant;
    PropCount, i: Integer;
    PropList: PPropList;
    TypeKind: TTypeKind;
    AClass: TClass;
    AObj: TObject;
    Node: INxXMLNode;
    AType: string;
  begin
    { Can add }
    PropCount := GetPropList(Instance.ClassInfo, TypeKinds, nil);

    GetMem(PropList, PropCount * SizeOf(Pointer));

    GetPropList(Instance.ClassInfo, TypeKinds, PropList);

    for i := 0 to Pred(PropCount) do
    begin

      { Don't save read-only }
      if PropList[i]^.SetProc <> nil then
      begin
        PropName := String(PropList[i]^.Name);

        TypeKind := PropType(Instance, PropName);

        AType := '';

        case TypeKind of
          tkClass:
          begin
            Continue;

            AClass := GetObjectPropClass(Instance, PropList[i]);
            AObj := GetObjectProp(Instance, PropList[i], AClass);

            if Assigned(AObj) then
            begin

            end;

          end;

          tkString,
          tkWString,
          tkLString
          {$IFDEF UNICODE},tkUString{$ENDIF}: AType := 'String';

          tkWChar,
          tkChar,
          tkVariant: AType := 'Char';

          tkInteger,
          tkInt64: AType := 'Integer';

          tkFloat: AType := 'Float';

          tkSet: AType := 'Set';

          tkEnumeration: AType := 'Enumeration';

          else Continue;
        end;

        PropValue := GetPropValue(Instance, PropName, True);

        case TypeKind of
          tkChar, tkWChar, tkVariant: if PropValue = 0 then PropValue := '#0';
        end;

        Node := TNxXMLNode.Create('Property');

        Node.Attributes['Name'] := PropName;
        Node.Attributes['Type'] := AType;

        Node.AsString := PropValue;

        ANode.ChildNodes.Add(Node);

      end; { if ReadOnly }

    end; { for }

    FreeMem(PropList);
  end;

begin
  TypeKinds := [
    tkArray,
    tkChar,
    tkClass,
    tkDynArray,
    tkEnumeration,
    tkFloat,
    tkInt64,
    tkInteger,
    tkInterface,
    tkLString,
    tkMethod,
    tkRecord,
    tkSet,
    tkString,
    {$IFDEF UNICODE}tkUString,{$ENDIF}
    tkUnknown,
    tkVariant,
    tkWChar,
    tkWString
  ];

  { Add properties nodes }
  ReadProperty(AObject, AParentNode);
end;

{ TNxNode }

procedure TNxNode.AssignValue(Source: INxBase);
begin

end;

procedure TNxNode.ClearChildren;
begin

end;

constructor TNxNode.Create;
begin
  FWeakReference := TWeakReference.Create(Self);
end;

function TNxNode.GetAbsoluteIndex: Integer;
begin
  Result := -1;
end;

function TNxNode.GetAsBoolean: Boolean;
begin
  Result := False;
end;

function TNxNode.GetAsDateTime: TDateTime;
begin
  Result := 0;
end;

function TNxNode.GetAsFloat: Double;
begin
  Result := 0;
end;

function TNxNode.GetAsInt64: Int64;
begin
  Result := 0;
end;

function TNxNode.GetAsInteger: Integer;
begin
  Result := 0;
end;

function TNxNode.GetAsString: WideString;
begin
  Result := EmptyStr;
end;

function TNxNode.GetAsUTF8String: UTF8String;
begin
  Result := '';
end;

function TNxNode.GetChildCount: Integer;
begin
  Result := 0;
end;

function TNxNode.GetChildNodes: INxNodeList;
begin

end;

function TNxNode.GetCount: Integer;
begin
  Result := 0;
end;

function TNxNode.GetHasChildren: Boolean;
begin
  Result := ChildCount > 0;
end;

function TNxNode.GetHidden: Boolean;
begin
  Result := False;
end;

function TNxNode.GetIsNull: Boolean;
begin
  Result := False;
end;

function TNxNode.GetLevel: Integer;
begin
  if ParentNode = nil then Result := 0 else Result := Succ(ParentNode.Level);
end;

function TNxNode.GetParentNode: INxNode;
begin
  if Assigned(FParentNode) then
    Result := FParentNode.GetIntf as INxNode
  else
    Result := nil;
end;

function TNxNode.IsTopLevel: Boolean;
begin
  Result := Level = 0;
end;

function TNxNode.NextSibling: INxNode;
begin
  if Assigned(ParentNode) then
  begin
    if Index < Pred(ParentNode.Count) then
    begin
      Result := ParentNode.ChildNode[Succ(Index)];
    end;
  end;
end;

procedure TNxNode.Release;
begin

end;

procedure TNxNode.Remove;
begin

end;

procedure TNxNode.RemoveChild;
begin

end;

procedure TNxNode.SetAsBoolean(const Value: Boolean);
begin

end;

procedure TNxNode.SetAsDateTime(const Value: TDateTime);
begin

end;

procedure TNxNode.SetAsFloat(const Value: Double);
begin

end;

procedure TNxNode.SetAsInt64(const Value: Int64);
begin

end;

procedure TNxNode.SetAsInteger(const Value: Integer);
begin

end;

procedure TNxNode.SetAsString(const Value: WideString);
begin

end;

procedure TNxNode.SetAsUTF8String(const Value: UTF8String);
begin

end;

procedure TNxNode.SetIndex(const Value: Integer);
begin
  //TODO: Move Node inside Parent ChildList
end;

procedure TNxNode.SetParentNode(const Value: INxNode);
begin
  if Assigned(Value) then
    FParentNode := (Value AS IWeakly).WeakReference
  else
    FParentNode := nil;

  //TODO: Move Node to new Parent
end;

function TNxNode.ToObject: TObject;
begin
  Result := Self;
end;

function TNxNode.WeakReference: IWeakReference;
begin
  Result := FWeakReference;
end;

{ TNxXMLNodeList }

function TNxXMLNodeList.Add(const Node: INxXMLNode): Integer;
begin
  Result := FNodes.Add(Node as INxXMLNode);
  //TODO: Preserve recursion
  Node.ParentNode := OwnerNode;
end;

function TNxXMLNodeList.Add(const NodeName: WideString): INxXMLNode;
begin
  Result := TNxXMLNode.Create(NodeName);
  Add(Result);
end;

procedure TNxXMLNodeList.Clear;
begin
  FNodes.Clear;
end;

constructor TNxXMLNodeList.Create(AOwner: INxXMLNode);
begin
  FNodes := TInterfaceList.Create;
  SetOwnerNode(AOwner);
end;

destructor TNxXMLNodeList.Destroy;
begin
  FNodes.Free;
  inherited;
end;

function TNxXMLNodeList.FindNode(const NodeName: WideString): INxXMLNode;
var
  i: Integer;
begin
  for i := 0 to Pred(FNodes.Count) do
  begin
    if Nodes[i].NodeName = NodeName then
    begin
      Result := Nodes[i];
      Exit;
    end;
  end;
end;

function TNxXMLNodeList.GetCount: Integer;
begin
  Result := FNodes.Count;
end;

function TNxXMLNodeList.GetNode(const IndexOrName: Variant): INxXMLNode;
begin
  if VarIsNumeric(IndexOrName) then
  begin
    Result := INxXMLNode(FNodes[IndexOrName]);
  end else
  begin
    Result := FindNode(IndexOrName);
  end;
end;

function TNxXMLNodeList.GetOwnerNode: INxXMLNode;
begin
  if Assigned(FOwnerNode) then
    Result := FOwnerNode.GetIntf as INxXMLNode
  else
    Result := nil;
end;

function TNxXMLNodeList.IndexOf(const Node: INxXMLNode): Integer;
begin
  Result := FNodes.IndexOf(Node);
end;

function TNxXMLNodeList.Remove(const Node: INxXMLNode): Integer;
begin
  Result := FNodes.Remove(Node);
end;

procedure TNxXMLNodeList.SetOwnerNode(const Value: INxXMLNode);
begin
  if Assigned(Value) then
    FOwnerNode := (Value AS IWeakly).WeakReference
  else
    FOwnerNode := nil;
end;

{ TNxXMLAttribute }

constructor TNxXMLAttribute.Create(const AttributeName: WideString);
begin
  FName := AttributeName;
end;

function TNxXMLAttribute.GetName: WideString;
begin
  Result := FName;
end;

function TNxXMLAttribute.GetValue: Variant;
begin
  Result := FValue;
end;

procedure TNxXMLAttribute.SetName(const Value: WideString);
begin
  FName := Value;
end;

procedure TNxXMLAttribute.SetValue(const Value: Variant);
begin
  FValue := Value;
end;

{ TNxXMLNode }

constructor TNxXMLNode.Create(ANodeName: WideString);
begin
  inherited Create;
  FAttributes := TInterfaceList.Create;
  FChildNodes := TNxXMLNodeList.Create(Self);
  FNodeName := ANodeName;
  FText := '';
end;

destructor TNxXMLNode.Destroy;
begin
  FAttributes.Free;
  inherited;
end;

procedure TNxXMLNode.DoChildAdd(const Node: INxNode);
begin

end;

function TNxXMLNode.GetAsString: WideString;
begin
  Result := FText;
end;

function TNxXMLNode.GetAsXML: WideString;
var
  i, j: Integer;
  AAttribute: INxXMLAttribute;
begin
  Result := StringOfChar(Tab, Level);

  { Open Node }
  Result := Result + '<' + NodeName;

  for j := 0 to Pred(AttributeCount) do
  begin
    AAttribute := GetAttribute(j);

    Result := Result + ' ' + AAttribute.Name + '=' + DblQuotes(AAttribute.Value);
  end;

  if (Text = EmptyStr) and not HasChildren then
  begin
    Result := Result + ' />' + LnBreak;
    Exit;
  end;

  Result := Result + '>';

  { Node's value }
  if FText <> EmptyStr then
  begin
    Result := Result + Trim(FText);
  end;

  { Child nodes }
  if HasChildren then
  begin
    Result := Result + LnBreak;

    for i := 0 to Pred(ChildNodes.Count) do
    begin
      Result := Result + ChildNodes.Nodes[i].AsXML;
    end;

    Result := Result + StringOfChar(Tab, Level);
  end;

  { Close Node }
  Result := Result +  '</' + NodeName + '>' + LnBreak;
end;

function TNxXMLNode.GetAttributeByName(const AttrName: WideString): Variant;
var
  i: Integer;
begin
  for i := 0 to Pred(FAttributes.Count) do
  begin
    if CompareStr(AttrName, INxXMLAttribute(FAttributes[i]).Name) = CompareEqual then
    begin
      Result := INxXMLAttribute(FAttributes[i]).Value;
      Exit;
    end;
  end;
end;

function TNxXMLNode.GetAttribute(const Index: Integer): INxXMLAttribute;
begin
  Result := INxXMLAttribute(FAttributes[Index]);
end;

function TNxXMLNode.GetAttributeCount: Integer;
begin
  Result := FAttributes.Count;
end;

function TNxXMLNode.GetAttributeName(const Index: Integer): string;
begin
  Result := GetAttribute(Index).Name;
end;

function TNxXMLNode.GetChildCount: Integer;
begin
  Result := FChildNodes.Count;
end;

function TNxXMLNode.GetChildNode(Index: Integer): INxNode;
begin
  Result := ChildNodes[Index];
end;

function TNxXMLNode.GetChildNodes: INxXMLNodeList;
begin
  Result := FChildNodes;
end;

function TNxXMLNode.GetIndex: Integer;
begin
  if Assigned(ParentNode) then Result := ParentNode.IndexOf(Self) else Result := 0;
end;

function TNxXMLNode.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

function TNxXMLNode.GetText: WideString;
begin
  Result := FText;
end;

function TNxXMLNode.HasAttribute(const Name: WideString): Boolean;
begin
  Result := IndexOfAttribute(Name) <> -1;
end;

function TNxXMLNode.IndexOf(const Node: INxNode): Integer;
begin
  Result := ChildNodes.IndexOf(INxXMLNode(Node));
end;

function TNxXMLNode.IndexOfAttribute(const AttrName: WideString): Integer;
var
  i: Integer;
  Attribute: INxXMLAttribute;
begin
  for i := 0 to Pred(AttributeCount) do
    if Supports(FAttributes[i], INxXMLAttribute, Attribute) then
    begin
      if Attribute.Name = AttrName then
      begin
        Result := i;
        Exit;
      end;
    end;

  Result := -1; { Not Found }
end;

function TNxXMLNode.IndexOfAttributeValue(const AttrName: WideString): Integer;
var
  i: Integer;
begin
  for i := 0 to Pred(AttributeCount) do
    if Attributes[AttrName] = AttrName then
    begin
      Result := i;
      Exit;
    end;

  Result := -1; { Not Found }
end;

procedure TNxXMLNode.SetAsString(const Value: WideString);
begin
  FText := Value;
end;

procedure TNxXMLNode.SetAttributeByName(const AttrName: WideString; const Value: Variant);
var
  AAttribute: INxXMLAttribute;
begin
  if HasAttribute(AttrName) then
  begin
//    ShowMessage('error');
//    Attributes[AttrName] := Value;
  end else
  begin
    AAttribute := TNxXMLAttribute.Create(AttrName);
    AAttribute.Value := Value;

    { Add into TList }
    FAttributes.Add(AAttribute);
  end;
end;

procedure TNxXMLNode.SetNodeName(const Value: WideString);
begin
  FNodeName := Value;
end;

procedure TNxXMLNode.SetText(const Value: WideString);
begin
  FText := Value;
end;

{ TNxXMLDocument }

procedure TNxXMLDocument6.Clear;
begin
  DocumentElement := nil;
end;

constructor TNxXMLDocument6.Create(AOwner: TComponent);
begin
  inherited;
  FFileHeader := stXMLOpen;
end;

function TNxXMLDocument6.GetDocumentElement: INxXMLNode;
begin
  Result := FDocumentElement;
end;

function TNxXMLDocument6.GetStrings: TStrings;
var
  Indentation: Integer;
  procedure ReadNode(ANode: INxXMLNode);
  var
    i: Integer;
  begin
    Inc(Indentation, 2);
    for i := 0 to Pred(ANode.ChildCount) do
    begin
      Result.Add(Format('%s<%s>', [DupeString('  ', Indentation), ANode.ChildNodes[i].NodeName]));
      if ANode.ChildNodes[i].HasChildren
        then ReadNode(ANode.ChildNodes[i]);
    end;
    Dec(Indentation, 2);
  end;
begin
  Result := TStringList.Create;
  if Assigned(FDocumentElement) then ReadNode(FDocumentElement);
end;

procedure TNxXMLDocument6.LoadFromFile(const AFileName: WideString);
var
  Text: WideString;
begin
  Text := LoadTextFile(AFileName);
  LoadFromText(Text);
end;

procedure TNxXMLDocument6.LoadFromText(const Text: WideString);
var
  i: Integer;
  State: TNxXMLParserState;

  procedure ReadProlog;
  var
    Ch: WideChar;
  begin

    while i < Length(Text) do
    begin
      Ch := Text[i];

      Inc(i);

      if ch = '>' then
      begin
        Exit;
      end;

    end;
  end;

  function ReadTag(Node: INxXMLNode): WideString;
  var
    Attribute, AttributeValue: WideString;
    Tag: WideString;
    TagNode: INxXMLNode;
//    QuoteNo: Integer;

    Ch: WideChar;
  begin
    Tag := '';
    TagNode := nil;
    Result := '';

    while i < Length(Text) do
    begin
      Ch := Text[i];

      { Open child or close current tag? }

      if psTagOpening in State then
      begin

        if Ch = '/' then
        begin
          Inc(i);
          State := [];
          Tag := '';
//          Exit;
        end;

      end;

      if Ch = '<' then
      begin
        Inc(i);
        Ch := Text[i];

        { Close tag }
        if Ch = '/' then
        begin
          Inc(i); { Skip `/` }

          State := [psTagClosing];

          { Skip until `>` }
          while (i < Length(Text)) and (Text[i] <> '>') do
          begin
            Inc(i);
          end;

          Exit;

        end else
        begin
          State := [psTagReading, psTagOpening];
        end;


      end;

      { Tag still open (reading Tag & attribs.) }
      if psTagOpening in State then
      begin

        { Tag is ready & can be added? }
        if CharInSet(Ch, ['>', ' ']) then
        begin

          if psTagReading in State then
          begin
            TagNode := TNxXMLNode.Create(Tag);

            if Node = nil then DocumentElement := TagNode
              else Node.ChildNodes.Add(TagNode);

            { Stop reading, both chars accepted }
            State := State - [psTagReading];
          end;

          if Ch = ' ' then
          begin

            if not(ptAttributeReading in State) then
            begin
              { Don't continue reading Tag.
                Now we are on attributes }
              State := State - [psTagReading];

              { Start reading attributes }
              State := State + [ptAttributesReading, ptAttributeReading];

              Attribute := '';
              AttributeValue := '';

              State := State - [ptAttributeValueReading];
            end;

          end

          { Tag in opening state &
            recursing into child Tag }

          else if Ch = '>' then
          begin
            Inc(i);
            State := [ptValueReading];
            TagNode.Text := ReadTag(TagNode);
            Tag := '';
          end;

          Inc(i);
          Continue;
        end;

        if psTagReading in State then
        begin
          Tag := Tag + Ch;
        end;
      end;

      { Attributes }

      if ptAttributesReading in State then
      begin

        { Attribute }
        if ptAttributeReading in State then
        begin

          if Ch = '=' then
          begin
            State := State - [ptAttributeReading];

            Inc(i);
            Continue;

          end;

          Attribute := Attribute + Ch;
        end;

        if Ch = '"' then
        begin

          { AttributeValue }
          if ptAttributeValueReading in State then
          begin

            { Add this created Attribute }
            TagNode.Attributes[Attribute] := AttributeValue;

            State := State - [ptAttributeValueReading];

            Attribute := '';
            AttributeValue := '';

          end else
          begin
            State := State + [ptAttributeValueReading];
            AttributeValue := '';
          end;

        end else
        begin

          if ptAttributeValueReading in State then
          begin
            AttributeValue := AttributeValue + Ch;
          end;

        end;

      end; { ptAttributesReading }

      if ptValueReading in State then
      begin
        Result := Result + Ch;
      end;

      Inc(i);

    end; { while }

  end;

begin
  Clear;

  i := 0;
  State := [];

  ReadProlog;
  ReadTag(nil);
end;

function GetUnicodeEncoding(const FileName: string): TNxUnicodeEncoding;
var
  FileHandle: File of Byte;
  b: Byte;
begin
  Result := [];
  AssignFile(FileHandle, FileName);
  try
    Reset(FileHandle);
    if FileSize(FileHandle) >= 2 then
    begin
      Read(FileHandle, b);
      if b = 255 then
      begin
        Read(FileHandle, b);
        if b = 254 then Result := [ueUnicode];
      end
      else if b = 254 then
      begin
        Read(FileHandle, b);
        if b = 255 then Result := [ueUnicode, ueBigEndian];
      end;
    end;
  finally
    Close(FileHandle);
  end;
end;

function TNxXMLDocument6.LoadTextFile(const FileName: WideString): WideString;
var
  w: Word;
  fw: File of WideChar;
  FileAnsi: File of Char;
  wc: WideChar;
  Ch: Char;
  EofF: Boolean;
  Encoding: TNxUnicodeEncoding;
begin
  Result := '';
  Encoding := GetUnicodeEncoding(FileName);

  if ueUnicode in Encoding then
  begin
    AssignFile(fw, Filename);
    FileMode := 0;
    Reset(fw);
    { ignore first widechar }
    Read(fw, wc);
    EofF := Eof(fw);
  end else
  begin
    AssignFile(FileAnsi, Filename);
    FileMode := 0;
    Reset(FileAnsi);
    EofF := Eof(FileAnsi);
  end;

  while not EofF do
  begin
    if ueUnicode in Encoding then
    begin
      Read(fw, wc);
      if ueBigEndian in Encoding then
      begin
        w := Ord(wc);
        wc := Widechar(((w and $255) shl 8) + (w  shr 8)); { rotate bytes }
      end;
      EofF := Eof(fw);
    end else
    begin
      Read(FileAnsi, ch);
      wc := WideChar(ch);
      EofF := Eof(FileAnsi);
    end;

    if (wc <> #13) and (wc <> #10) and (wc <> #9) and (wc <> #9) then
    begin
      Result := Result + wc;
    end;
  end;
  if ueUnicode in Encoding then Close(fw) else Close(FileAnsi);
end;

function TNxXMLDocument6.ObjectToNode(AObject: TObject; ANodeName: string = 'Object'): INxXMLNode;
begin
  Result := TNxXMLNode.Create(ANodeName);

  Result.Attributes['Type'] := AObject.ClassName;
  if AObject is TComponent then
  begin
    Result.Attributes['Name'] := TComponent(AObject).Name;
  end;

  LoadProperties(AObject, Result);
end;

procedure TNxXMLDocument6.SaveToFile(const FileName: WideString; Encoding: TNxEncoding);

  procedure WriteUnicode;
  var
    i: Integer;
    F: file of WideChar;
    S: WideString;
    C: WideChar;
  begin
    AssignFile(F, FileName);
    Rewrite(F);
    try

      { Header }
      case Encoding of
        ekUnicode: C := #$FEFF;
        ekUnicodeBigEndian: C := #$FFFE;
      end;

      Write(F, C);

      S := FileHeader + LnBreak + DocumentElement.AsXML;

      for i := 1 to Length(S)
        do Write(F, S[i]);

    finally
      CloseFile(F);
    end;
  end;

begin
  case Encoding of
    ekAnsi: ;
    ekUnicode, ekUnicodeBigEndian: WriteUnicode;
  end;
end;

procedure TNxXMLDocument6.SaveToXML(var XML: WideString);
begin
  XML := DocumentElement.AsXML;
end;

procedure TNxXMLDocument6.SetDocumentElement(const Value: INxXMLNode);
begin
  FDocumentElement := Value;
end;

{ TNxXMLSerialize }

constructor TNxXMLSerialize.Create(Source: TObject);
begin
  FSource := Source;
end;

procedure TNxXMLSerialize.SaveToXML(FileName: string);
var
  XML: IXMLDocument;
begin
  XML := NewXMLDocument;

  XML.Encoding := 'utf-8';
  XML.Options := [doNodeAutoIndent];
  XML.ParseOptions := [poValidateOnParse];

  Serialize(FSource, XML.AddChild('Properties'));

  XML.SaveToFile(FileName);
end;

procedure TNxXMLSerialize.Serialize(Instance: TObject; Node: IXMLNode);
var
  AClass: TClass;
  AObj: TObject;
  PropCount, i: Integer;
  TypeKinds: TTypeKinds;
  PropName: string;
  PropList: PPropList;
  PropNode: IXMLNode;
begin
  TypeKinds := [
    tkInteger,
    tkChar,
    tkEnumeration,
    tkFloat,
    tkString,
    tkSet,
    tkClass,
    tkWChar,
    tkLString,
    tkWString,
    {$IFDEF UNICODE}tkUString,{$ENDIF}
    tkVariant,
    tkArray,
    tkRecord,
    tkInterface,
    tkInt64,
    tkDynArray
  ];

  PropCount := GetPropList(Instance.ClassInfo, TypeKinds, nil);

  GetMem(PropList, PropCount * SizeOf(Pointer));

  GetPropList(Instance.ClassInfo, TypeKinds, PropList);

  for i := 0 to Pred(PropCount) do
  begin
    PropName := String(PropList[i]^.Name);

    PropNode := Node.AddChild('Property');

    PropNode.Attributes['Name'] := PropName;

    case PropType(Instance, PropName) of
      tkClass:
      begin
        AClass := GetObjectPropClass(Instance, PropList[i]);
        AObj := GetObjectProp(Instance, PropList[i], AClass);
        if Assigned(AObj) then
        begin
          Serialize(AObj, PropNode);
        end;
      end;
      tkEnumeration: PropNode.NodeValue := GetEnumProp(Instance, PropName);
      tkSet: PropNode.NodeValue := GetSetProp(Instance, PropName);
      tkString, tkWString, tkLString, {$IFDEF UNICODE}tkUString,{$ENDIF}
      tkWChar,
      tkChar: PropNode.NodeValue := GetStrProp(Instance, PropName);
      tkVariant: PropNode.NodeValue := GetVariantProp(Instance, PropName);
      tkInteger: PropNode.NodeValue := GetOrdProp(Instance, PropName);
      tkInt64: PropNode.NodeValue := GetInt64Prop(Instance, PropName);
      tkFloat: PropNode.NodeValue := GetFloatProp(Instance, PropName)
    end;
  end;
end;

{ TNxJSON6 }

{$WARNINGS OFF}
{$HINTS OFF}

function TNxJSON6.AddArray(const AProperty: string): TNxJSONProperty;
begin
  Result := nil;
end;

function TNxJSON6.AddObject(const AProperty: string): TNxJSONProperty;
begin
//  Result := TNxJSONProperty(AProperty, nil);
//  FList.Add(Result);
  Result := nil;
end;

function TNxJSON6.AddProperty(const AInstance: TObject;
  const AProperty: string): TNxJSONProperty;
begin
//  Result := TNxJSONProperty(AInstance, AProperty);
//  FList.Add(Result);
  Result := nil;
end;

constructor TNxJSON6.Create;
begin
  FIdentLevel := 0;
end;

procedure TNxJSON6.SaveToFile(const FileName: WideString;
  Encoding: TNxEncoding);
var
  JSONFile: TextFile;
begin

end;

function TNxJSON6.ToJSON(const AInstance: TObject; const AProperty: string): string;
var
  AClass: TClass;
  TypeKinds: TTypeKinds;
  PropInfo: PPropInfo;
  PropValue: string;
begin
//  TypeKinds := [
//    tkInteger,
//    tkChar,
//    tkEnumeration,
//    tkFloat,
//    tkString,
//    tkSet,
//    tkClass,
//    tkWChar,
//    tkLString,
//    tkWString,
//    {$IFDEF UNICODE}tkUString,{$ENDIF}
//    tkVariant,
//    tkArray,
//    tkRecord,
//    tkInterface,
//    tkInt64,
//    tkDynArray
//  ];
//
//  PropInfo := GetPropInfo(AInstance, AProperty, TypeKinds);
//
//  case PropType(AInstance, AProperty) of
//    tkClass:
//    begin
////        AClass := GetObjectPropClass(Instance, PropList[i]);
////        AObj := GetObjectProp(Instance, PropList[i], AClass);
////        if Assigned(AObj) then
////        begin
////          Serialize(AObj, PropNode);
////        end;
//    end;
//    tkEnumeration: PropValue := GetEnumProp(AInstance, AProperty);
//    tkSet: PropValue := GetSetProp(AInstance, AProperty);
//    tkString, tkWString, tkLString, {$IFDEF UNICODE}tkUString,{$ENDIF}
//    tkWChar,
//    tkChar: PropValue := GetStrProp(AInstance, AProperty);
//    tkVariant: PropValue := GetVariantProp(AInstance, AProperty);
//    tkInteger: PropValue := GetOrdProp(AInstance, AProperty);
//    tkInt64: PropValue := GetInt64Prop(AInstance, AProperty);
//    tkFloat: PropValue := GetFloatProp(AInstance, AProperty)
//  end;
//
//  Result := PropInfo.Name + ': ' + PropValue;
end;

{ TNxJSONObject }

function TNxJSONObject.AddArray(const AProperty: string): TNxJSONObject;
begin
  Result := nil;
end;

function TNxJSONObject.AddObject(const AProperty: string): TNxJSONObject;
begin
  Result := nil;
end;

function TNxJSONObject.AddProperty(const AInstance: TObject;
  const AProperty: string; const AText: string = ''): TNxJSONProperty;
begin
  Result := nil;
end;

procedure TNxJSONObject.Clear;
var
  i: Integer;
begin
  for i := 0 to Pred(FList.Count) do TObject(FList[i]).Free;
  FList.Clear;
end;

constructor TNxJSONObject.Create(const AOwner: TNxJSON6; const AKey: string);
begin
  FOwner := AOwner;
  FKey := AKey;
  FList := TList.Create;
end;

destructor TNxJSONObject.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

{ TNxJSONProperty }

constructor TNxJSONProperty.Create(const AOwner: TNxJSON6; const AKey: string;
  const AInstance: TObject);
begin
  inherited Create(AOwner, AKey);
  FInstance := AInstance;
//  FTypeKind := PropType(AInstance, FKey);
end;

{$HINTS ON}
{$WARNINGS ON}

end.
