PascalCoin/src/libraries/pascalcoin/UJSONFunctions.pas

unit UJSONFunctions;

{ Copyright (c) 2016 by Albert Molina

  Distributed under the MIT software license, see the accompanying file LICENSE
  or visit http://www.opensource.org/licenses/mit-license.php.

  This unit is a part of the PascalCoin Project, an infinitely scalable
  cryptocurrency. Find us here:
  Web: https://www.pascalcoin.org
  Source: https://github.com/PascalCoin/PascalCoin

  If you like it, consider a donation using Bitcoin:
  16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk

  THIS LICENSE HEADER MUST NOT BE REMOVED.
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

Uses
{$IFNDEF VER210}
{$DEFINE DELPHIXE}
{$ENDIF}

{$DEFINE USE_BTREE}
{$DEFINE JSONOBJECTS_NAMES_CASE_SENSITIVITY}

  {$IFDEF FPC}
  fpjson, jsonparser,
  {$ELSE}
  {$IFDEF DELPHIXE}
  System.JSON,
  {$ENDIF}
  DBXJSON,
  {$ENDIF}
  SysUtils, DateUtils, Variants, Classes,
  {$IFDEF USE_BTREE}UAbstractBTree,{$ENDIF}
  {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};

Type
  {$IFDEF FPC}
  TJSONValue = TJSONData;
  {$ENDIF}

  { TPCJSONData }

  TPCJSONData = Class
  private
    FParent : TPCJSONData;
  protected
    Function ToJSONFormatted(pretty:Boolean;Const prefix : String) : String; virtual; abstract;
  public
    Constructor Create; virtual;
    Destructor Destroy; override;
    Class Function ParseJSONValue(Const JSONObject : String) : TPCJSONData; overload;
    Class Function ParseJSONValue(Const JSONObject : TBytes) : TPCJSONData; overload;
    Class Function _GetCount : Integer;
    Function ToJSON(pretty : Boolean) : String;
    Procedure SaveToStream(Stream : TStream);
    Procedure Assign(PCJSONData : TPCJSONData);
    class function JSONFormatSettings : TFormatSettings;
  End;

  TPCJSONDataClass = Class of TPCJSONData;

  { TPCJSONVariantValue }

  TPCJSONVariantValue = Class(TPCJSONData)
  private
    FOldValue : Variant;
    FWritable : Boolean;
    FValue: Variant;
    procedure SetValue(const Value: Variant);
  protected
    Function ToJSONFormatted(pretty:Boolean;const prefix : String) : String; override;
  public
    Constructor Create; override;
    Constructor CreateFromVariant(const Value: Variant);
    Constructor CreateFromJSONValue(JSONValue : TJSONValue);
    Property Value : Variant read FValue write SetValue;
    Function AsString(DefValue : String) : String;
    Function AsInteger(DefValue : Integer) : Integer;
    Function AsInt64(DefValue : Int64) : Int64;
    Function AsDouble(DefValue : Double) : Double;
    Function AsBoolean(DefValue : Boolean) : Boolean;
    Function AsDateTime(DefValue : TDateTime) : TDateTime;
    Function AsCurrency(DefValue : Currency) : Currency;
    Function AsCardinal(DefValue : Cardinal) : Cardinal;
    Function IsNull : Boolean;
    Function IncrementAsInteger(AIncrement : Integer) : TPCJSONVariantValue;
    Function IncrementAsInt64(AIncrement : Int64) : TPCJSONVariantValue;
    Function IncrementAsDouble(AIncrement : Double) : TPCJSONVariantValue;
    Function IncrementAsCurrency(AIncrement : Currency) : TPCJSONVariantValue;
    Function IncrementAsCardinal(AIncrement : Cardinal) : TPCJSONVariantValue;
  End;

  TPCJSONNameValue = Class(TPCJSONData)
  private
    FName: String;
    FValue: TPCJSONData;
    FFreeValue : Boolean;
    procedure SetValue(const Value: TPCJSONData);
  protected
    Function ToJSONFormatted(pretty:Boolean;const prefix : String) : String; override;
  public
    Constructor Create(AName : String);
    Destructor Destroy; override;
    Property Name : String read FName;
    Property Value : TPCJSONData read FValue write SetValue;
  End;

  TPCJSONArray = class;
  TPCJSONObject = Class;

  TPCJSONList = Class(TPCJSONData)
  private
    FList : TList<TPCJSONData>;
    function GetItems(Index: Integer): TPCJSONData;
    procedure SetItems(Index: Integer; const Value: TPCJSONData);
  protected
    Function GetIndexAsVariant(Index : Integer) : TPCJSONVariantValue;
    Function GetIndexAsArray(Index : Integer) : TPCJSONArray;
    Function GetIndexAsObject(Index : Integer) : TPCJSONObject;
    Procedure CheckCanInsert(Index:Integer; PCJSONData:TPCJSONData); virtual;
  public
    Constructor Create; override;
    Destructor Destroy; override;
    Property Items[Index:Integer] : TPCJSONData read GetItems write SetItems;
    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData); virtual;
    Procedure Delete(index : Integer); virtual;
    function Count : Integer;
    Procedure Clear; virtual;
  End;

  TPCJSONArray = class(TPCJSONList)
  private
    Procedure GrowToIndex(index : Integer);
    function GetItemOfType(Index: Integer; DataClass:TPCJSONDataClass): TPCJSONData;
  protected
    Function ToJSONFormatted(pretty:Boolean;const prefix : String) : String; override;
  public
    Constructor Create; override;
    Constructor CreateFromJSONArray(JSONArray : TJSONArray);
    Destructor Destroy; override;
    Function GetAsVariant(index : Integer) : TPCJSONVariantValue;
    Function GetAsObject(index : Integer) : TPCJSONObject;
    Function GetAsArray(index : Integer) : TPCJSONArray;
  end;

  { TPCJSONObject }

  TPCJSONObject = Class(TPCJSONList)
  private
    {$IFDEF USE_BTREE}
    FSearchingValue : String;
    FOrderedByName : TMemoryBTree<Integer>;
    function CompareBTree(const Left, Right: Integer): Integer;
    {$ENDIF}
    Function GetIndexOrCreateName(Name : String) : Integer;
    Function GetByName(Name : String) : TPCJSONNameValue;
  protected
    Function ToJSONFormatted(pretty:Boolean;const prefix : String) : String; override;
    Procedure CheckCanInsert(Index:Integer; PCJSONData:TPCJSONData); override;
    Procedure CheckValidName(Name : String);
  public
    Constructor Create; override;
    Constructor CreateFromJSONObject(JSONObject : TJSONObject);
    Destructor Destroy; override;
    Function FindName(Name : String) : TPCJSONNameValue;
    Function IndexOfName(Name : String) : Integer;
    Function HasName(Name: String): Boolean;
    Function HasValue(const AParamName : String) : Boolean;
    Procedure DeleteName(Name : String);
    Function GetAsVariant(Name : String) : TPCJSONVariantValue;
    Function GetAsObject(Name : String) : TPCJSONObject;
    Function GetAsArray(Name : String) : TPCJSONArray;
    Function AsString(ParamName : String; DefValue : String) : String;
    Function AsInteger(ParamName : String; DefValue : Integer) : Integer;
    Function AsCardinal(ParamName : String; DefValue : Cardinal) : Cardinal;
    Function AsInt64(ParamName : String; DefValue : Int64) : Int64;
    Function AsDouble(ParamName : String; DefValue : Double) : Double;
    Function AsBoolean(ParamName : String; DefValue : Boolean) : Boolean;
    Function AsDateTime(ParamName : String; DefValue : TDateTime) : TDateTime;
    Function AsCurrency(ParamName : String; DefValue : Currency) : Currency;
    Function SaveAsStream(ParamName : String; Stream : TStream) : Integer;
    Function LoadAsStream(ParamName : String; Stream : TStream) : Integer;
    Function GetNameValue(index : Integer) : TPCJSONNameValue; overload;
    Function GetNameValue(Name : String) : TPCJSONNameValue; overload;
    Function IsNull(ParamName : String) : Boolean;
    Procedure SetAs(Name : String; Value : TPCJSONData);
    Procedure Delete(index : Integer); override;
    Procedure Clear; override;
    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData); override;
    procedure CheckConsistency;
  End;

  EPCParametresError = Class(Exception);

implementation

var _JSON_FormatSettings : TFormatSettings;

Function UTF8JSONEncode(plainTxt : String; includeSeparator : Boolean) : String;
Var ws : String;
  i : Integer;
Begin
   ws := UTF8Encode(plainTxt);
   {ALERT:
    UTF8Encode function deletes last char if equal to #0, so we put it manually
    }
   if plainTxt.Substring(Length(plainTxt)-1,1)=#0 then  ws := ws + #0;
        i := 0;
        result := '"';
        while i < Length(ws) do
          begin
            case ws.Chars[i] of
              '/', '\', '"': result := result + '\' + ws.Chars[i];
              #8: result := result + '\b';
              #9: result := result + '\t';
              #10: result := result + '\n';
              #13: result := result + '\r';
              #12: result := result + '\f';
            else
              if (ord(ws.Chars[i]) < 32) Or (ord(ws.Chars[i])>122) then
                result := result + '\u' + inttohex(ord(ws.Chars[i]), 4)
              else
                result := result + ws.Chars[i];
            end;
            inc(i);
          end;
        result := result + '"';
End;

{ TPCJSONArray }

constructor TPCJSONArray.Create;
begin
  inherited;

end;

constructor TPCJSONArray.CreateFromJSONArray(JSONArray: TJSONArray);
Var i : Integer;
begin
  Create;
{$IFDEF FPC}
  for i := 0 to JSONArray.Count - 1 do begin
    if (JSONArray.Items[i] is TJSONArray) then begin
      Insert(i,TPCJSONArray.CreateFromJSONArray(TJSONArray(JSONArray.Items[i])));
    end else if (JSONArray.Items[i] is TJSONObject) then begin
      Insert(i,TPCJSONObject.CreateFromJSONObject(TJSONObject(JSONArray.Items[i])));
    end else if (JSONArray.Items[i] is TJSONValue) then begin
      Insert(i,TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JSONArray.Items[i])));
    end else raise EPCParametresError.Create('Invalid TJSON Data: '+JSONArray.Items[i].ClassName);
  end;
{$ELSE}
  for i := 0 to JSONArray.Size - 1 do begin
    if (JSONArray.Get(i) is TJSONArray) then begin
      Insert(i,TPCJSONArray.CreateFromJSONArray(TJSONArray(JSONArray.Get(i))));
    end else if (JSONArray.Get(i) is TJSONObject) then begin
      Insert(i,TPCJSONObject.CreateFromJSONObject(TJSONObject(JSONArray.Get(i))));
    end else if (JSONArray.Get(i) is TJSONValue) then begin
      Insert(i,TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JSONArray.Get(i))));
    end else raise EPCParametresError.Create('Invalid TJSON Data: '+JSONArray.Get(i).ClassName);
  end;
{$ENDIF}
end;


destructor TPCJSONArray.Destroy;
begin
  inherited;
end;

function TPCJSONArray.GetAsArray(index: Integer): TPCJSONArray;
begin
  Result := GetItemOfType(index,TPCJSONArray) as TPCJSONArray;
end;

function TPCJSONArray.GetAsObject(index: Integer): TPCJSONObject;
begin
  Result := GetItemOfType(index,TPCJSONObject) as TPCJSONObject;
end;

function TPCJSONArray.GetAsVariant(index: Integer): TPCJSONVariantValue;
begin
  Result := GetItemOfType(index,TPCJSONVariantValue) as TPCJSONVariantValue;
end;

function TPCJSONArray.GetItemOfType(Index: Integer;
  DataClass: TPCJSONDataClass): TPCJSONData;
Var V,New : TPCJSONData;
begin
  GrowToIndex(Index);
  V := GetItems(index);
  if Not (V is DataClass) then begin
    New := DataClass.Create;
    Items[index] := New;
    V := New;
  end;
  Result := V as DataClass;
end;

procedure TPCJSONArray.GrowToIndex(index: Integer);
begin
  While (index>=Count) do Insert(Count,TPCJSONVariantValue.Create);
end;

function TPCJSONArray.ToJSONFormatted(pretty: Boolean; const prefix: String): String;
Var i : Integer;
begin
  if pretty then Result := '['+#10+prefix
  else Result := '[';
  for i := 0 to Count - 1 do begin
    if (i>0) then begin
      Result := Result+',';
      If pretty then Result :=Result +#10+prefix;
    end;
    Result := Result + Items[i].ToJSONFormatted(pretty,prefix+'   ');
  end;
  Result := Result+']';
end;

{ TPCJSONList }

procedure TPCJSONList.CheckCanInsert(Index: Integer; PCJSONData: TPCJSONData);
begin
  if (Index<0) Or (Index>Count) then raise Exception.Create('Invalid insert at index '+Inttostr(Index)+' (Count:'+Inttostr(Count)+')');
end;

procedure TPCJSONList.Clear;
begin
  while (FList.Count>0) do Delete(FList.Count-1);
end;

function TPCJSONList.Count: Integer;
begin
  Result := FList.Count;
end;

constructor TPCJSONList.Create;
begin
  inherited;
  FParent := Nil;
  FList := TList<TPCJSONData>.Create;
end;

procedure TPCJSONList.Delete(index: Integer);
Var M : TPCJSONData;
begin
  M := GetItems(index);
  FList.Delete(index);
  M.Free;
end;

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

function TPCJSONList.GetIndexAsArray(Index: Integer): TPCJSONArray;
Var D : TPCJSONData;
begin
  D := GetItems(Index);
  if (Not (D is TPCJSONArray)) then begin
    Result := TPCJSONArray.Create;
    SetItems(Index,Result);
    D.Free;
  end else Result := TPCJSONArray(D);
end;

function TPCJSONList.GetIndexAsObject(Index: Integer): TPCJSONObject;
Var D : TPCJSONData;
begin
  D := GetItems(Index);
  if (Not (D is TPCJSONObject)) then begin
    Result := TPCJSONObject.Create;
    SetItems(Index,Result);
    D.Free;
  end else Result := TPCJSONObject(D);
end;

function TPCJSONList.GetIndexAsVariant(Index: Integer): TPCJSONVariantValue;
Var D : TPCJSONData;
begin
  D := GetItems(Index);
  if (Not (D is TPCJSONVariantValue)) then begin
    Result := TPCJSONVariantValue.Create;
    SetItems(Index,Result);
    D.Free;
  end else Result := TPCJSONVariantValue(D);
end;

function TPCJSONList.GetItems(Index: Integer): TPCJSONData;
begin
  Result := FList.Items[Index];
end;

procedure TPCJSONList.Insert(Index: Integer; PCJSONData: TPCJSONData);
begin
  CheckCanInsert(Index,PCJSONData);
  FList.Insert(Index,PCJSONData);
end;

procedure TPCJSONList.SetItems(Index: Integer; const Value: TPCJSONData);
Var OldP : TPCJSONData;
begin
  OldP := FList.Items[Index];
  Try
    FList.Items[Index] := Value;
  Finally
    OldP.Free;
  End;
end;

{ TPCJSONVariantValue }

Function VariantToDouble(Value : Variant) : Double;
Var s : String;
Begin
  Result := 0;
  Case varType(Value) of
    varSmallint, varInteger, varSingle, varDouble,
      varCurrency : Result := Value;
  Else
    Begin
      s := VarToStr(Value);
      If s='' Then Abort
      Else Result := StrToFloat(s);
    End;
  End;
End;

function TPCJSONVariantValue.AsBoolean(DefValue: Boolean): Boolean;
begin
  try
    if VarIsNull(Value) then Result := DefValue
    else Result := VarAsType(Value,varBoolean);
  except
    Result := DefValue;
  end;
end;

function TPCJSONVariantValue.AsCurrency(DefValue: Currency): Currency;
begin
  try
    if VarIsNull(Value) then Result := DefValue
    else Result := VariantToDouble(Value);
  except
    Result := DefValue;
  end;
end;

function TPCJSONVariantValue.AsCardinal(DefValue: Cardinal): Cardinal;
begin
  if VarIsNull(Value) then Result := DefValue
  else Result := Cardinal( StrToIntDef(VarToStrDef(Value,''),DefValue) );
end;

function TPCJSONVariantValue.AsDateTime(DefValue: TDateTime): TDateTime;
begin
  try
    if VarIsNull(Value) then Result := DefValue
    else Result := VarAsType(Value,varDate);
  except
    Result := DefValue;
  end;
end;

function TPCJSONVariantValue.AsDouble(DefValue: Double): Double;
begin
  try
    if VarIsNull(Value) then Result := DefValue
    else Result := VariantToDouble(Value);
  except
    Result := DefValue;
  end;
end;

function TPCJSONVariantValue.AsInt64(DefValue: Int64): Int64;
begin
  if VarIsNull(Value) then Result := DefValue
  else Result := StrToInt64Def(VarToStrDef(Value,''),DefValue);
end;

function TPCJSONVariantValue.AsInteger(DefValue: Integer): Integer;
begin
  if VarIsNull(Value) then Result := DefValue
  else Result := StrToIntDef(VarToStrDef(Value,''),DefValue);
end;

function TPCJSONVariantValue.AsString(DefValue: String): String;
begin
  try
    Case VarType(Value) of
      varNull : Result := '';
      varSmallint, varInteger :
        Begin
          Result := inttostr(Value);
        End;
      varSingle, varDouble,varCurrency :
        Begin
          Result := FloatToStr(VariantToDouble(Value));
        End;
      varDate : Result := DateTimeToStr(Value);
    Else Result := VarToStr(Value);
    End;
  except
    Result := DefValue;
  end;
end;

constructor TPCJSONVariantValue.Create;
begin
  inherited;
  FValue := Null;
  FOldValue := Unassigned;
  FWritable := False;
end;

Constructor TPCJSONVariantValue.CreateFromVariant(const Value: Variant);
begin
  Create;
  SetValue(Value);
end;

constructor TPCJSONVariantValue.CreateFromJSONValue(JSONValue: TJSONValue);
{$IFnDEF FPC}
Var d : Double;
    i64 : Integer;
  ds,ts : Char;
{$ENDIF}
begin
  Create;
  {$IFDEF FPC}
  Value := JSONValue.Value;
  {$ELSE}
  if JSONValue is TJSONNumber then begin
    d := TJSONNumber(JSONValue).AsDouble;
    if JSONValue.ToString.IndexOf('.')>=0 then i64 := 0
    else i64 := TJSONNumber(JSONValue).AsInt;
    ds := {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator;
    ts := {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator;
    {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator := '.';
    {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator := ',';
    Try
      if FormatFloat('0.##########',d)=inttostr(i64) then
        Value := i64
      else Value := d;
    Finally
      {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator := ds;
      {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator := ts;
    End;
  end else if JSONValue is TJSONTrue then Value := true
  else if JSONValue is TJSONFalse then Value := false
  else if JSONValue is TJSONNull then Value := Null
  else Value := JSONValue.Value;
  {$ENDIF}
end;

function TPCJSONVariantValue.IncrementAsCardinal(AIncrement: Cardinal): TPCJSONVariantValue;
begin
  Value := AsCardinal(0) + AIncrement;
  Result := Self;
end;

function TPCJSONVariantValue.IncrementAsCurrency(AIncrement: Currency): TPCJSONVariantValue;
begin
  Value := AsCurrency(0) + AIncrement;
  Result := Self;
end;

function TPCJSONVariantValue.IncrementAsDouble(AIncrement: Double): TPCJSONVariantValue;
begin
  Value := AsDouble(0) + AIncrement;
  Result := Self;
end;

function TPCJSONVariantValue.IncrementAsInt64(AIncrement: Int64): TPCJSONVariantValue;
begin
  Value := AsInt64(0) + AIncrement;
  Result := Self;
end;

function TPCJSONVariantValue.IncrementAsInteger(AIncrement: Integer): TPCJSONVariantValue;
begin
  Value := AsInteger(0) + AIncrement;
  Result := Self;
end;

function TPCJSONVariantValue.IsNull: Boolean;
begin
  Result := VarIsNull(FValue) or VarIsEmpty(FValue);
end;

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

function TPCJSONVariantValue.ToJSONFormatted(pretty: Boolean; const prefix: String): String;
Var   ds,ts : Char;
begin
  Case VarType(Value) of
    varSmallint,varInteger,varByte,varWord,
    varLongWord,varInt64 : Result := VarToStr(Value);
    varBoolean : if (Value) then Result := 'true' else Result:='false';
    varNull : Result := 'null';
    varDate,varDouble,varcurrency : begin
      ds := {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator;
      ts := {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator;
      {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator := '.';
      {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator := ',';
      try
        if VarType(Value)=varcurrency then Result := FormatFloat('0.0000',Value)
        else Result := FormatFloat('0.##########',Value);
      finally
        {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}DecimalSeparator := ds;
        {$IFDEF DELPHIXE}FormatSettings.{$ENDIF}ThousandSeparator := ts;
      end;
    end
  else
    Result := UTF8JSONEncode(VarToStr(Value),true);
  end;
end;

{ TPCJSONObject }

function TPCJSONObject.AsBoolean(ParamName: String; DefValue: Boolean): Boolean;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := VarAsType(v,varBoolean);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsCardinal(ParamName: String; DefValue: Cardinal): Cardinal;
begin
  Result := Cardinal(AsInt64(ParamName,DefValue));
end;

function TPCJSONObject.AsCurrency(ParamName: String; DefValue: Currency): Currency;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := VariantToDouble(v);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsDateTime(ParamName: String;
  DefValue: TDateTime): TDateTime;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := VarAsType(v,varDate);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsDouble(ParamName: String; DefValue: Double): Double;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := VariantToDouble(v);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsInt64(ParamName: String; DefValue: Int64): Int64;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := StrToInt64Def(VarToStrDef(v,''),DefValue);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsInteger(ParamName: String; DefValue: Integer): Integer;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    if VarIsNull(v) then Result := DefValue
    else Result := StrToIntDef(VarToStrDef(v,''),DefValue);
  except
    Result := DefValue;
  end;
end;

function TPCJSONObject.AsString(ParamName: String; DefValue: String): String;
Var v : Variant;
  VV : TPCJSONVariantValue;
begin
  VV := GetAsVariant(ParamName);
  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
    Result := DefValue;
    Exit;
  end;
  v := VV.Value;
  try
    Case VarType(V) of
      varNull : Result := '';
      varSmallint, varInteger :
        Begin
          Result := inttostr(v);
        End;
      varSingle, varDouble,varCurrency :
        Begin
          Result := FloatToStr(VariantToDouble(v));
        End;
      varDate : Result := DateTimeToStr(v);
    Else Result := VarToStr(v);
    End;
  except
    Result := DefValue;
  end;
end;


procedure TPCJSONObject.CheckCanInsert(Index: Integer; PCJSONData: TPCJSONData);
begin
  inherited;
  if Not Assigned(PCJSONData) then raise Exception.Create('Object is nil');
  if Not (PCJSONData is TPCJSONNameValue) then raise Exception.Create('Object inside a '+TPCJSONData.ClassName+' must be a '+TPCJSONNameValue.ClassName+' (currently '+PCJSONData.ClassName+')');
end;

procedure TPCJSONObject.CheckConsistency;
begin
  {$IFDEF USE_BTREE}
  FOrderedByName.CheckConsistency;
  if FOrderedByName.Count<>Count then raise EPCParametresError.Create('Not valid counters');
  {$ENDIF}
end;

procedure TPCJSONObject.CheckValidName(Name: String);
Var i : Integer;
begin
  for i := 0 to Length(Name)-1 do begin
    if i=0 then begin
      if Not (Name.Chars[i] in ['a'..'z','A'..'Z','0'..'9','_','.']) then raise Exception.Create(Format('Invalid char %s at pos %d/%d',[Name.Chars[i],i+1,length(Name)]));
    end else begin
      if Not (Name.Chars[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then raise Exception.Create(Format('Invalid char %s at pos %d/%d',[Name.Chars[i],i+1,length(Name)]));
    end;
  end;
end;

procedure TPCJSONObject.Clear;
begin
  inherited;
  {$IFDEF USE_BTREE}
  FOrderedByName.EraseTree;
  {$ENDIF}
end;

constructor TPCJSONObject.Create;
begin
  inherited;
  {$IFDEF USE_BTREE}
  FOrderedByName := TMemoryBTree<Integer>.Create(CompareBTree,False,7);
  {$ENDIF}
end;

constructor TPCJSONObject.CreateFromJSONObject(JSONObject: TJSONObject);
var i,i2 : Integer;
  {$IFDEF FPC}
  aname : TJSONStringType;
  {$ENDIF}
begin
  Create;
  {$IFDEF FPC}
  for i := 0 to JSONObject.Count - 1 do begin
    aname := JSONObject.Names[i];
    i2 := GetIndexOrCreateName(JSONObject.Names[i]);
    if (JSONObject.Types[ aname ] = jtArray) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONArray.CreateFromJSONArray(JSONObject.Arrays[aname]);
    end else if (JSONObject.Types[ aname ] = jtObject) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONObject.CreateFromJSONObject(JSONObject.Objects[aname]);
    end else if (JSONObject.Types[ aname ] in [jtBoolean,jtNull,jtNumber,jtString]) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONVariantValue.CreateFromJSONValue(JSONObject.Items[i]);
    end else raise EPCParametresError.Create('Invalid TJSON Data in JSONObject.'+aname+': '+JSONObject.Items[i].ClassName);
  end;
  {$ELSE}
  for i := 0 to JSONObject.Size - 1 do begin
    i2 := GetIndexOrCreateName(JSONObject.Get(i).JsonString.Value);
    if (JSONObject.Get(i).JsonValue is TJSONArray) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONArray.CreateFromJSONArray(TJSONArray(JSONObject.Get(i).JsonValue));
    end else if (JSONObject.Get(i).JsonValue is TJSONObject) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONObject.CreateFromJSONObject(TJSONObject(JSONObject.Get(i).JsonValue));
    end else if (JSONObject.Get(i).JsonValue is TJSONValue) then begin
      (Items[i2] as TPCJSONNameValue).Value := TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JSONObject.Get(i).JsonValue));
    end else raise EPCParametresError.Create('Invalid TJSON Data in JSONObject.'+JSONObject.Get(i).JsonString.Value+': '+JSONObject.Get(i).ClassName);
  end;
  {$ENDIF}
end;

{$IFDEF USE_BTREE}
function TPCJSONObject.CompareBTree(const Left, Right: Integer): Integer;
var sLeft,sRight : String;
begin
  if Left=-1 then sLeft := FSearchingValue
  else if (Left>=0) and (Left<FList.Count) and (Assigned(FList.Items[Left])) And (TObject(FList.Items[Left]) is TPCJSONNameValue) then sLeft := TPCJSONNameValue( FList.Items[Left] ).Name
  else raise EPCParametresError.Create('Invalid JSON left index '+Left.ToString);
  if Right=-1 then sRight := FSearchingValue
  else if (Right>=0) and (Right<FList.Count) and (Assigned(FList.Items[Right])) And (TObject(FList.Items[Right]) is TPCJSONNameValue) then sRight := TPCJSONNameValue( FList.Items[Right] ).Name
  else raise EPCParametresError.Create('Invalid JSON right index '+Right.ToString);
  {$IFDEF JSONOBJECTS_NAMES_CASE_SENSITIVITY}
  // NOTE: CompareStr is case sensitivity
  Result := CompareStr(sLeft,sRight);
  {$ELSE}
  Result := CompareText(sLeft,sRight);
  {$ENDIF}
end;
{$ENDIF}

procedure TPCJSONObject.Delete(index: Integer);
begin
  {$IFDEF USE_BTREE}
  if (index<0) or (index>=FList.Count) then raise EPCParametresError.Create('Invalid delete index '+index.ToString+'/'+FList.Count.ToString);
  FSearchingValue :=  TPCJSONNameValue( FList.Items[index] ).Name;
  FOrderedByName.Delete(-1);
  {$ENDIF}
  inherited;
end;

procedure TPCJSONObject.DeleteName(Name: String);
Var i : Integer;
begin
  i := IndexOfName(Name);
  if (i>=0) then begin
    Delete(i);
  end;
end;

destructor TPCJSONObject.Destroy;
begin
  inherited;
  {$IFDEF USE_BTREE}
  FOrderedByName.Free;
  {$ENDIF}
end;

function TPCJSONObject.FindName(Name: String): TPCJSONNameValue;
Var i : Integer;
begin
  i := IndexOfName(Name);
  Result := Nil;
  if (i>=0) then Result := Items[i] as TPCJSONNameValue;
end;

function TPCJSONObject.GetAsArray(Name: String): TPCJSONArray;
Var NV : TPCJSONNameValue;
  V : TPCJSONData;
begin
  NV := GetByName(Name);
  if Not (NV.Value is TPCJSONArray) then begin
    NV.Value := TPCJSONArray.Create;
  end;
  Result := NV.Value as TPCJSONArray;
end;

function TPCJSONObject.GetAsObject(Name: String): TPCJSONObject;
Var NV : TPCJSONNameValue;
  V : TPCJSONData;
begin
  NV := GetByName(Name);
  if Not (NV.Value is TPCJSONObject) then begin
    NV.Value := TPCJSONObject.Create;
  end;
  Result := NV.Value as TPCJSONObject;
end;

function TPCJSONObject.GetAsVariant(Name: String): TPCJSONVariantValue;
Var NV : TPCJSONNameValue;
  V : TPCJSONData;
begin
  NV := GetByName(Name);
  if Not (NV.Value is TPCJSONVariantValue) then begin
    NV.Value := TPCJSONVariantValue.Create;
  end;
  Result := NV.Value as TPCJSONVariantValue;
end;

function TPCJSONObject.GetByName(Name: String): TPCJSONNameValue;
Var i : Integer;
begin
  i := GetIndexOrCreateName(Name);
  Result := Items[i] as TPCJSONNameValue;
end;

function TPCJSONObject.GetIndexOrCreateName(Name: String): Integer;
Var
  NV : TPCJSONNameValue;
Begin
  Result := IndexOfName(Name);
  if (Result<0) then begin
    CheckValidName(Name);
    NV := TPCJSONNameValue.Create(Name);
    Result := FList.Count;
    Insert(Result,NV);
  end;
end;

function TPCJSONObject.GetNameValue(Name: String): TPCJSONNameValue;
begin
  Result := Items[GetIndexOrCreateName(Name)] as TPCJSONNameValue;
end;

function TPCJSONObject.GetNameValue(index: Integer): TPCJSONNameValue;
begin
  Result := Items[index] as TPCJSONNameValue;
end;

function TPCJSONObject.IsNull(ParamName: String): Boolean;
Var i : Integer;
  NV : TPCJSONNameValue;
begin
  i := IndexOfName(ParamName);
  if i<0 then result := true
  else begin
    Result := false;
    NV := TPCJSONNameValue( FList.Items[i] );
    If (Assigned(NV.Value)) AND (NV.Value is TPCJSONVariantValue) then begin
      Result := TPCJSONVariantValue(NV.Value).IsNull;
    end;
  end;
end;

function TPCJSONObject.IndexOfName(Name: String): Integer;
{$IFDEF USE_BTREE}
var bnode : TMemoryBTree<Integer>.TAbstractBTreeNode;
  i : Integer;
{$ENDIF}
begin
  {$IFDEF USE_BTREE}
  FSearchingValue := Name;
  if FOrderedByName.Find(-1,bnode,i) then begin
    Result := bnode.data[i];
  end else Result := -1;
  {$ELSE}
  for Result := 0 to FList.Count - 1 do begin
    if (Assigned(FList.Items[Result])) And (TObject(FList.Items[Result]) is TPCJSONNameValue) then begin
      {$IFDEF JSONOBJECTS_NAMES_CASE_SENSITIVITY}
      // NOTE: CompareStr is case sensitivity
      If CompareStr(TPCJSONNameValue( FList.Items[Result] ).Name, Name)=0 then begin
        Exit;
      end;
      {$ELSE}
      if CompareText(TPCJSONNameValue( FList.Items[Result] ).Name, Name)=0 then begin
        Exit;
      end;
      {$ENDIF}
    end;
  end;
  Result := -1;
  {$ENDIF}
end;

procedure TPCJSONObject.Insert(Index: Integer; PCJSONData: TPCJSONData);
begin
  inherited;
  {$IFDEF USE_BTREE}
  FSearchingValue := TPCJSONNameValue(PCJSONData).Name;
  if not FOrderedByName.Add( Index ) then raise EPCParametresError.Create('Error adding "'+FSearchingValue+'" index '+Index.ToString+' on BTree');
  {$ENDIF}
end;

function TPCJSONObject.HasName(Name: String): Boolean;
begin
  Result := IndexOfName(Name) >= 0;
end;

Function TPCJSONObject.HasValue(const AParamName : String) : Boolean;
begin
  Result := HasName(AParamName) AND (NOT AsString(AParamName, String.Empty).IsEmpty);
end;


function TPCJSONObject.LoadAsStream(ParamName: String; Stream: TStream): Integer;
Var s : RawByteString;
begin
  s := AsString(ParamName,'');
  if (s<>'') then begin
    Stream.Write(s[Low(s)],length(s));
  end;
  Result := Length(s);
end;

function TPCJSONObject.SaveAsStream(ParamName: String; Stream: TStream): Integer;
Var s : RawByteString;
begin
  Stream.Position := 0;
  SetLength(s,Stream.Size);
  Stream.Read(s[Low(s)],Stream.Size);
  GetAsVariant(ParamName).Value := s;
end;

procedure TPCJSONObject.SetAs(Name: String; Value: TPCJSONData);
 // When assigning a object with SetAs this will not be freed automatically
Var NV : TPCJSONNameValue;
  V : TPCJSONData;
  i : Integer;
begin
  i := GetIndexOrCreateName(Name);
  NV := Items[i] as TPCJSONNameValue;
  NV.Value := Value;
  NV.FFreeValue := false;
end;

function TPCJSONObject.ToJSONFormatted(pretty: Boolean; const prefix: String): String;
Var i : Integer;
begin
  if pretty then Result := '{'+#10+prefix
  else Result := '{';
  for i := 0 to Count - 1 do begin
    if (i>0) then Begin
      Result := Result+',';
      If pretty then Result :=Result +#10+prefix;
    End;
    Result := Result + Items[i].ToJSONFormatted(pretty,prefix+'   ');
  end;
  Result := Result+'}';
end;

{ TPCJSONNameValue }

constructor TPCJSONNameValue.Create(AName: String);
begin
  inherited Create;
  FName := AName;
  FValue := TPCJSONData.Create;
  FFreeValue := True;
end;

destructor TPCJSONNameValue.Destroy;
begin
  if FFreeValue then FValue.Free;
  inherited;
end;

procedure TPCJSONNameValue.SetValue(const Value: TPCJSONData);
Var old : TPCJSONData;
begin
  if FValue=Value then exit;
  old := FValue;
  FValue := Value;
  if FFreeValue then old.Free;
  FFreeValue := true;
end;

function TPCJSONNameValue.ToJSONFormatted(pretty: Boolean; const prefix: String): String;
begin
  if pretty then Result := prefix else Result := '';
  Result := Result + UTF8JSONEncode(name,true)+':'+Value.ToJSONFormatted(pretty,prefix+'   ');
end;

{ TPCJSONData }

Var _objectsCount : Integer;

procedure TPCJSONData.Assign(PCJSONData: TPCJSONData);
Var i : Integer;
  NV : TPCJSONNameValue;
  JSOND : TPCJSONData;
  s : String;
begin
  if Not Assigned(PCJSONData) then Abort;
  if (PCJSONData is TPCJSONObject) AND (Self is TPCJSONObject) then begin
    for i := 0 to TPCJSONObject(PCJSONData).Count - 1 do begin
      NV := TPCJSONObject(PCJSONData).Items[i] as TPCJSONNameValue;
      if NV.Value is TPCJSONObject then begin
        TPCJSONObject(Self).GetAsObject(NV.Name).Assign(NV.Value);
      end else if NV.Value is TPCJSONArray then begin
        TPCJSONObject(Self).GetAsArray(NV.Name).Assign(NV.Value);
      end else if NV.Value is TPCJSONVariantValue then begin
        TPCJSONObject(Self).GetAsVariant(NV.Name).Assign(NV.Value);
      end else raise Exception.Create('Error in TPCJSONData.Assign decoding '+NV.Name+' ('+NV.Value.ClassName+')');
    end;
  end else if (PCJSONData is TPCJSONArray) AND (Self is TPCJSONArray) then begin
    for i := 0 to TPCJSONArray(PCJSONData).Count - 1 do begin
      JSOND := TPCJSONArray(PCJSONData).Items[i];
      s := JSOND.ToJSON(false);
      TPCJSONArray(Self).Insert(TPCJSONArray(Self).Count,TPCJSONData.ParseJSONValue(s));
    end;
  end else if (PCJSONData is TPCJSONVariantValue) AND (Self is TPCJSONVariantValue) then begin
    TPCJSONVariantValue(Self).Value := TPCJSONVariantValue(PCJSONData).Value;
  end else begin
    raise Exception.Create('Error in TPCJSONData.Assign assigning a '+PCJSONData.ClassName+' to a '+ClassName);
  end;

end;

constructor TPCJSONData.Create;
begin
   inc(_objectsCount);
end;

destructor TPCJSONData.Destroy;
begin
  dec(_objectsCount);
  inherited;
end;

class function TPCJSONData.JSONFormatSettings: TFormatSettings;
begin
  Result := _JSON_FormatSettings;
end;


class function TPCJSONData.ParseJSONValue(const JSONObject: TBytes
  ): TPCJSONData;
Var JS : TJSONValue;
  {$IFDEF FPC}
  jss : TJSONStringType;
  i : Integer;
  {$ENDIF}
begin
  Result := Nil;
  JS := Nil;
  {$IFDEF FPC}
  SetLength(jss,length(JSONObject));
  for i:=0 to High(JSONObject) do jss[i+1] := AnsiChar( JSONObject[i] );
  Try
    JS := GetJSON(jss);
  Except
    On E:Exception do begin
      // Nothing to do...
    end;
  end;
  {$ELSE}
  JS := TJSONObject.ParseJSONValue(JSONObject,0);
  {$ENDIF}
  if Not Assigned(JS) then exit;
  Try
    if JS is TJSONObject then begin
      Result := TPCJSONObject.CreateFromJSONObject(TJSONObject(JS));
    end else if JS is TJSONArray then begin
      Result := TPCJSONArray.CreateFromJSONArray(TJSONArray(JS));
    end else if JS is TJSONValue then begin
      Result := TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JS));
    end else raise EPCParametresError.Create('Invalid TJSON Data type '+JS.ClassName);
  Finally
    JS.Free;
  End;
end;

procedure TPCJSONData.SaveToStream(Stream: TStream);
Var s : RawByteString;
begin
  s := ToJSON(false);
  Stream.Write(s[Low(s)],Length(s));
end;

class function TPCJSONData.ParseJSONValue(const JSONObject: String
  ): TPCJSONData;
begin
  Result := ParseJSONValue( TEncoding.ASCII.GetBytes(JSONObject) );
end;

function TPCJSONData.ToJSON(pretty: Boolean): String;
begin
  Result := ToJSONFormatted(pretty,'');
end;

class function TPCJSONData._GetCount: Integer;
begin
  Result := _objectsCount;
end;

initialization
  _objectsCount := 0;
  _JSON_FormatSettings := FormatSettings;
  _JSON_FormatSettings.ThousandSeparator := ',';
  _JSON_FormatSettings.DecimalSeparator := '.';
end.