Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROJSONParser.pas

unit uROJSONParser;

{$I RemObjects.inc}
// code chars > 127 as \uXXXX
{$DEFINE WRITE_ASCII_COMPATIBLE}
{$DEFINE RaiseInvalidDataTypeException}
interface
uses
  SysUtils, Classes;

type
  {$IFDEF UNICODE}
    JSON_String = string;
    JSON_Char   = Char;
    JSON_PChar  = PChar;
  {$ELSE}
    JSON_String = Widestring;
    JSON_Char   = WideChar;
    JSON_PChar  = PWideChar;
  {$ENDIF}

  TROJSONDataType = (jdtNull, jdtString, jdtNumber, jdtObject, jdtArray, jdtBoolean);

  TROJSONObject = class;
  TROJSONArray = class;

  TROJSONValue = class(TCollectionItem)
  private
    FValueType: TROJSONDataType;
    FValue: Variant;
    FObject: TCollection;
    function GetAsObject: TROJSONObject;
    function GetAsArray: TROJSONArray;
    function GetAsBoolean: Boolean;
    function GetAsNumber: Variant;
    function GetAsString: JSON_String;
    procedure SetAsObject(const Value: TROJSONObject);
    procedure SetAsArray(const Value: TROJSONArray);
    procedure SetAsString(const Value: JSON_String);
    procedure SetAsBoolean(const Value: Boolean);
    procedure SetAsNumber(const Value: Variant);
    function GetVarValue: Variant;
    procedure SetVarValue(const Value: Variant);
  protected
    Procedure IntSaveToStream(AStream: TStream);virtual;
    Procedure IntLoadFromStream(AStream: TStream);virtual;
  public
    procedure Clear;
    constructor Create(Collection: TCollection); overload;override; 
    constructor Create(aType: TROJSONDataType); reintroduce; overload;
    destructor Destroy; override;
    Procedure SaveToStream(AStream: TStream; AUTF8Stream: boolean = True);
    Procedure LoadFromStream(AStream: TStream; AUTF8Stream: boolean = True);
    property ValueType: TROJSONDataType read FValueType;
    property AsObject: TROJSONObject read GetAsObject write SetAsObject;
    property ASArray: TROJSONArray read GetAsArray write SetAsArray;
    property AsString: JSON_String read GetAsString write SetAsString;
    property AsBoolean: Boolean read GetAsBoolean Write SetAsBoolean;
    Property AsNumber: Variant read GetAsNumber write SetAsNumber;
    procedure SetAsNull;
    property VarValue: Variant read GetVarValue write SetVarValue;
  end;

  TROJSONProperty = class(TROJSONValue)
  private
    FName: JSON_String;
    procedure SetName(const Value: JSON_String);
  protected
    Procedure IntSaveToStream(AStream: TStream);override;
    Procedure IntLoadFromStream(AStream: TStream);override;
  public
    property Name: JSON_String read FName write SetName;
  end;

  TROJSONObject = class(TCollection)
  private
  protected
    function GetItems(Index: Integer): TROJSONProperty;
    procedure SetItems(Index: Integer; const Value: TROJSONProperty);
    Procedure IntSaveToStream(AStream: TStream);
    Procedure IntLoadFromStream(AStream: TStream);
  public
    constructor Create;
    Procedure SaveToStream(AStream: TStream; AUTF8Stream: boolean = True);
    Procedure LoadFromStream(AStream: TStream; AUTF8Stream: boolean = True);
    property Items[Index: Integer] :TROJSONProperty read GetItems write SetItems; default;
    function FindItem(const AName: JSON_String):TROJSONProperty;
    function ItemByName(const AName: JSON_String):TROJSONProperty;
    function IndexOf(const AName: JSON_String):integer;
    function Add: TROJSONProperty;
    function AddStringProperty(const AName, aValue: JSON_String): TROJSONProperty;
    function AddArrayProperty(const AName: JSON_String): TROJSONProperty;
    function AddObjectProperty(const AName: JSON_String): TROJSONProperty;
    function AddNullProperty(const AName: JSON_String): TROJSONProperty;
    function AddBooleanProperty(const AName: JSON_String; const AValue: Boolean): TROJSONProperty;
    function AddNumberProperty(const AName: JSON_String; const AValue: Variant): TROJSONProperty;
    function AddVariantProperty(const AName: JSON_String; const AValue: Variant): TROJSONProperty;
    function GetArrayItemByName(const AName: JSON_String; ACreate: Boolean): TROJSONArray;
    function GetObjectItemByName(const AName: JSON_String; ACreate: Boolean): TROJSONObject;
    function GetStringValueByName(const AName: JSON_String): JSON_String;
    function GetNumberValueByName(const AName: JSON_String): Variant;
    function GetBooleanValueByName(const AName: JSON_String): Boolean;
    function GetVariantValueByName(const AName: JSON_String): Variant;
  end;

  TROJSONArray = class(TCollection)
  private
  protected
    function GetItems(Index: Integer): TROJSONValue;
    procedure SetItems(Index: Integer; const Value: TROJSONValue);
    Procedure IntSaveToStream(AStream: TStream);
    Procedure IntLoadFromStream(AStream: TStream);
  public
    constructor Create;
    function Add: TROJSONValue;
    Procedure SaveToStream(AStream: TStream; AUTF8Stream: boolean = True);
    Procedure LoadFromStream(AStream: TStream; AUTF8Stream: boolean = True);
    property Items[Index: Integer] :TROJSONValue read GetItems write SetItems; default;
    function FindObjectByStringValue(const AName, aValue: JSON_String): TROJSONObject;
    function AddObject: TROJSONValue;
    function AddStringValue(const AValue: JSON_String):TROJSONValue;
    function AddNumberValue(const AValue: Variant):TROJSONValue;
    function AddBooleanValue(const AValue: Boolean):TROJSONValue;
    function AddNullValue:TROJSONValue;
    function AddArrayValue:TROJSONValue;
    function AddVariantValue(const AValue: Variant):TROJSONValue;
  end;

function JSON_ParseStream(AData: TStream; aUTF8Stream:Boolean = True):TROJSONValue;

implementation

uses Variants,uROBinaryHelpers, uROClasses;

const
  JSON_streamID     = 'stream';

{$IFDEF DELPHI7UP}
var
  JSON_FormatSettings: TFormatSettings;
{$ENDIF}

function ReadNumber(AStream: TStream):Variant; forward;
function ReadString(AStream: TStream):JSON_String;forward;
function ReadChar(AStream: TStream;ASkipSpaces: Boolean=True):JSON_Char;forward;
function ReadNextChar(AStream: TStream;ASkipSpaces: Boolean=True):JSON_Char;forward;

procedure WriteChar(AStream: TStream;AChar :JSON_Char);forward;
procedure WriteString(AStream: TStream; AValue: JSON_String); forward;
procedure WriteIdent(AStream: TStream; AValue: JSON_String); forward;
procedure WriteNumber(AStream: TStream; AValue: Variant); forward;

function WriteVarianttoStreamObject(aValue: Variant):TROJSONObject;
var
  lStream:TMemoryStream;
  i: integer;
  lArray: TROJSONArray;
begin
  lStream:= BinaryFromVariant(aValue);
  try
    Result := TROJSONObject.Create;
    lArray := Result.AddArrayProperty(JSON_streamID).ASArray;
    For i := 0 to lStream.Size-1 do
      lArray.AddNumberValue(PByteArray(lStream.Memory)^[i]);
  finally
    lStream.Free;
  end;
end;

function ReadVariantFromStreamObject(AObject: TROJSONObject): Variant;
var
  lProp: TROJSONProperty;
  lArray: TROJSONArray;
  i: integer;
  lStream: TMemoryStream;
begin
  Result:= Null;
  lProp := AObject.FindItem(JSON_streamID);
  if (lProp = nil) or (lProp.ValueType <> jdtArray) then Exit;
  lArray := lProp.ASArray;
  lStream:= TMemoryStream.Create;
  try
    lStream.Size := lArray.Count;
    for i:=0 to lArray.Count-1 do
      PByteArray(lStream.Memory)^[i]:= byte(lArray[i].GetAsNumber);
    Result:= VariantFromBinary(lStream);
  finally
    lStream.Free;
  end;
end;

Procedure JSON_Error_IncompatibleDataType;
begin
  raise Exception.Create('Incompatible datatype');
end;


Procedure JSON_Error_PropertyNotFound(AName: JSON_String);
begin
  raise Exception.Create(AName+' property not found.');
end;

Procedure JSON_Error(AStream: TStream);
begin
  if AStream <> nil then
    raise Exception.Create('This stream is incompatible with JSON format. Position:'+IntToStr(AStream.Position))
  else
    raise Exception.Create('This stream is incompatible with JSON format');
end;

procedure WriteChar(AStream: TStream;AChar :JSON_Char);
begin
  AStream.WriteBuffer(AChar,SizeOf(JSON_Char));
end;

procedure WriteIdent(AStream: TStream; AValue: JSON_String);
begin
  AStream.WriteBuffer(pointer(aValue)^,SizeOf(JSON_Char)*Length(AValue));
end;

procedure WriteNumber(AStream: TStream; AValue: Variant);
var
  s: string;
  c: char;
begin
  case VarType(AValue) of
    varShortInt,
    varSmallint,
    varByte,
    varWord,
    varInteger: s:= IntToStr(AValue);
    varLongWord,
    varInt64: s := IntToStr(aValue);
    {$IFNDEF FPC}
    varDate,
    varSingle,
    {$IFDEF DELPHI7UP}
    varDouble:  s:= FloatToStr(AValue,JSON_FormatSettings);
    {$ELSE}
    varDouble:  s:= StringReplace(FloatToStr(AValue), '.', DecimalSeparator, []);	
    {$ENDIF}

    {$IFDEF DELPHI7UP}
    varCurrency: s:= CurrToStr(AValue,JSON_FormatSettings);
    {$ELSE}
    varCurrency: s:= StringReplace(CurrToStr(AValue), '.', DecimalSeparator, []);	
    {$ENDIF}

    {$ENDIF}
  else
    c:= DecimalSeparator;
    try
      DecimalSeparator := '.';
      s:= VarToStr(AValue);
    finally
      DecimalSeparator := c;
    end;
  end;
  WriteIdent(AStream,s);
end;

procedure WriteString(AStream: TStream; AValue: JSON_String);

  procedure WriteTag(const WC: JSON_Char);
  begin
    WriteChar(AStream,'\');
    WriteChar(AStream,wc);
  end;

var
  i,j: integer;
  s: string;
begin
  WriteChar(AStream, '"');
  for i := 1 to Length(AValue)  do begin
    case ord(AValue[i]) of
      22 {"}  : WriteTag('"');
      92 {\}  : WriteTag('\');
      47 {/}  : WriteTag('/');
      08      : WriteTag('b');
      09      : WriteTag('t');
      10      : WriteTag('n');
      12      : WriteTag('f');
      13      : WriteTag('r');
      32, 33,
      35..46,
      48..91,
      93..127
      {$IFNDEF WRITE_ASCII_COMPATIBLE},128..$FFFF{$ENDIF}: WriteChar(AStream,AValue[i]);
    else
      WriteTag('u');
      s := IntToHex(ord(AValue[i]),4);
      for j:=1 to Length(s) do
        WriteChar(AStream,JSON_Char(ord(s[j])));
    end;
  end;
  WriteChar(AStream, '"');
end;

function ReadNumber(AStream: TStream):Variant;
var
  s: JSON_String;
  s1: string;
  lchar: JSON_Char;
begin
  Result:=Null;
  s:='';
  lchar := ReadChar(AStream);
  while true do begin
    if ord(lchar) in [43, 45,46, 48..57, 69, 101 {+-.0123456789Ee}] then begin
      s := s+lchar;
      AStream.ReadBuffer(lchar, SizeOf(lchar));
    end
    else begin
      AStream.Seek(-SizeOf(JSON_Char),soFromCurrent);
      Break;
    end;
  end;
  s1 := s;
  if (pos('.', s1) >0) or (pos('e', s1) >0) or (pos('E', s1) >0) then
    {$IFDEF DELPHI7UP}
    Result := StrToFloat(s1,JSON_FormatSettings)
    {$ELSE}
    Result := StrToFloat(StringReplace(s1, '.', DecimalSeparator, []))
    {$ENDIF}

  else
    Result := StrToInt64(s1);
end;

function ReadChar(AStream: TStream;ASkipSpaces: Boolean=True):JSON_Char;
var
  f: boolean;
begin
  f := True;
  {$IFDEF FPC}
  Result:=#0;
  {$ENDIF}
  While F do begin
    AStream.ReadBuffer(Result, SizeOf(Result));
    f := ASkipSpaces and  (ord(Result) in [ord(' '), 10, 13, 9]);
  end;
end;

function HexcodeToChar(AValue: JSON_String): JSON_Char;
var
  i,j,k: integer;
begin
  k:=0;
  for i:= 1 to Length(aValue) do begin
    j:= ord(AValue[i]);
    case j  of
      48..57: dec(j,48);
      65..70: dec(j, 55);
      97..120: dec(j, 87);
    else
      raise Exception.Create('can''t decode hex string:'''+aValue+'''');
    end;
    k:= k*16 + j;
  end;
  Result:= JSon_Char(k);
end;

function ReadString(AStream: TStream):JSON_String;
var
  LChar: JSON_Char;
  s: JSON_String;
begin
  Result:='';
  lchar := ReadChar(AStream,False);
  while lChar <> '"' do begin
    if lchar = '\' then begin
      lchar:=ReadChar(AStream,False);
           if lchar = 'n' then Result := Result + #0010
      else if lchar = 'r' then Result := Result + #0013
      else if lchar = 't' then Result := Result + #0009
      else if lchar = '"' then Result := Result + lchar
      else if lchar = '\' then Result := Result + lchar
      else if lchar = '/' then Result := Result + lchar
      else if lchar = 'u' then begin
        SetLength(s, 4);
        AStream.ReadBuffer(Pointer(s)^,4*sizeOf(JSON_Char));
        Result:=Result + HexCodetoChar(s);
      end
      else if lchar = 'b' then Result := Result + #0008
      else if lchar = 'f' then Result := Result + #0012
      else JSON_Error(AStream);
    end
    else
      Result := Result + lChar;
    lchar := ReadChar(AStream,False);
  end;
end;


function ReadNextChar(AStream: TStream;ASkipSpaces: Boolean=True):JSON_Char;
var
  p: int64;
begin
  p := AStream.Position;
  try
    Result := ReadChar(AStream, ASkipSpaces);
  finally
    AStream.Position := p;
  end;
end;

{ TROJSONValue }


procedure TROJSONValue.Clear;
begin
  if FValueType <> jdtNull then begin
    if FValueType in [jdtObject, jdtArray] then FreeAndNil(FObject);
    FValueType := jdtNull;
    FValue := Null;
  end;
end;


constructor TROJSONValue.Create(Collection: TCollection);
begin
  inherited;
  FObject := nil;
  FValueType := jdtNull;
  FValue := Null;
end;

destructor TROJSONValue.Destroy;
begin
  Clear;
  inherited;
end;

function TROJSONValue.GetAsArray: TROJSONArray;
begin
  if (FValueType = jdtArray) then
    Result:= TROJSONArray(FObject)
  else begin
    {$IFDEF RaiseInvalidDataTypeException}
    JSON_Error_IncompatibleDataType;
    {$ENDIF}
    Result := nil;
  end;
end;

function TROJSONValue.GetAsBoolean: Boolean;
begin
  if FValueType = jdtBoolean then
    Result := FValue
  else begin
    {$IFDEF RaiseInvalidDataTypeException}
    JSON_Error_IncompatibleDataType;
    {$ENDIF}
    Result := False;
  end;
end;


function TROJSONValue.GetAsNumber: Variant;
begin
  if FValueType = jdtNumber then
    Result := FValue
  else begin
    {$IFDEF RaiseInvalidDataTypeException}
    JSON_Error_IncompatibleDataType;
    {$ENDIF}
    Result := Null;
  end;
end;

function TROJSONValue.GetAsObject: TROJSONObject;
begin
  if (FValueType = jdtObject) then
    Result:= TROJSONObject(FObject)
  else begin
    {$IFDEF RaiseInvalidDataTypeException}
    JSON_Error_IncompatibleDataType;
    {$ENDIF}
    Result := nil;
  end;
end;

function TROJSONValue.GetAsString: JSON_String;
begin
  Result := FValue;
end;

function TROJSONValue.GetVarValue: Variant;
begin
  case FValueType of
    jdtNull : Result:= Null;
    jdtString: Result:= AsString;
    jdtNumber: Result:= AsNumber;
    jdtBoolean: Result := AsBoolean;
    jdtArray: ;
    jdtObject: Result := ReadVariantFromStreamObject(AsObject);
  end;
end;

procedure TROJSONValue.IntLoadFromStream(AStream: TStream);
var
  lChar: JSON_Char;
  s: JSON_String;
begin
  lChar := ReadNextChar(AStream);
  if lChar = '"' then begin //string
     ReadChar(AStream);
     AsString:=ReadString(AStream);
  end
  else if lChar = '{' then begin //object
    AsObject := TROJSONObject.Create;
    AsObject.IntLoadFromStream(AStream);
  end
  else if lChar = '[' then begin // array
    AsArray := TROJSONArray.Create;
    AsArray.IntLoadFromStream(AStream);
  end
  else if lchar = 't' then begin //true
    ReadChar(AStream);
    SetLength(s, 3);
    AStream.ReadBuffer(pointer(s)^, 3*sizeof(JSON_Char));
    if s <> 'rue' then JSON_Error(AStream);
    AsBoolean:=True;
  end
  else if lchar = 'f' then begin //false
    ReadChar(AStream);
    SetLength(s, 4);
    AStream.ReadBuffer(pointer(s)^, 4*sizeof(JSON_Char));
    if s <> 'alse' then JSON_Error(AStream);
    AsBoolean:=False;
  end
  else if lchar = 'n' then begin //null
    ReadChar(AStream);
    SetLength(s, 3);
    AStream.ReadBuffer(pointer(s)^, 3*sizeof(JSON_Char));
    if s <> 'ull' then JSON_Error(AStream);
    Clear;
  end
  else begin // number
    AsNumber:= ReadNumber(AStream);
  end
end;

procedure TROJSONValue.IntSaveToStream(AStream: TStream);
begin
  case FValueType of
    jdtObject: AsObject.IntSaveToStream(AStream);
    jdtArray:  ASArray.IntSaveToStream(AStream);
    jdtNull: WriteIdent(AStream, 'null');
    jdtBoolean: if GetAsBoolean then
                  WriteIdent(AStream, 'true')
                else
                  WriteIdent(AStream, 'false');
    jdtString: WriteString(AStream, AsString);
    jdtNumber: WriteNumber(AStream, AsNumber);
  end;
end;

procedure TROJSONValue.LoadFromStream(AStream: TStream; AUTF8Stream: boolean);
var
  lStream: TMemoryStream;
  s: UTF8String;
  w: JSON_String;
  lPos: int64;
begin
  lpos := AStream.Position;
  try
    if AUTF8Stream then begin
      lStream:= TMemoryStream.Create;
      try
        SetLength(s, AStream.Size - AStream.Position);
        AStream.Read(pointer(s)^, Length(s));
        if Copy(s,1,3) = UTF8String(#$EF#$BB#$BF) then delete(s,1,3);

        w:= UTF8ToString(s);
        s:='';
        lStream.Size := Length(w)*SizeOf(JSON_Char);
        Move(pointer(w)^,lStream.Memory^, lStream.Size);
        w:='';
        IntLoadFromStream(lStream);
      finally
        lStream.Free;
      end;
    end
    else begin
      IntLoadFromStream(AStream);
    end;
  except
    AStream.Position:= lPos;
    raise;
  end;
end;

procedure TROJSONValue.SaveToStream(AStream: TStream; AUTF8Stream: boolean);
var
  lStream: TMemoryStream;
  s: UTF8String;
  w: JSON_String;
begin
  if AUTF8Stream then begin
    lStream:= TMemoryStream.Create;
    try
      IntSaveToStream(lStream);
      SetString(w, JSON_PChar(lStream.Memory), lStream.Size div SizeOf(JSON_Char));
    finally
      lStream.Free;
    end;
    s:=UTF8Encode(W);
    w:='';
    AStream.Write(pointer(s)^, Length(s));
  end
  else begin
    IntSaveToStream(AStream);
  end;
end;

procedure TROJSONValue.SetAsArray(const Value: TROJSONArray);
begin
  if (Value <> FObject) or (FValueType <> jdtArray) then begin
    Clear;
    if Value <> nil then begin
      FObject := Value;
      FValueType := jdtArray;
    end;
   end;
end;

procedure TROJSONValue.SetAsBoolean(const Value: Boolean);
begin
  if FValueType <> jdtBoolean then begin
    Clear;
    FValueType := jdtBoolean;
  end;
  FValue := Value;
end;

procedure TROJSONValue.SetAsNull;
begin
  Clear;
end;

procedure TROJSONValue.SetAsNumber(const Value: Variant);
begin
  if FValueType <> jdtNumber then begin
    Clear;
    FValueType := jdtNumber;
  end;
  FValue:= Value;
end;

procedure TROJSONValue.SetAsObject(const Value: TROJSONObject);
begin
  if (Value <> FObject) or (FValueType <> jdtObject) then begin
    Clear;
    if Value <> nil then begin
      FObject := Value;
      FValueType := jdtObject;
    end;
   end;
end;

procedure TROJSONValue.SetVarValue(const Value: Variant);
begin
  if VarIsNull(Value) or VarIsEmpty(Value) then SetAsNull
  else if TVarData(Value).VType = varBoolean then AsBoolean := Value
  else if VarIsStr(Value) then AsString := Value
  else if VarIsNumeric(Value) or (TVarData(Value).VType = varDate) then AsNumber := Value
  else AsObject := WriteVarianttoStreamObject(Value);
end;

constructor TROJSONValue.Create(aType: TROJSONDataType);
begin
  inherited Create(nil);
  FObject := nil;
  case aType of
    jdtObject: FObject := TROJSONObject.Create;
    jdtArray: FObject := TROJSONArray.Create;
  end;
  FValueType := aType;
  FValue := Null;
end;

{ TROJSONProperty }


procedure TROJSONValue.SetAsString(const Value: JSON_String);
begin
  if FValueType <> jdtString then begin
    Clear;
    FValueType := jdtString;
  end;
  FValue:= Value;
end;

{ TROJSONProperty }

procedure TROJSONProperty.IntLoadFromStream(AStream: TStream);
begin
 // inherited;
  if ReadChar(AStream) <> '"' then JSON_Error(AStream);
  FName := ReadString(Astream);
  if ReadChar(AStream) <> ':' then JSON_Error(AStream);
  inherited IntLoadFromStream(AStream);
end;

procedure TROJSONProperty.IntSaveToStream(AStream: TStream);
begin
  WriteString(AStream,FName);
  WriteChar(AStream,':');
  inherited IntSaveToStream(Astream);
end;

procedure TROJSONProperty.SetName(const Value: JSON_String);
begin
  FName := Value;
end;

{ TROJSONObject }

function TROJSONObject.Add: TROJSONProperty;
begin
  Result:=TROJSONProperty(inherited Add);
end;

function TROJSONObject.AddArrayProperty(
  const AName: JSON_String): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.ASArray := TROJSONArray.Create;
end;

function TROJSONObject.AddBooleanProperty(const AName: JSON_String;
  const AValue: Boolean): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.AsBoolean := AValue;
end;

function TROJSONObject.AddNullProperty(const AName: JSON_String): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.SetAsNull;
end;

function TROJSONObject.AddNumberProperty(const AName: JSON_String;
  const AValue: Variant): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.AsNumber := AValue;
end;

function TROJSONObject.AddObjectProperty(
  const AName: JSON_String): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.AsObject := TROJSONObject.Create;
end;

function TROJSONObject.AddStringProperty(const AName,
  aValue: JSON_String): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.AsString := aValue;
end;

constructor TROJSONObject.Create;
begin
  inherited Create(TROJSONProperty);
end;

function TROJSONObject.GetArrayItemByName(const AName: JSON_String;
  ACreate: Boolean): TROJSONArray;
var
  aItem : TROJSONProperty;
begin
  Result := nil;
  aItem := FindItem(AName);
  if (AItem = nil) and ACreate then
    aItem := AddArrayProperty(Aname);

  if aItem <> nil then begin
    if aItem.ValueType = jdtArray then
      result := aItem.ASArray
    else
      JSON_Error_IncompatibleDataType;
  end;
end;

function TROJSONObject.FindItem(const AName: JSON_String): TROJSONProperty;
var
  i: integer;
begin
  i := IndexOf(AName);
  if i = -1 then
    Result := nil
  else
    Result := Items[i];  
end;

function TROJSONObject.IndexOf(const AName: JSON_String): integer;
begin
  For Result:= 0 to Count - 1 do
    if Items[Result].Name = AName then Exit;
  Result := -1;
end;

function TROJSONObject.GetItems(Index: Integer): TROJSONProperty;
begin
  Result:= TROJSONProperty(GetItem(Index));
end;

function TROJSONObject.GetObjectItemByName(const AName: JSON_String;
  ACreate: Boolean): TROJSONObject;
var
  aItem : TROJSONProperty;
begin
  Result := nil;
  aItem := FindItem(AName);
  if (AItem = nil) and ACreate then begin
    aItem := AddObjectProperty(AName);
  end;
  if aItem <> nil then begin
    if aItem.ValueType = jdtObject then
      result := aItem.AsObject
    else
      JSON_Error_IncompatibleDataType;
  end;
end;

procedure TROJSONObject.IntLoadFromStream(AStream: TStream);
var
  AChar: JSON_Char;
begin
  if ReadChar(AStream ) = '{' then begin
    AChar := ReadChar(AStream);
    while AChar <> '}' do begin
      if AChar = ',' then begin
        AChar:= ReadChar(AStream);
        continue;
      end
      else if AChar = '"' then begin
        AStream.Seek( -SizeOf(JSON_Char), soFromCurrent);
        TROJSONProperty(Add).IntLoadFromStream(AStream);
      end
      else
        // only " and , supported here
        JSON_Error(AStream);
      AChar:= ReadChar(AStream);
    end;
  end
  else begin
    JSON_Error(AStream);
  end;
end;

procedure TROJSONObject.IntSaveToStream(AStream: TStream);
var
  i: integer;
begin
  WriteChar(AStream, '{');
  For i := 0 to Count -1 do begin
    Items[i].IntSaveToStream(AStream);
    if i <> Count -1 then WriteChar(AStream, ',');
  end;
  WriteChar(AStream, '}');
end;

procedure TROJSONObject.SaveToStream(AStream: TStream; AUTF8Stream: boolean);
var
  temp: TROJSONValue;
begin
  if AUTF8Stream then begin
    temp:= TROJSONValue.Create(nil);
    try
      temp.AsObject := Self;
      temp.SaveToStream(AStream,AUTF8Stream);
    finally
      temp.FValueType:= jdtNull; // for preventing freeing object
      temp.Free;
    end;
  end
  else begin
    IntSaveToStream(AStream);
  end;
end;

procedure TROJSONObject.SetItems(Index: Integer;
  const Value: TROJSONProperty);
begin
  SetItem(Index, Value);
end;

function TROJSONObject.GetStringValueByName(
  const AName: JSON_String): JSON_String;
var
  aItem : TROJSONProperty;
begin
  Result := '';
  aItem := ItemByName(AName);
  if aItem <> nil then begin
    if aItem.ValueType = jdtString then
      result := aItem.AsString
    else
      JSON_Error_IncompatibleDataType;
  end;
end;

function TROJSONObject.GetBooleanValueByName(
  const AName: JSON_String): Boolean;
var
  aItem : TROJSONProperty;
begin
  Result := False;
  aItem := ItemByName(AName);
  if aItem <> nil then begin
    if aItem.ValueType = jdtBoolean then
      result := aItem.AsBoolean
    else
      JSON_Error_IncompatibleDataType;
  end;
end;

function TROJSONObject.GetNumberValueByName(
  const AName: JSON_String): Variant;
var
  aItem : TROJSONProperty;
begin
  Result := Null;
  aItem := ItemByName(AName);
  if aItem <> nil then begin
    if aItem.ValueType = jdtNumber then
      result := aItem.AsNumber
    else
      JSON_Error_IncompatibleDataType;
  end;
end;

function TROJSONObject.AddVariantProperty(const AName: JSON_String;
  const AValue: Variant): TROJSONProperty;
begin
  Result:=Add;
  Result.Name := AName;
  Result.VarValue := AValue;
end;

function TROJSONObject.GetVariantValueByName(
  const AName: JSON_String): Variant;
var
  aItem : TROJSONProperty;
begin
  Result := '';
  aItem := ItemByName(AName);
  if aItem <> nil then Result:= aItem.VarValue;
end;

function TROJSONObject.ItemByName(
  const AName: JSON_String): TROJSONProperty;
begin
  Result := FindItem(AName);
  if (Result = nil) then JSON_Error_PropertyNotFound(AName);
end;

procedure TROJSONObject.LoadFromStream(AStream: TStream; AUTF8Stream: boolean);
var
  temp: TROJSONValue;
begin
  if AUTF8Stream then begin
    temp:= TROJSONValue.Create(nil);
    try
      temp.AsObject := Self;
      temp.LoadFromStream(AStream,AUTF8Stream);
    finally
      temp.FValueType:= jdtNull; // for preventing freeing object
      temp.Free;
    end;
  end
  else begin
    IntLoadFromStream(AStream);
  end;
end;

{ TROJSONArray }

function TROJSONArray.Add: TROJSONValue;
begin
  Result:= TROJSONValue(inherited Add);
end;

function TROJSONArray.AddArrayValue: TROJSONValue;
begin
  Result:=Add;
  Result.ASArray:=TROJSONArray.Create;
end;

function TROJSONArray.AddBooleanValue(const AValue: Boolean): TROJSONValue;
begin
  Result:=Add;
  Result.AsBoolean:= AValue;
end;

function TROJSONArray.AddNullValue: TROJSONValue;
begin
  Result:=Add;
  Result.SetAsNull;
end;

function TROJSONArray.AddNumberValue(const AValue: Variant): TROJSONValue;
begin
  Result:=Add;
  Result.AsNumber:= AValue;
end;

function TROJSONArray.AddObject: TROJSONValue;
begin
  Result:= Add;
  Result.AsObject := TROJSONObject.Create;
end;

function TROJSONArray.AddStringValue(
  const AValue: JSON_String): TROJSONValue;
begin
  Result:=Add;
  Result.AsString:= AValue;
end;

function TROJSONArray.AddVariantValue(const AValue: Variant): TROJSONValue;
begin
  Result:=Add;
  Result.VarValue := AValue;
end;

constructor TROJSONArray.Create;
begin
  inherited Create(TROJSONValue);
end;

function TROJSONArray.FindObjectByStringValue(const AName,
  aValue: JSON_String): TROJSONObject;
var
  i: integer;
  lProp: TROJSONProperty;
begin
  for i := 0 to Count-1 do begin
    if (Items[i].ValueType = jdtObject) then begin
     Result := Items[i].AsObject;
     lProp := Result.FindItem(AName);
     if (lProp <> nil) and (lProp.ValueType = jdtString) and (lProp.AsString = aValue) then  Exit;
    end;
  end;
  Result := nil;
end;

function TROJSONArray.GetItems(Index: Integer): TROJSONValue;
begin
  Result:= TROJSONValue(GetItem(Index));
end;

procedure TROJSONArray.IntLoadFromStream(AStream: TStream);
var
  AChar: JSON_Char;
begin
  if ReadChar(AStream ) = '[' then begin
    AChar := ReadChar(AStream);
    while AChar <> ']' do begin
      if AChar <> ',' then AStream.Seek( -SizeOf(JSON_Char), soFromCurrent);
      TROJSONValue(Add).IntLoadFromStream(AStream);
      AChar := ReadChar(AStream);
    end;
  end
  else begin
    JSON_Error(AStream);
  end;
end;

procedure TROJSONArray.IntSaveToStream(AStream: TStream);
var
  i: integer;
begin
  WriteChar(AStream, '[');
  For i := 0 to Count -1 do begin
    Items[i].IntSaveToStream(AStream);
    if i <> Count -1 then WriteChar(AStream, ',');
  end;
  WriteChar(AStream, ']');
end;

procedure TROJSONArray.LoadFromStream(AStream: TStream; AUTF8Stream: boolean);
var
  temp: TROJSONValue;
begin
  if AUTF8Stream then begin
    temp:= TROJSONValue.Create(nil);
    try
      temp.ASArray := Self;
      temp.LoadFromStream(AStream,AUTF8Stream);
    finally
      temp.FValueType:= jdtNull; // for preventing freeing object
      temp.Free;
    end;
  end
  else begin
    IntLoadFromStream(AStream);
  end;
end;

procedure TROJSONArray.SaveToStream(AStream: TStream; AUTF8Stream: boolean);
var
  temp: TROJSONValue;
begin
  if AUTF8Stream then begin
    temp:= TROJSONValue.Create(nil);
    try
      temp.ASArray := Self;
      temp.SaveToStream(AStream,AUTF8Stream);
    finally
      temp.FValueType:= jdtNull; // for preventing freeing object
      temp.Free;
    end;
  end
  else begin
    IntSaveToStream(AStream);
  end;
end;

procedure TROJSONArray.SetItems(Index: Integer; const Value: TROJSONValue);
begin
  SetItem(Index, Value);
end;

function JSON_ParseStream(AData: TStream;aUTF8Stream:Boolean):TROJSONValue;
var
  lpos : int64;
begin
  lpos := AData.Position;
  try
    Result := TROJSONValue.Create(nil);
    Result.LoadFromStream(AData,aUTF8Stream);
  except
    AData.Position := lPos;
    Raise;
  end;
end;

{$IFDEF DELPHI7UP}
initialization
  JSON_FormatSettings.DecimalSeparator := '.';
{$ENDIF}
end.