3349 lines
88 KiB
ObjectPascal
3349 lines
88 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcJSON.pas }
|
|
{ File version: 5.14 }
|
|
{ Description: JSON }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2011-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2011/05/28 0.01 Initial version with test cases. }
|
|
{ 2011/06/04 0.02 Validation from schema and test case. }
|
|
{ 2011/06/19 0.03 JSONValue improvements. }
|
|
{ 2011/07/02 0.04 Setters for JSONValues. }
|
|
{ 2011/07/24 0.05 Variant getters and setters. }
|
|
{ 2011/08/27 0.06 Getters and setters for JSONArray. }
|
|
{ 2013/03/22 4.07 UnicodeString changes. }
|
|
{ 2013/03/23 4.08 Improvements. }
|
|
{ 2015/03/31 4.09 Revision. }
|
|
{ 2015/05/05 4.10 JSONFloat type, dynamic array functions. }
|
|
{ 2016/01/09 5.11 Revised for Fundamentals 5. }
|
|
{ 2018/07/23 5.12 Delphi type changes. }
|
|
{ 2018/08/12 5.13 String type changes. }
|
|
{ 2020/06/02 5.14 Locale independent float conversion. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 7 Win32 4.09 2015/03/31 }
|
|
{ Delphi XE7 Win32 5.11 2016/01/09 }
|
|
{ Delphi XE7 Win64 5.11 2016/01/09 }
|
|
{ }
|
|
{ References: }
|
|
{ }
|
|
{ JSON Schemas - http://tools.ietf.org/html/draft-zyp-json-schema-03 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ..\flcInclude.inc}
|
|
|
|
{$IFDEF FREEPASCAL}
|
|
{$WARNINGS OFF}
|
|
{$HINTS OFF}
|
|
{$ENDIF}
|
|
|
|
unit flcJSON;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
SysUtils,
|
|
|
|
{ Fundamentals }
|
|
flcStdTypes,
|
|
flcStrings,
|
|
flcStringBuilder;
|
|
|
|
|
|
|
|
type
|
|
{ TJSON values }
|
|
|
|
EJSONValue = class(Exception);
|
|
|
|
EJSONSchema = class(EJSONValue);
|
|
|
|
TJSONValueType = (
|
|
jvtString,
|
|
jvtInteger,
|
|
jvtFloat,
|
|
jvtBoolean,
|
|
jvtNull,
|
|
jvtArray,
|
|
jvtObject
|
|
);
|
|
|
|
TJSONStringOptions = set of (
|
|
jboIndent
|
|
);
|
|
|
|
{$IFDEF ExtendedIsDouble}
|
|
JSONFloat = Double;
|
|
{$ELSE}
|
|
JSONFloat = Extended;
|
|
{$ENDIF}
|
|
JSONFloatArray = array of JSONFloat;
|
|
|
|
TJSONArray = class;
|
|
TJSONObject = class;
|
|
|
|
TJSONValue = class
|
|
protected
|
|
procedure BuildJSONString(
|
|
const A: TUnicodeStringBuilder;
|
|
const AOptions: TJSONStringOptions;
|
|
const ALevel: Integer); virtual;
|
|
|
|
function GetValueType: TJSONValueType; virtual;
|
|
|
|
function GetValueStr: UnicodeString; virtual;
|
|
function GetValueStrUTF8: RawByteString;
|
|
function GetValueInt: Int64; virtual;
|
|
function GetValueFloat: JSONFloat; virtual;
|
|
function GetValueBoolean: Boolean; virtual;
|
|
function GetValueArray: TJSONArray; virtual;
|
|
function GetValueObject: TJSONObject; virtual;
|
|
function GetValueVariant: Variant; virtual;
|
|
|
|
procedure SetValueStr(const AValue: UnicodeString); virtual;
|
|
procedure SetValueStrUTF8(const AValue: RawByteString); virtual;
|
|
procedure SetValueInt(const AValue: Int64); virtual;
|
|
procedure SetValueFloat(const AValue: JSONFloat); virtual;
|
|
procedure SetValueBoolean(const AValue: Boolean); virtual;
|
|
procedure SetValueVariant(const AValue: Variant); virtual;
|
|
|
|
function GetValueIsStr: Boolean; virtual;
|
|
function GetValueIsInt: Boolean; virtual;
|
|
function GetValueIsFloat: Boolean; virtual;
|
|
function GetValueIsBoolean: Boolean; virtual;
|
|
function GetValueIsNull: Boolean; virtual;
|
|
function GetValueIsArray: Boolean; virtual;
|
|
function GetValueIsObject: Boolean; virtual;
|
|
|
|
public
|
|
function Clone: TJSONValue; virtual;
|
|
|
|
function GetJSONString(const AOptions: TJSONStringOptions = []): UnicodeString;
|
|
function GetJSONStringUTF8(const AOptions: TJSONStringOptions = []): RawByteString;
|
|
|
|
property ValueType: TJSONValueType read GetValueType;
|
|
|
|
property ValueStr: UnicodeString read GetValueStr write SetValueStr;
|
|
property ValueStrUTF8: RawByteString read GetValueStrUTF8 write SetValueStrUTF8;
|
|
property ValueInt: Int64 read GetValueInt write SetValueInt;
|
|
property ValueFloat: JSONFloat read GetValueFloat write SetValueFloat;
|
|
property ValueBoolean: Boolean read GetValueBoolean write SetValueBoolean;
|
|
property ValueArray: TJSONArray read GetValueArray;
|
|
property ValueObject: TJSONObject read GetValueObject;
|
|
property ValueVariant: Variant read GetValueVariant write SetValueVariant;
|
|
|
|
property ValueIsStr: Boolean read GetValueIsStr;
|
|
property ValueIsInt: Boolean read GetValueIsInt;
|
|
property ValueIsFloat: Boolean read GetValueIsFloat;
|
|
property ValueIsBoolean: Boolean read GetValueIsBoolean;
|
|
property ValueIsNull: Boolean read GetValueIsNull;
|
|
property ValueIsArray: Boolean read GetValueIsArray;
|
|
property ValueIsObject: Boolean read GetValueIsObject;
|
|
|
|
function Compare(const A: TJSONValue): Integer; virtual;
|
|
procedure Validate(const Schema: TJSONObject); virtual;
|
|
end;
|
|
|
|
TJSONString = class(TJSONValue)
|
|
private
|
|
FValue : UnicodeString;
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueStr: UnicodeString; override;
|
|
function GetValueInt: Int64; override;
|
|
function GetValueFloat: JSONFloat; override;
|
|
function GetValueBoolean: Boolean; override;
|
|
function GetValueVariant: Variant; override;
|
|
function GetValueIsStr: Boolean; override;
|
|
procedure SetValueStr(const AValue: UnicodeString); override;
|
|
procedure SetValueInt(const AValue: Int64); override;
|
|
procedure SetValueFloat(const AValue: JSONFloat); override;
|
|
procedure SetValueBoolean(const AValue: Boolean); override;
|
|
|
|
public
|
|
constructor Create(const AValue: UnicodeString);
|
|
constructor CreateUTF8(const AValue: RawByteString);
|
|
|
|
function Clone: TJSONValue; override;
|
|
property Value: UnicodeString read FValue;
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
procedure Validate(const Schema: TJSONObject); override;
|
|
end;
|
|
|
|
TJSONInteger = class(TJSONValue)
|
|
private
|
|
FValue : Int64;
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueStr: UnicodeString; override;
|
|
function GetValueInt: Int64; override;
|
|
function GetValueFloat: JSONFloat; override;
|
|
function GetValueBoolean: Boolean; override;
|
|
function GetValueVariant: Variant; override;
|
|
function GetValueIsInt: Boolean; override;
|
|
procedure SetValueStr(const AValue: UnicodeString); override;
|
|
procedure SetValueInt(const AValue: Int64); override;
|
|
procedure SetValueBoolean(const AValue: Boolean); override;
|
|
|
|
public
|
|
constructor Create(const AValue: Int64);
|
|
|
|
function Clone: TJSONValue; override;
|
|
property Value: Int64 read FValue;
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
procedure Validate(const Schema: TJSONObject); override;
|
|
end;
|
|
|
|
TJSONFloat = class(TJSONValue)
|
|
private
|
|
FValue : JSONFloat;
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueStr: UnicodeString; override;
|
|
function GetValueFloat: JSONFloat; override;
|
|
function GetValueVariant: Variant; override;
|
|
function GetValueIsFloat: Boolean; override;
|
|
procedure SetValueStr(const AValue: UnicodeString); override;
|
|
procedure SetValueInt(const AValue: Int64); override;
|
|
procedure SetValueFloat(const AValue: JSONFloat); override;
|
|
|
|
public
|
|
constructor Create(const AValue: JSONFloat);
|
|
|
|
function Clone: TJSONValue; override;
|
|
property Value: JSONFloat read FValue;
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
procedure Validate(const Schema: TJSONObject); override;
|
|
end;
|
|
|
|
TJSONBoolean = class(TJSONValue)
|
|
private
|
|
FValue : Boolean;
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueStr: UnicodeString; override;
|
|
function GetValueInt: Int64; override;
|
|
function GetValueBoolean: Boolean; override;
|
|
function GetValueVariant: Variant; override;
|
|
function GetValueIsBoolean: Boolean; override;
|
|
procedure SetValueStr(const AValue: UnicodeString); override;
|
|
procedure SetValueBoolean(const AValue: Boolean); override;
|
|
|
|
public
|
|
constructor Create(const AValue: Boolean);
|
|
|
|
function Clone: TJSONValue; override;
|
|
property Value: Boolean read FValue;
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
end;
|
|
|
|
TJSONNull = class(TJSONValue)
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueVariant: Variant; override;
|
|
function GetValueIsNull: Boolean; override;
|
|
|
|
public
|
|
function Clone: TJSONValue; override;
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
end;
|
|
|
|
TJSONArray = class(TJSONValue)
|
|
private
|
|
FList : array of TJSONValue;
|
|
|
|
function GetCount: Integer;
|
|
function GetItem(const Idx: Integer): TJSONValue;
|
|
|
|
function GetItemAsStr(const Idx: Integer): UnicodeString;
|
|
function GetItemAsStrUTF8(const Idx: Integer): RawByteString;
|
|
function GetItemAsInt(const Idx: Integer): Int64;
|
|
function GetItemAsFloat(const Idx: Integer): JSONFloat;
|
|
function GetItemAsBoolean(const Idx: Integer): Boolean;
|
|
function GetItemAsArray(const Idx: Integer): TJSONArray;
|
|
function GetItemAsObject(const Idx: Integer): TJSONObject;
|
|
function GetItemAsVariant(const Idx: Integer): Variant;
|
|
|
|
procedure SetItemAsStr(const Idx: Integer; const Value: UnicodeString);
|
|
procedure SetItemAsStrUTF8(const Idx: Integer; const Value: RawByteString);
|
|
procedure SetItemAsInt(const Idx: Integer; const Value: Int64);
|
|
procedure SetItemAsFloat(const Idx: Integer; const Value: JSONFloat);
|
|
procedure SetItemAsBoolean(const Idx: Integer; const Value: Boolean);
|
|
procedure SetItemAsVariant(const Idx: Integer; const Value: Variant);
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueArray: TJSONArray; override;
|
|
function GetValueIsArray: Boolean; override;
|
|
|
|
public
|
|
constructor Create;
|
|
constructor CreateEx(const Values: array of const);
|
|
destructor Destroy; override;
|
|
|
|
function Clone: TJSONValue; override;
|
|
|
|
procedure Clear;
|
|
property Count: Integer read GetCount;
|
|
property Item[const Idx: Integer]: TJSONValue read GetItem; default;
|
|
|
|
function ItemIsNull(const Idx: Integer): Boolean;
|
|
property ItemAsStr[const Idx: Integer]: UnicodeString read GetItemAsStr write SetItemAsStr;
|
|
property ItemAsStrUTF8[const Idx: Integer]: RawByteString read GetItemAsStrUTF8 write SetItemAsStrUTF8;
|
|
property ItemAsInt[const Idx: Integer]: Int64 read GetItemAsInt write SetItemAsInt;
|
|
property ItemAsFloat[const Idx: Integer]: JSONFloat read GetItemAsFloat write SetItemAsFloat;
|
|
property ItemAsBoolean[const Idx: Integer]: Boolean read GetItemAsBoolean write SetItemAsBoolean;
|
|
property ItemAsArray[const Idx: Integer]: TJSONArray read GetItemAsArray;
|
|
property ItemAsObject[const Idx: Integer]: TJSONObject read GetItemAsObject;
|
|
property ItemAsVariant[const Idx: Integer]: Variant read GetItemAsVariant write SetItemAsVariant;
|
|
|
|
procedure Append(const A: TJSONValue);
|
|
procedure AppendStr(const A: UnicodeString);
|
|
procedure AppendStrUTF8(const A: RawByteString);
|
|
procedure AppendInt(const A: Int64);
|
|
procedure AppendFloat(const A: JSONFloat);
|
|
procedure AppendBoolean(const A: Boolean);
|
|
procedure AppendNull;
|
|
procedure AppendVariant(const A : Variant);
|
|
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
procedure Validate(const Schema: TJSONObject); override;
|
|
|
|
function GetAsStrArray: UnicodeStringArray;
|
|
function GetAsStrArrayUTF8: RawByteStringArray;
|
|
function GetAsIntArray: Int64Array;
|
|
function GetAsFloatArray: JSONFloatArray;
|
|
end;
|
|
|
|
TJSONObjectItem = record
|
|
Name : UnicodeString;
|
|
Value : TJSONValue;
|
|
end;
|
|
PJSONObjectItem = ^TJSONObjectItem;
|
|
|
|
TJSONObjectIterator = record
|
|
InternalIndex : Integer;
|
|
Item : TJSONObjectItem;
|
|
end;
|
|
|
|
TJSONObject = class(TJSONValue)
|
|
private
|
|
FList : array of TJSONObjectItem;
|
|
|
|
function GetCount: Integer;
|
|
function GetItemIndexByName(const Name: UnicodeString; out Item: PJSONObjectItem): Integer;
|
|
function GetItemByName(const Name: UnicodeString): PJSONObjectItem;
|
|
function GetItemValueByName(const Name: UnicodeString): TJSONValue;
|
|
|
|
protected
|
|
procedure BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer); override;
|
|
function GetValueType: TJSONValueType; override;
|
|
function GetValueObject: TJSONObject; override;
|
|
function GetValueIsObject: Boolean; override;
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function Clone: TJSONValue; override;
|
|
|
|
procedure Clear;
|
|
property Count: Integer read GetCount;
|
|
property Item[const Name: UnicodeString]: TJSONValue read GetItemValueByName; default;
|
|
procedure Add(const Name: UnicodeString; const Value: TJSONValue);
|
|
function Exists(const Name: UnicodeString): Boolean; overload;
|
|
function Exists(const Name: UnicodeString; out Value: TJSONValue): Boolean; overload;
|
|
|
|
function ItemIsNull(const Name: UnicodeString): Boolean;
|
|
function GetItemAsStr(const Name: UnicodeString; const Default: UnicodeString = ''): UnicodeString;
|
|
function GetItemAsStrUTF8(const Name: UnicodeString; const Default: RawByteString = ''): RawByteString;
|
|
function GetItemAsInt(const Name: UnicodeString; const Default: Int64 = 0): Int64;
|
|
function GetItemAsFloat(const Name: UnicodeString; const Default: JSONFloat = 0.0): JSONFloat;
|
|
function GetItemAsBoolean(const Name: UnicodeString; const Default: Boolean = False): Boolean;
|
|
function GetItemAsArray(const Name: UnicodeString): TJSONArray;
|
|
function GetItemAsObject(const Name: UnicodeString): TJSONObject;
|
|
function GetItemAsVariant(const Name: UnicodeString): Variant;
|
|
|
|
function RequireItemAsArray(const Name: UnicodeString): TJSONArray;
|
|
function RequireItemAsObject(const Name: UnicodeString): TJSONObject;
|
|
|
|
procedure SetItemAsStr(const Name: UnicodeString; const Value: UnicodeString);
|
|
procedure SetItemAsStrUTF8(const Name: UnicodeString; const Value: RawByteString);
|
|
procedure SetItemAsInt(const Name: UnicodeString; const Value: Int64);
|
|
procedure SetItemAsFloat(const Name: UnicodeString; const Value: JSONFloat);
|
|
procedure SetItemAsBoolean(const Name: UnicodeString; const Value: Boolean);
|
|
procedure SetItemAsVariant(const Name: UnicodeString; const Value: Variant);
|
|
|
|
function Iterate(var Iterator: TJSONObjectIterator): Boolean;
|
|
function IterateNext(var Iterator: TJSONObjectIterator): Boolean;
|
|
procedure IterateClose(var Iterator: TJSONObjectIterator);
|
|
|
|
function Compare(const A: TJSONValue): Integer; override;
|
|
procedure Validate(const Schema: TJSONObject); override;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONParser }
|
|
|
|
TJSONParserToken = (
|
|
jptNone,
|
|
jptEOF,
|
|
jptWhiteSpace,
|
|
jptLeftSquare,
|
|
jptRightSquare,
|
|
jptLeftCurly,
|
|
jptRightCurly,
|
|
jptColon,
|
|
jptComma,
|
|
jptTrue,
|
|
jptFalse,
|
|
jptNull,
|
|
jptInteger,
|
|
jptFloat,
|
|
jptSciFloat,
|
|
jptString
|
|
);
|
|
|
|
TJSONParser = class
|
|
private
|
|
FText : UnicodeString;
|
|
FTextLength : Integer;
|
|
FTextPos : Integer;
|
|
FTextRow : Integer;
|
|
FTextRowPos : Integer;
|
|
FTextChar : WideChar;
|
|
FTextEOF : Boolean;
|
|
|
|
FToken : TJSONParserToken;
|
|
FTokenPos : Integer;
|
|
FTokenLen : Integer;
|
|
FTokenInteger : Int64;
|
|
FTokenFloat : JSONFloat;
|
|
FTokenStrBuilder : TUnicodeStringBuilder;
|
|
FTokenStr : UnicodeString;
|
|
|
|
procedure SetText(const AText: UnicodeString);
|
|
procedure InitParser;
|
|
|
|
function GetNextChar: WideChar;
|
|
function ExpectNextChar: WideChar;
|
|
|
|
function GetTokenTextPtr: PWideChar;
|
|
function ParseToken_UnsignedInteger(const Ch: WideChar): Int64;
|
|
function ParseToken_ExpectUnsignedInteger(const Ch: WideChar): Int64;
|
|
function ParseToken_SignedInteger(const Ch: WideChar): Int64;
|
|
function ParseToken_ExpectSignedInteger(const Ch: WideChar): Int64;
|
|
function ParseToken_Float(const Ch: WideChar): JSONFloat;
|
|
function ParseToken_Number(const Ch: WideChar): TJSONParserToken;
|
|
function ParseToken_String_Escaped_Hex4(const Ch: WideChar): WideChar;
|
|
function ParseToken_String_Escaped(const Ch: WideChar): WideChar;
|
|
function ParseToken_String(const Ch: WideChar): TJSONParserToken;
|
|
function GetAnyNextToken: TJSONParserToken;
|
|
function GetNextToken: TJSONParserToken;
|
|
function RequireNextToken: TJSONParserToken;
|
|
|
|
function ParseNamedLiteral(const AToken: TJSONParserToken): TJSONValue;
|
|
function ParseNumber(const AToken: TJSONParserToken): TJSONValue;
|
|
function ParseString: TJSONValue;
|
|
function ParseRequiredStringValue: UnicodeString;
|
|
function ParseArray: TJSONArray;
|
|
function ParseObject: TJSONObject;
|
|
function ParseValue(const AToken: TJSONParserToken): TJSONValue;
|
|
function ParseRequiredValue(const AToken: TJSONParserToken): TJSONValue;
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function ParseText(const AText: UnicodeString): TJSONValue;
|
|
function ParseTextUTF8(const AText: RawByteString): TJSONValue;
|
|
end;
|
|
|
|
EJSONParser = class(Exception);
|
|
|
|
|
|
|
|
{ }
|
|
{ JSON helpers }
|
|
{ }
|
|
function ParseJSONText(const JSONText: UnicodeString): TJSONValue;
|
|
function ParseJSONTextUTF8(const JSONText: RawByteString): TJSONValue;
|
|
|
|
function GetSchemaSchemaObj: TJSONObject;
|
|
procedure ValidateSchema(const Schema: TJSONObject);
|
|
|
|
|
|
|
|
{ }
|
|
{ Self-testing code }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ System }
|
|
Math,
|
|
Variants,
|
|
|
|
{ Fundamentals }
|
|
flcUtils,
|
|
flcFloats,
|
|
flcASCII,
|
|
flcUTF;
|
|
|
|
|
|
|
|
{ JSON value helpers }
|
|
|
|
const
|
|
SJSONBoolean : array[Boolean] of UnicodeString = ('false', 'true');
|
|
SJSONNull = 'null';
|
|
SJSONIndent = ' ';
|
|
|
|
SSchemaTypeAny = 'any';
|
|
SSchemaTypeStr : array[TJSONValueType] of UnicodeString = (
|
|
'string',
|
|
'integer',
|
|
'number',
|
|
'boolean',
|
|
'null',
|
|
'array',
|
|
'object');
|
|
|
|
SSchemaField_Type = 'type';
|
|
SSchemaField_Enum = 'enum';
|
|
SSchemaField_MinLength = 'minLength';
|
|
SSchemaField_MaxLength = 'maxLength';
|
|
SSchemaField_Minimum = 'minimum';
|
|
SSchemaField_Maximum = 'maximum';
|
|
SSchemaField_ExclusiveMinimum = 'exclusiveMinimum';
|
|
SSchemaField_ExclusiveMaximum = 'exclusiveMaximum';
|
|
SSchemaField_MinItems = 'minItems';
|
|
SSchemaField_MaxItems = 'maxItems';
|
|
SSchemaField_Properties = 'properties';
|
|
SSchemaField_Required = 'required';
|
|
SSchemaField_Items = 'items';
|
|
|
|
SErr_InvalidSchema = 'Invalid schema: %s';
|
|
SErr_ValidationFailed = 'Validation failed: %s';
|
|
SErr_InvalidValueType = 'Invalid value type';
|
|
SErr_ValueOutOfRange = 'Value out of range';
|
|
SErr_InvalidLength = 'Invalid length';
|
|
SErr_InvalidItemCount = 'Invalid item count';
|
|
SErr_InvalidValue = 'Invalid value';
|
|
|
|
function EscapedJSONStringValue(const S: UnicodeString): UnicodeString;
|
|
var T : UnicodeString;
|
|
begin
|
|
|
|
T := S;
|
|
T := StrReplaceCharStrU('\', '\\', T);
|
|
T := StrReplaceCharStrU('/', '\/', T);
|
|
T := StrReplaceCharStrU('"', '\"', T);
|
|
T := StrReplaceCharStrU(WideBS, '\b', T);
|
|
T := StrReplaceCharStrU(WideFF, '\f', T);
|
|
T := StrReplaceCharStrU(WideLF, '\n', T);
|
|
T := StrReplaceCharStrU(WideCR, '\r', T);
|
|
T := StrReplaceCharStrU(WideHT, '\t', T);
|
|
T := StrReplaceCharStrU(WideNULL, '\u0000', T);
|
|
T := StrReplaceCharStrU(WideEOF, '\u001A', T);
|
|
Result := T;
|
|
end;
|
|
|
|
function QuotedJSONStringValue(const S: UnicodeString): UnicodeString;
|
|
begin
|
|
Result := '"' + EscapedJSONStringValue(S) + '"';
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONValue }
|
|
|
|
function TJSONValue.Clone: TJSONValue;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Clone not implemented', [ClassName]);
|
|
end;
|
|
|
|
procedure TJSONValue.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
raise EJSONValue.CreateFmt(' %s: Conversion to JSON string not implemented', [ClassName]);
|
|
end;
|
|
|
|
function TJSONValue.GetJSONString(const AOptions: TJSONStringOptions): UnicodeString;
|
|
var B : TUnicodeStringBuilder;
|
|
begin
|
|
B := TUnicodeStringBuilder.Create;
|
|
try
|
|
BuildJSONString(B, AOptions, 0);
|
|
Result := B.AsUnicodeString;
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJSONValue.GetJSONStringUTF8(const AOptions: TJSONStringOptions): RawByteString;
|
|
begin
|
|
Result := UnicodeStringToUTF8String(GetJSONString(AOptions));
|
|
end;
|
|
|
|
function TJSONValue.GetValueType: TJSONValueType;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: GetValueType not implemented', [ClassName]);
|
|
end;
|
|
|
|
function TJSONValue.GetValueStr: UnicodeString;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported', [ClassName, 'string']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueStrUTF8: RawByteString;
|
|
begin
|
|
Result := UnicodeStringToUTF8String(GetValueStr);
|
|
end;
|
|
|
|
function TJSONValue.GetValueInt: Int64;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'integer']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueFloat: JSONFloat;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'float']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueBoolean: Boolean;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'boolean']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueObject: TJSONObject;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'object']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueArray: TJSONArray;
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'array']);
|
|
end;
|
|
|
|
function TJSONValue.GetValueVariant: Variant;
|
|
begin
|
|
case GetValueType of
|
|
jvtString : Result := GetValueStr;
|
|
jvtInteger : Result := GetValueInt;
|
|
jvtFloat : Result := GetValueFloat;
|
|
jvtBoolean : Result := GetValueBoolean;
|
|
jvtNull : Result := Null;
|
|
else
|
|
raise EJSONValue.CreateFmt('%s: Conversion of value to %s not supported',
|
|
[ClassName, 'variant']);
|
|
end;
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueStr(const AValue: UnicodeString);
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion from %s value not supported',
|
|
[ClassName, 'string']);
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueStrUTF8(const AValue: RawByteString);
|
|
begin
|
|
SetValueStr(UTF8StringToUnicodeString(AValue));
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueInt(const AValue: Int64);
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion from %s value not supported',
|
|
[ClassName, 'integer']);
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueFloat(const AValue: JSONFloat);
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion from %s value not supported',
|
|
[ClassName, 'float']);
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueBoolean(const AValue: Boolean);
|
|
begin
|
|
raise EJSONValue.CreateFmt('%s: Conversion from %s value not supported',
|
|
[ClassName, 'boolean']);
|
|
end;
|
|
|
|
procedure TJSONValue.SetValueVariant(const AValue: Variant);
|
|
begin
|
|
case VarType(AValue) of
|
|
varByte,
|
|
varWord,
|
|
varLongWord,
|
|
varSmallint,
|
|
varShortInt,
|
|
varInteger,
|
|
varInt64 : SetValueInt(AValue);
|
|
varSingle,
|
|
varDouble,
|
|
varCurrency : SetValueFloat(AValue);
|
|
varString : SetValueStr(AValue);
|
|
varBoolean : SetValueBoolean(AValue);
|
|
else
|
|
raise EJSONValue.CreateFmt('%s: Conversion from %s value not supported',
|
|
[ClassName, 'variant']);
|
|
end;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsStr: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtString;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsInt: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtInteger;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsFloat: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtFloat;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsBoolean: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtBoolean;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsNull: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtNull;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsArray: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtArray;
|
|
end;
|
|
|
|
function TJSONValue.GetValueIsObject: Boolean;
|
|
begin
|
|
Result := GetValueType = jvtObject;
|
|
end;
|
|
|
|
function TJSONValue.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
Assert(Assigned(A));
|
|
raise EJSONValue.CreateFmt('%s: Compare with %s not implemented',
|
|
[ClassName, A.ClassName]);
|
|
end;
|
|
|
|
procedure TJSONValue.Validate(const Schema: TJSONObject);
|
|
var A, P : TJSONValue;
|
|
B : TJSONArray;
|
|
I : Integer;
|
|
T : UnicodeString;
|
|
R : Boolean;
|
|
S : UnicodeString;
|
|
begin
|
|
if not Assigned(Schema) then
|
|
exit;
|
|
A := Schema[SSchemaField_Type];
|
|
if Assigned(A) then
|
|
begin
|
|
if A is TJSONArray then
|
|
begin
|
|
B := TJSONArray(A);
|
|
R := False;
|
|
S := SSchemaTypeStr[GetValueType];
|
|
for I := 0 to B.GetCount - 1 do
|
|
begin
|
|
P := B.GetItem(I);
|
|
if P is TJSONString then
|
|
begin
|
|
T := TJSONString(P).Value;
|
|
if T <> '' then
|
|
if (T = SSchemaTypeAny) or (T = S) then
|
|
begin
|
|
R := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
if not R then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidValueType])
|
|
end else
|
|
if A is TJSONString then
|
|
begin
|
|
T := A.ValueStr;
|
|
if (T <> '') and (T <> SSchemaTypeAny) then
|
|
begin
|
|
S := SSchemaTypeStr[GetValueType];
|
|
if T <> S then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidValueType])
|
|
end;
|
|
end
|
|
else
|
|
raise EJSONSchema.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "type" field']);
|
|
end;
|
|
A := Schema[SSchemaField_Enum];
|
|
if Assigned(A) then
|
|
begin
|
|
if not (A is TJSONArray) then
|
|
raise EJSONSchema.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "enum" field']);
|
|
B := TJSONArray(A);
|
|
R := False;
|
|
for I := 0 to B.GetCount - 1 do
|
|
if Compare(B.GetItem(I)) = 0 then
|
|
begin
|
|
R := True;
|
|
break;
|
|
end;
|
|
if not R then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidValue]);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONString }
|
|
|
|
constructor TJSONString.Create(const AValue: UnicodeString);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
constructor TJSONString.CreateUTF8(const AValue: RawByteString);
|
|
begin
|
|
inherited Create;
|
|
SetValueStrUTF8(AValue);
|
|
end;
|
|
|
|
function TJSONString.Clone: TJSONValue;
|
|
begin
|
|
Result := TJSONString.Create(FValue);
|
|
end;
|
|
|
|
procedure TJSONString.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
A.AppendCh(WideChar('"'));
|
|
A.Append(EscapedJSONStringValue(FValue));
|
|
A.AppendCh(WideChar('"'));
|
|
end;
|
|
|
|
function TJSONString.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtString;
|
|
end;
|
|
|
|
function TJSONString.GetValueStr: UnicodeString;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TJSONString.GetValueInt: Int64;
|
|
begin
|
|
Result := StrToInt64(FValue);
|
|
end;
|
|
|
|
function TJSONString.GetValueFloat: JSONFloat;
|
|
begin
|
|
Result := StringToFloatU(FValue);
|
|
end;
|
|
|
|
function TJSONString.GetValueBoolean: Boolean;
|
|
begin
|
|
if FValue = SJSONBoolean[False] then
|
|
Result := False
|
|
else
|
|
if FValue = SJSONBoolean[True] then
|
|
Result := True
|
|
else
|
|
raise EJSONValue.Create(SErr_InvalidValue);
|
|
end;
|
|
|
|
function TJSONString.GetValueVariant: Variant;
|
|
begin
|
|
Result := GetValueBoolean;
|
|
end;
|
|
|
|
function TJSONString.GetValueIsStr: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJSONString.SetValueStr(const AValue: UnicodeString);
|
|
begin
|
|
FValue := AValue;
|
|
end;
|
|
|
|
procedure TJSONString.SetValueInt(const AValue: Int64);
|
|
begin
|
|
FValue := IntToStr(AValue);
|
|
end;
|
|
|
|
procedure TJSONString.SetValueFloat(const AValue: JSONFloat);
|
|
begin
|
|
FValue := FloatToStringU(AValue);
|
|
end;
|
|
|
|
procedure TJSONString.SetValueBoolean(const AValue: Boolean);
|
|
begin
|
|
FValue := SJSONBoolean[AValue];
|
|
end;
|
|
|
|
function TJSONString.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
if A is TJSONString then
|
|
Result := StrCompareU(FValue, TJSONString(A).FValue)
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
procedure TJSONString.Validate(const Schema: TJSONObject);
|
|
var A : TJSONValue;
|
|
begin
|
|
inherited Validate(Schema);
|
|
A := Schema[SSchemaField_MinLength];
|
|
if Assigned(A) then
|
|
if not A.ValueIsInt then
|
|
raise EJSONValue.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "minLength" field'])
|
|
else
|
|
if Length(FValue) < A.ValueInt then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidLength]);
|
|
A := Schema[SSchemaField_MaxLength];
|
|
if Assigned(A) then
|
|
if not A.ValueIsInt then
|
|
raise EJSONValue.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "maxLength" field'])
|
|
else
|
|
if Length(FValue) > A.ValueInt then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidLength]);
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONInteger }
|
|
|
|
constructor TJSONInteger.Create(const AValue: Int64);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
function TJSONInteger.Clone: TJSONValue;
|
|
begin
|
|
Result := TJSONInteger.Create(FValue);
|
|
end;
|
|
|
|
procedure TJSONInteger.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
A.Append(IntToStr(FValue));
|
|
end;
|
|
|
|
function TJSONInteger.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtInteger;
|
|
end;
|
|
|
|
function TJSONInteger.GetValueStr: UnicodeString;
|
|
begin
|
|
Result := IntToStr(FValue);
|
|
end;
|
|
|
|
function TJSONInteger.GetValueInt: Int64;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TJSONInteger.GetValueFloat: JSONFloat;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TJSONInteger.GetValueBoolean: Boolean;
|
|
begin
|
|
Result := FValue <> 0;
|
|
end;
|
|
|
|
function TJSONInteger.GetValueVariant: Variant;
|
|
begin
|
|
Result := GetValueInt;
|
|
end;
|
|
|
|
function TJSONInteger.GetValueIsInt: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJSONInteger.SetValueStr(const AValue: UnicodeString);
|
|
begin
|
|
FValue := StrToInt64(AValue);
|
|
end;
|
|
|
|
procedure TJSONInteger.SetValueInt(const AValue: Int64);
|
|
begin
|
|
FValue := AValue;
|
|
end;
|
|
|
|
procedure TJSONInteger.SetValueBoolean(const AValue: Boolean);
|
|
begin
|
|
FValue := Ord(AValue);
|
|
end;
|
|
|
|
function TJSONInteger.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
if A is TJSONInteger then
|
|
begin
|
|
if FValue > TJSONInteger(A).FValue then
|
|
Result := 1 else
|
|
if FValue < TJSONInteger(A).FValue then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end else
|
|
if A is TJSONFloat then
|
|
begin
|
|
if FValue > TJSONFloat(A).FValue then
|
|
Result := 1 else
|
|
if FValue < TJSONFloat(A).FValue then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
procedure TJSONInteger.Validate(const Schema: TJSONObject);
|
|
var A : TJSONValue;
|
|
B : TJSONValue;
|
|
R : Boolean;
|
|
begin
|
|
inherited Validate(Schema);
|
|
A := Schema[SSchemaField_Minimum];
|
|
if Assigned(A) then
|
|
begin
|
|
B := Schema[SSchemaField_ExclusiveMinimum];
|
|
if Assigned(B) then
|
|
R := B.ValueBoolean
|
|
else
|
|
R := False;
|
|
if (not R and (FValue < A.ValueInt)) or
|
|
(R and (FValue <= A.ValueInt)) then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_ValueOutOfRange]);
|
|
end;
|
|
A := Schema[SSchemaField_Maximum];
|
|
if Assigned(A) then
|
|
begin
|
|
B := Schema[SSchemaField_ExclusiveMaximum];
|
|
if Assigned(B) then
|
|
R := B.ValueBoolean
|
|
else
|
|
R := False;
|
|
if (not R and (FValue > A.ValueInt)) or
|
|
(R and (FValue >= A.ValueInt)) then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_ValueOutOfRange]);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONFloat }
|
|
|
|
constructor TJSONFloat.Create(const AValue: JSONFloat);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
function TJSONFloat.Clone: TJSONValue;
|
|
begin
|
|
Result := TJSONFloat.Create(FValue);
|
|
end;
|
|
|
|
procedure TJSONFloat.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
A.Append(FloatToStringU(FValue));
|
|
end;
|
|
|
|
function TJSONFloat.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtFloat;
|
|
end;
|
|
|
|
function TJSONFloat.GetValueStr: UnicodeString;
|
|
begin
|
|
Result := FloatToStr(FValue);
|
|
end;
|
|
|
|
function TJSONFloat.GetValueFloat: JSONFloat;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TJSONFloat.GetValueVariant: Variant;
|
|
begin
|
|
Result := GetValueFloat;
|
|
end;
|
|
|
|
function TJSONFloat.GetValueIsFloat: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJSONFloat.SetValueStr(const AValue: UnicodeString);
|
|
begin
|
|
FValue := StringToFloatU(AValue);
|
|
end;
|
|
|
|
procedure TJSONFloat.SetValueInt(const AValue: Int64);
|
|
begin
|
|
FValue := AValue;
|
|
end;
|
|
|
|
procedure TJSONFloat.SetValueFloat(const AValue: JSONFloat);
|
|
begin
|
|
FValue := AValue;
|
|
end;
|
|
|
|
function TJSONFloat.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
if A is TJSONFloat then
|
|
begin
|
|
if FValue > TJSONFloat(A).FValue then
|
|
Result := 1 else
|
|
if FValue < TJSONFloat(A).FValue then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end else
|
|
if A is TJSONInteger then
|
|
begin
|
|
if FValue > TJSONInteger(A).FValue then
|
|
Result := 1 else
|
|
if FValue < TJSONInteger(A).FValue then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
procedure TJSONFloat.Validate(const Schema: TJSONObject);
|
|
var A : TJSONValue;
|
|
B : TJSONValue;
|
|
R : Boolean;
|
|
begin
|
|
inherited Validate(Schema);
|
|
A := Schema[SSchemaField_Minimum];
|
|
if Assigned(A) then
|
|
begin
|
|
B := Schema[SSchemaField_ExclusiveMinimum];
|
|
if Assigned(B) then
|
|
R := B.ValueBoolean
|
|
else
|
|
R := False;
|
|
if (not R and (FValue < A.ValueFloat)) or
|
|
(R and (FValue <= A.ValueFloat)) then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_ValueOutOfRange]);
|
|
end;
|
|
A := Schema[SSchemaField_Maximum];
|
|
if Assigned(A) then
|
|
begin
|
|
B := Schema[SSchemaField_ExclusiveMaximum];
|
|
if Assigned(B) then
|
|
R := B.ValueBoolean
|
|
else
|
|
R := False;
|
|
if (not R and (FValue > A.ValueFloat)) or
|
|
(R and (FValue >= A.ValueFloat)) then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_ValueOutOfRange]);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONBoolean }
|
|
|
|
constructor TJSONBoolean.Create(const AValue: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
function TJSONBoolean.Clone: TJSONValue;
|
|
begin
|
|
Result := TJSONBoolean.Create(FValue);
|
|
end;
|
|
|
|
procedure TJSONBoolean.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
A.Append(SJSONBoolean[FValue]);
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtBoolean;
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueStr: UnicodeString;
|
|
begin
|
|
Result := SJSONBoolean[FValue];
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueInt: Int64;
|
|
begin
|
|
Result := Ord(FValue);
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueBoolean: Boolean;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueVariant: Variant;
|
|
begin
|
|
Result := GetValueBoolean;
|
|
end;
|
|
|
|
function TJSONBoolean.GetValueIsBoolean: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJSONBoolean.SetValueStr(const AValue: UnicodeString);
|
|
begin
|
|
if AValue = SJSONBoolean[False] then
|
|
FValue := False
|
|
else
|
|
if AValue = SJSONBoolean[True] then
|
|
FValue := True
|
|
else
|
|
raise EJSONValue.Create(SErr_InvalidValue);
|
|
end;
|
|
|
|
procedure TJSONBoolean.SetValueBoolean(const AValue: Boolean);
|
|
begin
|
|
FValue := AValue;
|
|
end;
|
|
|
|
function TJSONBoolean.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
if A is TJSONBoolean then
|
|
begin
|
|
if FValue > TJSONBoolean(A).FValue then
|
|
Result := 1 else
|
|
if FValue < TJSONBoolean(A).FValue then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONNull }
|
|
|
|
function TJSONNull.Clone: TJSONValue;
|
|
begin
|
|
Result := TJSONNull.Create;
|
|
end;
|
|
|
|
procedure TJSONNull.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
begin
|
|
A.Append(SJSONNull);
|
|
end;
|
|
|
|
function TJSONNull.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtNull;
|
|
end;
|
|
|
|
function TJSONNull.GetValueVariant: Variant;
|
|
begin
|
|
Result := Null;
|
|
end;
|
|
|
|
function TJSONNull.GetValueIsNull: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TJSONNull.Compare(const A: TJSONValue): Integer;
|
|
begin
|
|
if A is TJSONNull then
|
|
Result := 0
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
|
|
|
|
{ TVarRec }
|
|
|
|
function VarRecToJSONValue(const Value: TVarRec): TJSONValue;
|
|
begin
|
|
case Value.VType of
|
|
System.vtInteger : Result := TJSONInteger.Create(Value.VInteger);
|
|
System.vtBoolean : Result := TJSONBoolean.Create(Value.VBoolean);
|
|
System.vtChar : Result := TJSONString.Create(ToStringChB(Value.VChar));
|
|
System.vtExtended : Result := TJSONFloat.Create(Value.VExtended^);
|
|
{$IFDEF SupportAnsiString}
|
|
System.vtString : Result := TJSONString.Create(String(Value.VString^));
|
|
{$ENDIF}
|
|
System.vtPointer : if not Assigned(Value.VPointer) then
|
|
Result := TJSONNull.Create
|
|
else
|
|
raise EJSONValue.Create('VarRec value not supported');
|
|
{$IFDEF SupportAnsiString}
|
|
System.vtPChar : Result := TJSONString.Create(ToStringA(Value.VPChar^));
|
|
{$ENDIF}
|
|
System.vtWideChar : Result := TJSONString.Create(ToStringChW(Value.VWideChar));
|
|
System.vtPWideChar : Result := TJSONString.Create(Value.VPWideChar^);
|
|
{$IFDEF SupportAnsiString}
|
|
System.vtAnsiString : Result := TJSONString.Create(ToStringA(AnsiString(Value.VAnsiString)));
|
|
{$ENDIF}
|
|
System.vtCurrency : Result := TJSONFloat.Create(Value.VCurrency^);
|
|
{$IFDEF SupportWideString}
|
|
System.vtWideString : Result := TJSONString.Create(UnicodeString(WideString(Value.VWideString)));
|
|
{$ENDIF}
|
|
System.vtInt64 : Result := TJSONInteger.Create(Value.VInt64^);
|
|
{$IFDEF SupportUnicodeString}
|
|
System.vtUnicodeString : Result := TJSONString.Create(UnicodeString(Value.VUnicodeString));
|
|
{$ENDIF}
|
|
else
|
|
raise EJSONValue.Create('VarRec value type not supported');
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONArray }
|
|
|
|
constructor TJSONArray.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
constructor TJSONArray.CreateEx(const Values: array of const);
|
|
var L, I : Integer;
|
|
begin
|
|
inherited Create;
|
|
L := Length(Values);
|
|
SetLength(FList, L);
|
|
for I := 0 to L - 1 do
|
|
FList[I] := nil;
|
|
for I := 0 to L - 1 do
|
|
FList[I] := VarRecToJSONValue(Values[I]);
|
|
end;
|
|
|
|
destructor TJSONArray.Destroy;
|
|
var I : Integer;
|
|
begin
|
|
for I := Length(FList) - 1 downto 0 do
|
|
FreeAndNil(FList[I]);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJSONArray.Clone: TJSONValue;
|
|
var A : TJSONArray;
|
|
I : Integer;
|
|
begin
|
|
A := TJSONArray.Create;
|
|
try
|
|
for I := 0 to Length(FList) - 1 do
|
|
A.Append(FList[I].Clone);
|
|
except
|
|
A.Free;
|
|
raise;
|
|
end;
|
|
Result := A;
|
|
end;
|
|
|
|
procedure TJSONArray.Clear;
|
|
var I : Integer;
|
|
begin
|
|
for I := Length(FList) - 1 downto 0 do
|
|
FreeAndNil(FList[I]);
|
|
FList := nil;
|
|
end;
|
|
|
|
function TJSONArray.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtArray;
|
|
end;
|
|
|
|
function TJSONArray.GetValueArray: TJSONArray;
|
|
begin
|
|
Result := self;
|
|
end;
|
|
|
|
function TJSONArray.GetValueIsArray: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TJSONArray.GetCount: Integer;
|
|
begin
|
|
Result := Length(FList);
|
|
end;
|
|
|
|
function TJSONArray.GetItem(const Idx: Integer): TJSONValue;
|
|
begin
|
|
Assert(Idx >= 0);
|
|
Assert(Idx < Length(FList));
|
|
|
|
Result := FList[Idx];
|
|
end;
|
|
|
|
function TJSONArray.ItemIsNull(const Idx: Integer): Boolean;
|
|
begin
|
|
Result := GetItem(Idx).ValueIsNull;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsStr(const Idx: Integer): UnicodeString;
|
|
begin
|
|
Result := GetItem(Idx).GetValueStr;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsStrUTF8(const Idx: Integer): RawByteString;
|
|
begin
|
|
Result := GetItem(Idx).GetValueStrUTF8;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsInt(const Idx: Integer): Int64;
|
|
begin
|
|
Result := GetItem(Idx).GetValueInt;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsFloat(const Idx: Integer): JSONFloat;
|
|
begin
|
|
Result := GetItem(Idx).GetValueFloat;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsBoolean(const Idx: Integer): Boolean;
|
|
begin
|
|
Result := GetItem(Idx).GetValueBoolean;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsArray(const Idx: Integer): TJSONArray;
|
|
begin
|
|
Result := GetItem(Idx).GetValueArray;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsObject(const Idx: Integer): TJSONObject;
|
|
begin
|
|
Result := GetItem(Idx).GetValueObject;
|
|
end;
|
|
|
|
function TJSONArray.GetItemAsVariant(const Idx: Integer): Variant;
|
|
begin
|
|
Result := GetItem(Idx).GetValueVariant;
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsStr(const Idx: Integer; const Value: UnicodeString);
|
|
begin
|
|
GetItem(Idx).SetValueStr(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsStrUTF8(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
GetItem(Idx).SetValueStrUTF8(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsInt(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
GetItem(Idx).SetValueInt(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsFloat(const Idx: Integer; const Value: JSONFloat);
|
|
begin
|
|
GetItem(Idx).SetValueFloat(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsBoolean(const Idx: Integer; const Value: Boolean);
|
|
begin
|
|
GetItem(Idx).SetValueBoolean(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.SetItemAsVariant(const Idx: Integer; const Value: Variant);
|
|
begin
|
|
GetItem(Idx).SetValueVariant(Value);
|
|
end;
|
|
|
|
procedure TJSONArray.Append(const A: TJSONValue);
|
|
var L : Integer;
|
|
begin
|
|
Assert(Assigned(A));
|
|
|
|
L := Length(FList);
|
|
SetLength(FList, L + 1);
|
|
FList[L] := A;
|
|
end;
|
|
|
|
procedure TJSONArray.AppendStr(const A: UnicodeString);
|
|
begin
|
|
Append(TJSONString.Create(A));
|
|
end;
|
|
|
|
procedure TJSONArray.AppendStrUTF8(const A: RawByteString);
|
|
begin
|
|
Append(TJSONString.CreateUTF8(A));
|
|
end;
|
|
|
|
procedure TJSONArray.AppendInt(const A: Int64);
|
|
begin
|
|
Append(TJSONInteger.Create(A));
|
|
end;
|
|
|
|
procedure TJSONArray.AppendFloat(const A: JSONFloat);
|
|
begin
|
|
Append(TJSONFloat.Create(A));
|
|
end;
|
|
|
|
procedure TJSONArray.AppendBoolean(const A: Boolean);
|
|
begin
|
|
Append(TJSONBoolean.Create(A));
|
|
end;
|
|
|
|
procedure TJSONArray.AppendNull;
|
|
begin
|
|
Append(TJSONNull.Create);
|
|
end;
|
|
|
|
procedure TJSONArray.AppendVariant(const A : Variant);
|
|
begin
|
|
case VarType(A) of
|
|
varByte,
|
|
varWord,
|
|
varLongWord,
|
|
varSmallint,
|
|
varShortInt,
|
|
varInteger,
|
|
varInt64 : AppendInt(A);
|
|
varSingle,
|
|
varDouble,
|
|
varCurrency : AppendFloat(A);
|
|
varString : AppendStr(A);
|
|
varBoolean : AppendBoolean(A);
|
|
varNull : AppendNull;
|
|
else
|
|
raise EJSONValue.Create('Variant type not supported');
|
|
end;
|
|
end;
|
|
|
|
procedure TJSONArray.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
var I, L, N : Integer;
|
|
F : Boolean;
|
|
begin
|
|
F := jboIndent in AOptions;
|
|
A.AppendCh(WideChar('['));
|
|
L := ALevel + 1;
|
|
N := Length(FList);
|
|
for I := 0 to N - 1 do
|
|
begin
|
|
if I > 0 then
|
|
A.AppendCh(WideChar(','));
|
|
if F then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, L);
|
|
end;
|
|
FList[I].BuildJSONString(A, AOptions, L);
|
|
end;
|
|
if F and (N > 0) then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, ALevel);
|
|
end;
|
|
A.AppendCh(WideChar(']'));
|
|
if F and (N > 0) then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, ALevel);
|
|
end;
|
|
end;
|
|
|
|
function TJSONArray.Compare(const A: TJSONValue): Integer;
|
|
var B : TJSONArray;
|
|
L, N, I, C : Integer;
|
|
begin
|
|
if A is TJSONArray then
|
|
begin
|
|
B := TJSONArray(A);
|
|
L := GetCount;
|
|
N := B.GetCount;
|
|
if L < N then
|
|
Result := -1 else
|
|
if L > N then
|
|
Result := 1
|
|
else
|
|
begin
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
C := GetItem(I).Compare(B.GetItem(I));
|
|
if C <> 0 then
|
|
begin
|
|
Result := C;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
end
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
procedure TJSONArray.Validate(const Schema: TJSONObject);
|
|
var A, C : TJSONValue;
|
|
B : TJSONArray;
|
|
I, L, N : Integer;
|
|
begin
|
|
inherited Validate(Schema);
|
|
A := Schema[SSchemaField_MinItems];
|
|
if Assigned(A) then
|
|
if not A.ValueIsInt then
|
|
raise EJSONValue.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "minItems" field'])
|
|
else
|
|
if GetCount < A.ValueInt then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidItemCount]);
|
|
A := Schema[SSchemaField_MaxItems];
|
|
if Assigned(A) then
|
|
if not A.ValueIsInt then
|
|
raise EJSONValue.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "maxItems" field'])
|
|
else
|
|
if GetCount > A.ValueInt then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, [SErr_InvalidItemCount]);
|
|
A := Schema[SSchemaField_Items];
|
|
if Assigned(A) then
|
|
if A is TJSONArray then
|
|
begin
|
|
B := TJSONArray(A);
|
|
L := Length(FList);
|
|
N := Length(B.FList);
|
|
for I := 0 to Min(L, N) - 1 do
|
|
begin
|
|
C := B.FList[I];
|
|
if not (C is TJSONObject) then
|
|
raise EJSONSchema.CreateFmt(SErr_InvalidSchema, ['Invalid value type for item in "Items" field: Expected schema object'])
|
|
else
|
|
try
|
|
FList[I].Validate(TJSONObject(C));
|
|
except
|
|
on E : Exception do
|
|
raise EJSONSchema.Create(E.Message + ': Item [' + IntToStr(I) + ']');
|
|
end;
|
|
end;
|
|
end else
|
|
if A is TJSONObject then
|
|
begin
|
|
for I := 0 to Length(FList) - 1 do
|
|
try
|
|
FList[I].Validate(TJSONObject(A));
|
|
except
|
|
on E : Exception do
|
|
raise EJSONSchema.Create(E.Message + ': Item [' + IntToStr(I) + ']');
|
|
end;
|
|
end
|
|
else
|
|
raise EJSONSchema.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "items" field']);
|
|
end;
|
|
|
|
function TJSONArray.GetAsStrArray: UnicodeStringArray;
|
|
var L, I : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
SetLength(Result, L);
|
|
for I := 0 to L - 1 do
|
|
Result[I] := GetItemAsStr(I);
|
|
end;
|
|
|
|
function TJSONArray.GetAsStrArrayUTF8: RawByteStringArray;
|
|
var L, I : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
SetLength(Result, L);
|
|
for I := 0 to L - 1 do
|
|
Result[I] := GetItemAsStrUTF8(I);
|
|
end;
|
|
|
|
function TJSONArray.GetAsIntArray: Int64Array;
|
|
var L, I : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
SetLength(Result, L);
|
|
for I := 0 to L - 1 do
|
|
Result[I] := GetItemAsInt(I);
|
|
end;
|
|
|
|
function TJSONArray.GetAsFloatArray: JSONFloatArray;
|
|
var L, I : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
SetLength(Result, L);
|
|
for I := 0 to L - 1 do
|
|
Result[I] := GetItemAsFloat(I);
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONObject helpers }
|
|
|
|
procedure ClearJSONObjectItem(var Item: TJSONObjectItem);
|
|
begin
|
|
Item.Name := '';
|
|
Item.Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONObject }
|
|
|
|
constructor TJSONObject.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TJSONObject.Destroy;
|
|
var I : Integer;
|
|
begin
|
|
for I := 0 to Length(FList) - 1 do
|
|
FreeAndNil(FList[I].Value);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJSONObject.Clone: TJSONValue;
|
|
var A : TJSONObject;
|
|
I : Integer;
|
|
E : PJSONObjectItem;
|
|
begin
|
|
A := TJSONObject.Create;
|
|
try
|
|
for I := 0 to Length(FList) - 1 do
|
|
begin
|
|
E := @FList[I];
|
|
A.Add(E^.Name, E^.Value.Clone);
|
|
end;
|
|
except
|
|
A.Free;
|
|
raise;
|
|
end;
|
|
Result := A;
|
|
end;
|
|
|
|
procedure TJSONObject.Clear;
|
|
var I : Integer;
|
|
begin
|
|
for I := 0 to Length(FList) - 1 do
|
|
FreeAndNil(FList[I].Value);
|
|
FList := nil;
|
|
end;
|
|
|
|
function TJSONObject.GetValueType: TJSONValueType;
|
|
begin
|
|
Result := jvtObject;
|
|
end;
|
|
|
|
function TJSONObject.GetValueObject: TJSONObject;
|
|
begin
|
|
Result := self;
|
|
end;
|
|
|
|
function TJSONObject.GetValueIsObject: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TJSONObject.GetCount: Integer;
|
|
begin
|
|
Result := Length(FList);
|
|
end;
|
|
|
|
function TJSONObject.GetItemIndexByName(const Name: UnicodeString; out Item: PJSONObjectItem): Integer;
|
|
var I : Integer;
|
|
E : PJSONObjectItem;
|
|
begin
|
|
for I := 0 to Length(FList) - 1 do
|
|
begin
|
|
E := @FList[I];
|
|
if E^.Name = Name then
|
|
begin
|
|
Item := E;
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
Item := nil;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJSONObject.GetItemByName(const Name: UnicodeString): PJSONObjectItem;
|
|
begin
|
|
GetItemIndexByName(Name, Result);
|
|
end;
|
|
|
|
function TJSONObject.GetItemValueByName(const Name: UnicodeString): TJSONValue;
|
|
var I : PJSONObjectItem;
|
|
begin
|
|
I := GetItemByName(Name);
|
|
if not Assigned(I) then
|
|
Result := nil
|
|
else
|
|
Result := I^.Value;
|
|
end;
|
|
|
|
procedure TJSONObject.Add(const Name: UnicodeString; const Value: TJSONValue);
|
|
var L : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
SetLength(FList, L + 1);
|
|
FList[L].Name := Name;
|
|
FList[L].Value := Value;
|
|
end;
|
|
|
|
function TJSONObject.Exists(const Name: UnicodeString): Boolean;
|
|
begin
|
|
Result := Assigned(GetItemByName(Name));
|
|
end;
|
|
|
|
function TJSONObject.Exists(const Name: UnicodeString; out Value: TJSONValue): Boolean;
|
|
begin
|
|
Value := GetItemValueByName(Name);
|
|
Result := Assigned(Value);
|
|
end;
|
|
|
|
function TJSONObject.ItemIsNull(const Name: UnicodeString): Boolean;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := False
|
|
else
|
|
Result := I.ValueIsNull;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsStr(const Name: UnicodeString; const Default: UnicodeString): UnicodeString;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Default
|
|
else
|
|
if I.ValueIsNull then
|
|
Result := Default
|
|
else
|
|
try
|
|
Result := I.ValueStr;
|
|
except
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsStrUTF8(const Name: UnicodeString; const Default: RawByteString): RawByteString;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Default
|
|
else
|
|
if I.ValueIsNull then
|
|
Result := Default
|
|
else
|
|
try
|
|
Result := I.ValueStrUTF8;
|
|
except
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsInt(const Name: UnicodeString; const Default: Int64): Int64;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Default
|
|
else
|
|
if I.ValueIsNull then
|
|
Result := Default
|
|
else
|
|
try
|
|
Result := I.ValueInt;
|
|
except
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsFloat(const Name: UnicodeString; const Default: JSONFloat): JSONFloat;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Default
|
|
else
|
|
if I.ValueIsNull then
|
|
Result := Default
|
|
else
|
|
try
|
|
Result := I.ValueFloat;
|
|
except
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsBoolean(const Name: UnicodeString; const Default: Boolean): Boolean;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Default
|
|
else
|
|
if I.ValueIsNull then
|
|
Result := Default
|
|
else
|
|
try
|
|
Result := I.ValueBoolean;
|
|
except
|
|
Result := Default;
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsArray(const Name: UnicodeString): TJSONArray;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := nil
|
|
else
|
|
if not (I is TJSONArray) then
|
|
Result := nil
|
|
else
|
|
Result := TJSONArray(I);
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsObject(const Name: UnicodeString): TJSONObject;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := nil
|
|
else
|
|
if not (I is TJSONObject) then
|
|
Result := nil
|
|
else
|
|
Result := TJSONObject(I);
|
|
end;
|
|
|
|
function TJSONObject.GetItemAsVariant(const Name: UnicodeString): Variant;
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Result := Unassigned
|
|
else
|
|
Result := I.ValueVariant;
|
|
end;
|
|
|
|
function TJSONObject.RequireItemAsArray(const Name: UnicodeString): TJSONArray;
|
|
var I : TJSONValue;
|
|
V : TJSONArray;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
begin
|
|
V := TJSONArray.Create;
|
|
Add(Name, V);
|
|
Result := V;
|
|
end
|
|
else
|
|
if not (I is TJSONArray) then
|
|
raise EJSONValue.Create('Not an array value')
|
|
else
|
|
Result := TJSONArray(I);
|
|
end;
|
|
|
|
function TJSONObject.RequireItemAsObject(const Name: UnicodeString): TJSONObject;
|
|
var I : TJSONValue;
|
|
V : TJSONObject;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
begin
|
|
V := TJSONObject.Create;
|
|
Add(Name, V);
|
|
Result := V;
|
|
end
|
|
else
|
|
if not (I is TJSONObject) then
|
|
raise EJSONValue.Create('Not an object value')
|
|
else
|
|
Result := TJSONObject(I);
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsStr(const Name: UnicodeString; const Value: UnicodeString);
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Add(Name, TJSONString.Create(Value))
|
|
else
|
|
I.ValueStr := Value;
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsStrUTF8(const Name: UnicodeString; const Value: RawByteString);
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Add(Name, TJSONString.CreateUTF8(Value))
|
|
else
|
|
I.ValueStrUTF8 := Value;
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsInt(const Name: UnicodeString; const Value: Int64);
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Add(Name, TJSONInteger.Create(Value))
|
|
else
|
|
I.ValueInt := Value;
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsFloat(const Name: UnicodeString; const Value: JSONFloat);
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Add(Name, TJSONFloat.Create(Value))
|
|
else
|
|
I.ValueFloat := Value;
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsBoolean(const Name: UnicodeString; const Value: Boolean);
|
|
var I : TJSONValue;
|
|
begin
|
|
I := GetItemValueByName(Name);
|
|
if not Assigned(I) then
|
|
Add(Name, TJSONBoolean.Create(Value))
|
|
else
|
|
I.ValueBoolean := Value;
|
|
end;
|
|
|
|
procedure TJSONObject.SetItemAsVariant(const Name: UnicodeString; const Value: Variant);
|
|
begin
|
|
case VarType(Value) of
|
|
varByte,
|
|
varWord,
|
|
varLongWord,
|
|
varSmallint,
|
|
varShortInt,
|
|
varInteger,
|
|
varInt64 : SetItemAsInt(Name, Value);
|
|
varSingle,
|
|
varDouble,
|
|
varCurrency : SetItemAsFloat(Name, Value);
|
|
varString : SetItemAsStr(Name, Value);
|
|
varBoolean : SetItemAsBoolean(Name, Value);
|
|
else
|
|
raise EJSONValue.Create('Variant type not supported');
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.Iterate(var Iterator: TJSONObjectIterator): Boolean;
|
|
var L : Integer;
|
|
begin
|
|
L := Length(FList);
|
|
Iterator.InternalIndex := 0;
|
|
Result := L > 0;
|
|
if Result then
|
|
Iterator.Item := FList[0]
|
|
else
|
|
ClearJSONObjectItem(Iterator.Item);
|
|
end;
|
|
|
|
function TJSONObject.IterateNext(var Iterator: TJSONObjectIterator): Boolean;
|
|
var I, L : Integer;
|
|
R : Boolean;
|
|
begin
|
|
L := Length(FList);
|
|
I := Iterator.InternalIndex;
|
|
if I < 0 then
|
|
raise EJSONValue.Create('Iterator closed');
|
|
Inc(I);
|
|
Iterator.InternalIndex := I;
|
|
R := I < L;
|
|
if R then
|
|
Iterator.Item := FList[I]
|
|
else
|
|
ClearJSONObjectItem(Iterator.Item);
|
|
Result := R;
|
|
end;
|
|
|
|
procedure TJSONObject.IterateClose(var Iterator: TJSONObjectIterator);
|
|
begin
|
|
Iterator.InternalIndex := -1;
|
|
ClearJSONObjectItem(Iterator.Item);
|
|
end;
|
|
|
|
procedure TJSONObject.BuildJSONString(const A: TUnicodeStringBuilder; const AOptions: TJSONStringOptions; const ALevel: Integer);
|
|
var I, L, N : Integer;
|
|
F : Boolean;
|
|
P : PJSONObjectItem;
|
|
begin
|
|
F := jboIndent in AOptions;
|
|
A.AppendCh(WideChar('{'));
|
|
L := ALevel + 1;
|
|
N := Length(FList);
|
|
for I := 0 to N - 1 do
|
|
begin
|
|
if I > 0 then
|
|
A.AppendCh(WideChar(','));
|
|
if F then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, L);
|
|
end;
|
|
P := @FList[I];
|
|
A.AppendCh(WideChar('"'));
|
|
A.Append(EscapedJSONStringValue(P^.Name));
|
|
A.AppendCh(WideChar('"'));
|
|
if F then
|
|
A.AppendCh(WideSP);
|
|
A.AppendCh(WideChar(':'));
|
|
if F then
|
|
A.AppendCh(WideSP);
|
|
P^.Value.BuildJSONString(A, AOptions, L);
|
|
end;
|
|
if F and (N > 0) then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, ALevel);
|
|
end;
|
|
A.AppendCh(WideChar('}'));
|
|
if F and (N > 0) then
|
|
begin
|
|
A.Append(WideCRLF);
|
|
A.Append(SJSONIndent, ALevel);
|
|
end;
|
|
end;
|
|
|
|
function TJSONObject.Compare(const A: TJSONValue): Integer;
|
|
var B : TJSONObject;
|
|
L, N, I, C : Integer;
|
|
P, Q : PJSONObjectItem;
|
|
begin
|
|
if A is TJSONObject then
|
|
begin
|
|
B := TJSONObject(A);
|
|
L := GetCount;
|
|
N := B.GetCount;
|
|
if L < N then
|
|
Result := -1 else
|
|
if L > N then
|
|
Result := 1
|
|
else
|
|
begin
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
P := @FList[I];
|
|
Q := B.GetItemByName(P^.Name);
|
|
if not Assigned(Q) then
|
|
C := -1
|
|
else
|
|
C := P^.Value.Compare(Q^.Value);
|
|
if C <> 0 then
|
|
begin
|
|
Result := C;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := 0;
|
|
end;
|
|
end
|
|
else
|
|
Result := inherited Compare(A);
|
|
end;
|
|
|
|
procedure TJSONObject.Validate(const Schema: TJSONObject);
|
|
var A : TJSONValue;
|
|
P : TJSONObject;
|
|
I : TJSONObjectIterator;
|
|
V : TJSONValue;
|
|
C : TJSONObject;
|
|
B : TJSONValue;
|
|
N : UnicodeString;
|
|
begin
|
|
inherited Validate(Schema);
|
|
A := Schema[SSchemaField_Properties];
|
|
if Assigned(A) then
|
|
begin
|
|
if not A.ValueIsObject then
|
|
raise EJSONValue.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "properties" field']);
|
|
P := A as TJSONObject;
|
|
if P.Iterate(I) then
|
|
try
|
|
repeat
|
|
C := I.Item.Value as TJSONObject;
|
|
N := I.Item.Name;
|
|
V := GetItemValueByName(N);
|
|
if not Assigned(V) then
|
|
begin
|
|
B := C[SSchemaField_Required];
|
|
if Assigned(B) then
|
|
if B.ValueBoolean then
|
|
raise EJSONSchema.CreateFmt(SErr_ValidationFailed, ['Required field missing: Field "' + N + '"']);
|
|
end
|
|
else
|
|
try
|
|
V.Validate(C);
|
|
except
|
|
on E: Exception do
|
|
raise EJSONSchema.Create(E.Message + ': Field "' + N + '"');
|
|
end;
|
|
until not P.IterateNext(I);
|
|
finally
|
|
P.IterateClose(I);
|
|
end;
|
|
end;
|
|
A := Schema[SSchemaField_Items];
|
|
if Assigned(A) then
|
|
if A is TJSONObject then
|
|
begin
|
|
if Iterate(I) then
|
|
try
|
|
repeat
|
|
V := I.Item.Value;
|
|
try
|
|
V.Validate(TJSONObject(A));
|
|
except
|
|
on E: Exception do
|
|
raise EJSONSchema.Create(E.Message + ': Field "' + I.Item.Name + '"');
|
|
end;
|
|
until not IterateNext(I);
|
|
finally
|
|
IterateClose(I);
|
|
end;
|
|
end
|
|
else
|
|
raise EJSONSchema.CreateFmt(SErr_InvalidSchema, ['Invalid value type for "items" field']);
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONParser helpers }
|
|
|
|
function IsJSONWhiteSpaceChar(const C: WideChar): Boolean;
|
|
begin
|
|
case C of
|
|
WideHT,
|
|
WideLF,
|
|
WideCR,
|
|
WideSP : Result := True;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function IsJSONReservedChar(const C: WideChar): Boolean;
|
|
begin
|
|
case C of
|
|
'a'..'z' : Result := True;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function IsJSONUnsignedIntegerChar(const C: WideChar): Boolean;
|
|
begin
|
|
case C of
|
|
'0'..'9' : Result := True;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TJSONParser }
|
|
|
|
const
|
|
SErr_UnexpectedEndOfText = 'Unexpected end of text';
|
|
SErr_NumberExpected = 'Number expected';
|
|
SErr_StringExpected = 'String expected';
|
|
SErr_InvalidString = 'Invalid string';
|
|
SErr_UnknownIdentifier = 'Unknown identifier';
|
|
SErr_IntegerOverflow = 'Integer overflow';
|
|
SErr_UnexpectedCharacter = 'Unexpected character';
|
|
SErr_ValueExpected = 'Value expected';
|
|
SErr_UnexpectedToken = 'Unexpected token';
|
|
SErr_JSONParseError = 'JSON parse error: %s';
|
|
|
|
constructor TJSONParser.Create;
|
|
begin
|
|
inherited Create;
|
|
FToken := jptNone;
|
|
FTokenStrBuilder := TUnicodeStringBuilder.Create;
|
|
end;
|
|
|
|
destructor TJSONParser.Destroy;
|
|
begin
|
|
FreeAndNil(FTokenStrBuilder);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJSONParser.GetNextChar: WideChar;
|
|
var I : Integer;
|
|
C : WideChar;
|
|
begin
|
|
I := FTextPos;
|
|
if I > FTextLength then
|
|
begin
|
|
FTextEOF := True;
|
|
FTextChar := #0;
|
|
Result := #0;
|
|
end
|
|
else
|
|
begin
|
|
C := FText[I];
|
|
Inc(I);
|
|
FTextPos := I;
|
|
FTextChar := C;
|
|
Result := C;
|
|
Inc(FTokenLen);
|
|
end;
|
|
end;
|
|
|
|
function TJSONParser.ExpectNextChar: WideChar;
|
|
begin
|
|
Result := GetNextChar;
|
|
if FTextEOF then
|
|
raise EJSONParser.Create(SErr_UnexpectedEndOfText);
|
|
end;
|
|
|
|
function TJSONParser.GetTokenTextPtr: PWideChar;
|
|
begin
|
|
Assert(FTextPos - FTokenLen - 1 >= 1);
|
|
Result := @FText[FTextPos - FTokenLen - 1];
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_UnsignedInteger(const Ch: WideChar): Int64;
|
|
const M1 = High(Int64) div 10;
|
|
M2 = High(Int64) mod 10;
|
|
var C : WideChar;
|
|
N : Int64;
|
|
I : Byte;
|
|
R : Boolean;
|
|
begin
|
|
Assert(IsJSONUnsignedIntegerChar(Ch));
|
|
C := Ch;
|
|
N := 0;
|
|
R := False;
|
|
repeat
|
|
if N >= M1 then
|
|
begin
|
|
if N > M1 then
|
|
raise EJSONParser.Create(SErr_IntegerOverflow);
|
|
R := True;
|
|
end;
|
|
N := N * 10;
|
|
I := Ord(C) - Ord('0');
|
|
if R then
|
|
if I > M2 then
|
|
raise EJSONParser.Create(SErr_IntegerOverflow);
|
|
Inc(N, I);
|
|
C := GetNextChar;
|
|
if FTextEOF then
|
|
break;
|
|
until not IsJSONUnsignedIntegerChar(C);
|
|
Result := N;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_ExpectUnsignedInteger(const Ch: WideChar): Int64;
|
|
begin
|
|
if not IsJSONUnsignedIntegerChar(Ch) then
|
|
raise EJSONParser.Create(SErr_NumberExpected);
|
|
Result := ParseToken_UnsignedInteger(Ch);
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_SignedInteger(const Ch: WideChar): Int64;
|
|
var C : WideChar;
|
|
N : Boolean;
|
|
begin
|
|
C := Ch;
|
|
case C of
|
|
'+', '-' :
|
|
begin
|
|
N := C = '-';
|
|
C := ExpectNextChar;
|
|
Result := ParseToken_ExpectUnsignedInteger(C);
|
|
if N then
|
|
Result := -Result;
|
|
end;
|
|
else
|
|
Result := ParseToken_UnsignedInteger(C);
|
|
end;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_ExpectSignedInteger(const Ch: WideChar): Int64;
|
|
begin
|
|
case Ch of
|
|
'+', '-', '0'..'9' : Result := ParseToken_SignedInteger(Ch);
|
|
else
|
|
raise EJSONParser.Create(SErr_NumberExpected);
|
|
end;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_Float(const Ch: WideChar): JSONFloat;
|
|
var C : WideChar;
|
|
F, E : JSONFloat;
|
|
N : Integer;
|
|
begin
|
|
C := Ch;
|
|
Assert(C = '.');
|
|
F := 0.0;
|
|
E := 0.1;
|
|
C := ExpectNextChar;
|
|
if not IsJSONUnsignedIntegerChar(C) then
|
|
raise EJSONParser.Create(SErr_NumberExpected);
|
|
repeat
|
|
N := Ord(C) - Ord('0');
|
|
F := F + (E * N);
|
|
C := GetNextChar;
|
|
if FTextEOF then
|
|
break;
|
|
E := E / 10;
|
|
until not IsJSONUnsignedIntegerChar(C);
|
|
Result := F;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_Number(const Ch: WideChar): TJSONParserToken;
|
|
var C : WideChar;
|
|
T : TJSONParserToken;
|
|
N, E : Int64;
|
|
F, G : JSONFloat;
|
|
begin
|
|
C := Ch;
|
|
T := jptInteger;
|
|
case C of
|
|
'-' : N := ParseToken_SignedInteger(C);
|
|
'0'..'9' : N := ParseToken_UnsignedInteger(C);
|
|
else
|
|
T := jptNone;
|
|
N := 0;
|
|
end;
|
|
C := FTextChar;
|
|
if C = '.' then
|
|
begin
|
|
if T = jptInteger then
|
|
F := N
|
|
else
|
|
F := 0;
|
|
G := ParseToken_Float(C);
|
|
if F < 0 then
|
|
F := F - G
|
|
else
|
|
F := F + G;
|
|
T := jptFloat;
|
|
end
|
|
else
|
|
F := 0.0;
|
|
if T = jptNone then
|
|
raise EJSONParser.Create(SErr_NumberExpected);
|
|
C := FTextChar;
|
|
if (C = 'E') or (C = 'e') then
|
|
begin
|
|
C := ExpectNextChar;
|
|
E := ParseToken_ExpectSignedInteger(C);
|
|
if T = jptInteger then
|
|
F := N;
|
|
F := F * Power(10, E);
|
|
T := jptSciFloat;
|
|
end;
|
|
case T of
|
|
jptInteger : FTokenInteger := N;
|
|
jptFloat,
|
|
jptSciFloat : FTokenFloat := F;
|
|
end;
|
|
Result := T;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_String_Escaped_Hex4(const Ch: WideChar): WideChar;
|
|
var I : Integer;
|
|
C, T : WideChar;
|
|
D : Byte;
|
|
begin
|
|
C := Ch;
|
|
Assert(C = 'u');
|
|
T := #0;
|
|
for I := 1 to 4 do
|
|
begin
|
|
C := ExpectNextChar;
|
|
case C of
|
|
'0'..'9' : D := Ord(C) - Ord('0');
|
|
'A'..'F' : D := Ord(C) - Ord('A') + 10;
|
|
'a'..'f' : D := Ord(C) - Ord('a') + 10;
|
|
else
|
|
raise EJSONParser.Create(SErr_InvalidString);
|
|
end;
|
|
T := WideChar(Ord(T) * 16 + D);
|
|
end;
|
|
GetNextChar;
|
|
Result := T;
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_String_Escaped(const Ch: WideChar): WideChar;
|
|
var C, D : WideChar;
|
|
begin
|
|
C := Ch;
|
|
Assert(C = '\');
|
|
C := ExpectNextChar;
|
|
case C of
|
|
'"',
|
|
'\',
|
|
'/' : D := C;
|
|
'b' : D := #$8;
|
|
'f' : D := #$C;
|
|
'n' : D := #$A;
|
|
'r' : D := #$D;
|
|
't' : D := #$9;
|
|
else
|
|
D := #0;
|
|
end;
|
|
if D <> #0 then
|
|
begin
|
|
Result := D;
|
|
GetNextChar;
|
|
exit;
|
|
end;
|
|
if C = 'u' then
|
|
begin
|
|
Result := ParseToken_String_Escaped_Hex4(C);
|
|
exit;
|
|
end;
|
|
// unknown escape code
|
|
raise EJSONParser.Create(SErr_InvalidString);
|
|
end;
|
|
|
|
function TJSONParser.ParseToken_String(const Ch: WideChar): TJSONParserToken;
|
|
var C : WideChar;
|
|
R : Boolean;
|
|
D : WideChar;
|
|
begin
|
|
C := Ch;
|
|
Assert(C = '"');
|
|
FTokenStrBuilder.Clear;
|
|
R := False;
|
|
C := ExpectNextChar;
|
|
repeat
|
|
case C of
|
|
'"' :
|
|
begin
|
|
GetNextChar;
|
|
R := True;
|
|
end;
|
|
'\' :
|
|
begin
|
|
D := ParseToken_String_Escaped(C);
|
|
FTokenStrBuilder.AppendCh(D);
|
|
if FTextEOF then
|
|
raise EJSONParser.Create(SErr_InvalidString);
|
|
C := FTextChar;
|
|
end;
|
|
else
|
|
begin
|
|
FTokenStrBuilder.AppendCh(C);
|
|
C := ExpectNextChar;
|
|
end;
|
|
end;
|
|
until R;
|
|
FTokenStr := FTokenStrBuilder.AsUnicodeString;
|
|
Result := jptString;
|
|
end;
|
|
|
|
function TJSONParser.GetAnyNextToken: TJSONParserToken;
|
|
var C : WideChar;
|
|
T : TJSONParserToken;
|
|
P : PWideChar;
|
|
L : Integer;
|
|
begin
|
|
FTokenPos := FTextPos;
|
|
FTokenLen := 0;
|
|
if FTextEOF then
|
|
begin
|
|
Result := jptEOF;
|
|
exit;
|
|
end;
|
|
C := FTextChar;
|
|
if IsJSONWhiteSpaceChar(C) then
|
|
begin
|
|
repeat
|
|
C := GetNextChar;
|
|
if FTextEOF then
|
|
break;
|
|
if C = WideLF then
|
|
begin
|
|
Inc(FTextRow);
|
|
FTextRowPos := FTextPos;
|
|
end;
|
|
until not IsJSONWhiteSpaceChar(C);
|
|
Result := jptWhiteSpace;
|
|
exit;
|
|
end;
|
|
if IsJSONReservedChar(C) then
|
|
begin
|
|
repeat
|
|
C := GetNextChar;
|
|
if FTextEOF then
|
|
break;
|
|
until not IsJSONReservedChar(C);
|
|
P := GetTokenTextPtr;
|
|
L := FTokenLen;
|
|
if (L = 4) and StrPMatchStrU(P, L, 'true') then
|
|
T := jptTrue else
|
|
if (L = 5) and StrPMatchStrU(P, L, 'false') then
|
|
T := jptFalse else
|
|
if (L = 4) and StrPMatchStrU(P, L, 'null') then
|
|
T := jptNull
|
|
else
|
|
raise EJSONParser.Create(SErr_UnknownIdentifier);
|
|
Result := T;
|
|
exit;
|
|
end;
|
|
case C of
|
|
'{' : T := jptLeftCurly;
|
|
'}' : T := jptRightCurly;
|
|
'[' : T := jptLeftSquare;
|
|
']' : T := jptRightSquare;
|
|
':' : T := jptColon;
|
|
',' : T := jptComma;
|
|
else
|
|
T := jptNone;
|
|
end;
|
|
if T <> jptNone then
|
|
begin
|
|
GetNextChar;
|
|
Result := T;
|
|
exit;
|
|
end;
|
|
case C of
|
|
'-',
|
|
'0'..'9',
|
|
'.' : T := ParseToken_Number(C);
|
|
'"' : T := ParseToken_String(C);
|
|
else
|
|
raise EJSONParser.Create(SErr_UnexpectedCharacter);
|
|
end;
|
|
Result := T;
|
|
end;
|
|
|
|
function TJSONParser.GetNextToken: TJSONParserToken;
|
|
var T : TJSONParserToken;
|
|
begin
|
|
repeat
|
|
T := GetAnyNextToken;
|
|
until T <> jptWhiteSpace;
|
|
FToken := T;
|
|
Result := T;
|
|
end;
|
|
|
|
function TJSONParser.RequireNextToken: TJSONParserToken;
|
|
begin
|
|
Result := GetNextToken;
|
|
if Result = jptEOF then
|
|
raise EJSONParser.Create(SErr_UnexpectedEndOfText);
|
|
end;
|
|
|
|
{ = false / null / true }
|
|
function TJSONParser.ParseNamedLiteral(const AToken: TJSONParserToken): TJSONValue;
|
|
begin
|
|
Assert(AToken in [jptTrue, jptFalse, jptNull]);
|
|
case AToken of
|
|
jptTrue,
|
|
jptFalse : Result := TJSONBoolean.Create(AToken = jptTrue);
|
|
jptNull : Result := TJSONNull.Create;
|
|
else
|
|
Result := nil;
|
|
end;
|
|
if not Assigned(Result) then
|
|
exit;
|
|
GetNextToken;
|
|
end;
|
|
|
|
{ number = [ minus ] int [ frac ] [ exp ] }
|
|
function TJSONParser.ParseNumber(const AToken: TJSONParserToken): TJSONValue;
|
|
begin
|
|
Assert(AToken in [jptInteger, jptFloat, jptSciFloat]);
|
|
case AToken of
|
|
jptInteger : Result := TJSONInteger.Create(FTokenInteger);
|
|
jptFloat,
|
|
jptSciFloat : Result := TJSONFloat.Create(FTokenFloat);
|
|
else
|
|
Result := nil;
|
|
end;
|
|
if not Assigned(Result) then
|
|
exit;
|
|
GetNextToken;
|
|
end;
|
|
|
|
{ string = quotation-mark *char quotation-mark }
|
|
function TJSONParser.ParseString: TJSONValue;
|
|
begin
|
|
Assert(FToken = jptString);
|
|
case FToken of
|
|
jptString : Result := TJSONString.Create(FTokenStr);
|
|
else
|
|
Result := nil;
|
|
end;
|
|
if not Assigned(Result) then
|
|
exit;
|
|
GetNextToken;
|
|
end;
|
|
|
|
function TJSONParser.ParseRequiredStringValue: UnicodeString;
|
|
begin
|
|
if FToken <> jptString then
|
|
raise EJSONParser.Create(SErr_StringExpected);
|
|
Result := FTokenStr;
|
|
GetNextToken;
|
|
end;
|
|
|
|
{ array = begin-array [ value *( value-separator value ) ] end-array }
|
|
function TJSONParser.ParseArray: TJSONArray;
|
|
var A : TJSONArray;
|
|
T : TJSONParserToken;
|
|
R : Boolean;
|
|
begin
|
|
Assert(FToken = jptLeftSquare);
|
|
A := TJSONArray.Create;
|
|
try
|
|
T := RequireNextToken;
|
|
R := T = jptRightSquare;
|
|
while not R do
|
|
begin
|
|
A.Append(ParseRequiredValue(T));
|
|
case FToken of
|
|
jptRightSquare : R := True;
|
|
jptComma : T := RequireNextToken;
|
|
else
|
|
raise EJSONParser.Create(', or ] expected');
|
|
end;
|
|
end;
|
|
Assert(FToken = jptRightSquare);
|
|
GetNextToken;
|
|
except
|
|
A.Free;
|
|
raise;
|
|
end;
|
|
Result := A;
|
|
end;
|
|
|
|
{ object = begin-object [ member *( value-separator member ) ] end-object }
|
|
{ member = string name-separator value }
|
|
function TJSONParser.ParseObject: TJSONObject;
|
|
var A : TJSONObject;
|
|
T : TJSONParserToken;
|
|
R : Boolean;
|
|
N : UnicodeString;
|
|
V : TJSONValue;
|
|
begin
|
|
Assert(FToken = jptLeftCurly);
|
|
A := TJSONObject.Create;
|
|
try
|
|
T := RequireNextToken;
|
|
R := T = jptRightCurly;
|
|
while not R do
|
|
begin
|
|
N := ParseRequiredStringValue;
|
|
if FToken <> jptColon then
|
|
raise EJSONParser.Create(': expected');
|
|
T := RequireNextToken;
|
|
V := ParseRequiredValue(T);
|
|
A.Add(N, V);
|
|
case FToken of
|
|
jptRightCurly : R := True;
|
|
jptComma : RequireNextToken;
|
|
else
|
|
raise EJSONParser.Create(', or } expected');
|
|
end;
|
|
end;
|
|
Assert(FToken = jptRightCurly);
|
|
GetNextToken;
|
|
except
|
|
A.Free;
|
|
raise;
|
|
end;
|
|
Result := A;
|
|
end;
|
|
|
|
{ value = false / null / true / object / array / number / string }
|
|
function TJSONParser.ParseValue(const AToken: TJSONParserToken): TJSONValue;
|
|
begin
|
|
case AToken of
|
|
jptFalse,
|
|
jptNull,
|
|
jptTrue : Result := ParseNamedLiteral(AToken);
|
|
jptLeftCurly : Result := ParseObject;
|
|
jptLeftSquare : Result := ParseArray;
|
|
jptInteger,
|
|
jptFloat,
|
|
jptSciFloat : Result := ParseNumber(AToken);
|
|
jptString : Result := ParseString;
|
|
else
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TJSONParser.ParseRequiredValue(const AToken: TJSONParserToken): TJSONValue;
|
|
begin
|
|
Result := ParseValue(AToken);
|
|
if not Assigned(Result) then
|
|
raise EJSONParser.Create(SErr_ValueExpected);
|
|
end;
|
|
|
|
procedure TJSONParser.SetText(const AText: UnicodeString);
|
|
begin
|
|
FText := AText;
|
|
FTextLength := Length(FText);
|
|
end;
|
|
|
|
procedure TJSONParser.InitParser;
|
|
begin
|
|
FTextPos := 1;
|
|
FTextRow := 1;
|
|
FTextRowPos := 1;
|
|
FTextEOF := False;
|
|
GetNextChar;
|
|
FToken := GetNextToken;
|
|
end;
|
|
|
|
{ JSON-text = object / array }
|
|
function TJSONParser.ParseText(const AText: UnicodeString): TJSONValue;
|
|
begin
|
|
SetText(AText);
|
|
InitParser;
|
|
try
|
|
case FToken of
|
|
jptEOF : Result := nil;
|
|
jptLeftSquare : Result := ParseArray;
|
|
jptLeftCurly : Result := ParseObject;
|
|
else
|
|
raise EJSONParser.Create(SErr_UnexpectedToken);
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
raise EJSONParser.CreateFmt(SErr_JSONParseError, [E.Message]);
|
|
end;
|
|
end;
|
|
|
|
function TJSONParser.ParseTextUTF8(const AText: RawByteString): TJSONValue;
|
|
begin
|
|
Result := ParseText(UTF8StringToUnicodeString(AText));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ JSON helpers }
|
|
{ }
|
|
function ParseJSONText(const JSONText: UnicodeString): TJSONValue;
|
|
var P : TJSONParser;
|
|
begin
|
|
P := TJSONParser.Create;
|
|
try
|
|
Result := P.ParseText(JSONText);
|
|
finally
|
|
P.Free;
|
|
end;
|
|
end;
|
|
|
|
function ParseJSONTextUTF8(const JSONText: RawByteString): TJSONValue;
|
|
begin
|
|
Result := ParseJSONText(UTF8StringToUnicodeString(JSONText));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ JSON schema schema }
|
|
{ }
|
|
const
|
|
SSchemaSchema =
|
|
'{' +
|
|
'"$schema" : "http://json-schema.org/draft-03/schema#",' +
|
|
'"id" : "http://json-schema.org/draft-03/schema#",' +
|
|
'"type" : "object",' +
|
|
|
|
'"properties" : {' +
|
|
'"type" : {' +
|
|
'"type" : ["string", "array"],' +
|
|
'"items" : {' +
|
|
'"type" : ["string", {"$ref" : "#"}]' +
|
|
'},' +
|
|
'"uniqueItems" : true,' +
|
|
'"default" : "any"' +
|
|
'},' +
|
|
|
|
'"properties" : {' +
|
|
'"type" : "object",' +
|
|
'"additionalProperties" : {"$ref" : "#"},' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"patternProperties" : {' +
|
|
'"type" : "object",' +
|
|
'"additionalProperties" : {"$ref" : "#"},' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"additionalProperties" : {' +
|
|
'"type" : [{"$ref" : "#"}, "boolean"],' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"items" : {' +
|
|
'"type" : [{"$ref" : "#"}, "array"],' +
|
|
'"items" : {"$ref" : "#"},' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"additionalItems" : {' +
|
|
'"type" : [{"$ref" : "#"}, "boolean"],' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"required" : {' +
|
|
'"type" : "boolean",' +
|
|
'"default" : false ' +
|
|
'},' +
|
|
|
|
'"dependencies" : {' +
|
|
'"type" : "object",' +
|
|
'"additionalProperties" : {' +
|
|
'"type" : ["string", "array", {"$ref" : "#"}],' +
|
|
'"items" : {' +
|
|
'"type" : "string"' +
|
|
'}' +
|
|
'},' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"minimum" : {' +
|
|
'"type" : "number"' +
|
|
'},' +
|
|
|
|
|
|
'"maximum" : {' +
|
|
'"type" : "number"' +
|
|
'},' +
|
|
|
|
'"exclusiveMinimum" : {' +
|
|
'"type" : "boolean",' +
|
|
'"default" : false ' +
|
|
'},' +
|
|
|
|
'"exclusiveMaximum" : {' +
|
|
'"type" : "boolean",' +
|
|
'"default" : false ' +
|
|
'},' +
|
|
|
|
'"minItems" : {' +
|
|
'"type" : "integer",' +
|
|
'"minimum" : 0,' +
|
|
'"default" : 0 ' +
|
|
'},' +
|
|
|
|
'"maxItems" : {' +
|
|
'"type" : "integer",' +
|
|
'"minimum" : 0 ' +
|
|
'},' +
|
|
|
|
'"uniqueItems" : {' +
|
|
'"type" : "boolean",' +
|
|
'"default" : false ' +
|
|
'},' +
|
|
|
|
'"pattern" : {' +
|
|
'"type" : "string",' +
|
|
'"format" : "regex"' +
|
|
'},' +
|
|
|
|
'"minLength" : {' +
|
|
'"type" : "integer",' +
|
|
'"minimum" : 0,' +
|
|
'"default" : 0 ' +
|
|
'},' +
|
|
|
|
'"maxLength" : {' +
|
|
'"type" : "integer"' +
|
|
'},' +
|
|
|
|
'"enum" : {' +
|
|
'"type" : "array",' +
|
|
'"minItems" : 1,' +
|
|
'"uniqueItems" : true ' +
|
|
'},' +
|
|
|
|
'"default" : {' +
|
|
'"type" : "any"' +
|
|
'},' +
|
|
|
|
'"title" : {' +
|
|
'"type" : "string"' +
|
|
'},' +
|
|
|
|
'"description" : {' +
|
|
'"type" : "string"' +
|
|
'},' +
|
|
|
|
'"format" : {' +
|
|
'"type" : "string"' +
|
|
'},' +
|
|
|
|
'"divisibleBy" : {' +
|
|
'"type" : "number",' +
|
|
'"minimum" : 0,' +
|
|
'"exclusiveMinimum" : true,' +
|
|
'"default" : 1 ' +
|
|
'},' +
|
|
|
|
'"disallow" : {' +
|
|
'"type" : ["string", "array"],' +
|
|
'"items" : {' +
|
|
'"type" : ["string", {"$ref" : "#"}] ' +
|
|
'},' +
|
|
'"uniqueItems" : true ' +
|
|
'},' +
|
|
|
|
'"extends" : {' +
|
|
'"type" : [{"$ref" : "#"}, "array"],' +
|
|
'"items" : {"$ref" : "#"},' +
|
|
'"default" : {}' +
|
|
'},' +
|
|
|
|
'"id" : {' +
|
|
'"type" : "string",' +
|
|
'"format" : "uri"' +
|
|
'},' +
|
|
|
|
'"$ref" : {' +
|
|
'"type" : "string",' +
|
|
'"format" : "uri"' +
|
|
'},' +
|
|
|
|
'"$schema" : {' +
|
|
'"type" : "string",' +
|
|
'"format" : "uri"' +
|
|
'}' +
|
|
'},' +
|
|
|
|
'"dependencies" : {' +
|
|
'"exclusiveMinimum" : "minimum",' +
|
|
'"exclusiveMaximum" : "maximum"' +
|
|
'},' +
|
|
|
|
'"default" : {}' +
|
|
'}';
|
|
|
|
var
|
|
SchemaSchemaObj : TJSONObject = nil;
|
|
|
|
function GetSchemaSchemaObj: TJSONObject;
|
|
var P : TJSONParser;
|
|
begin
|
|
if not Assigned(SchemaSchemaObj) then
|
|
begin
|
|
P := TJSONParser.Create;
|
|
try
|
|
SchemaSchemaObj := P.ParseText(SSchemaSchema) as TJSONObject;
|
|
finally
|
|
P.Free;
|
|
end;
|
|
end;
|
|
Result := SchemaSchemaObj;
|
|
end;
|
|
|
|
procedure ValidateSchema(const Schema: TJSONObject);
|
|
begin
|
|
Schema.Validate(GetSchemaSchemaObj);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Self-testing code }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$ASSERTIONS ON}
|
|
procedure Test;
|
|
const
|
|
TestStr1 =
|
|
'{' +
|
|
'"test1":"a\"b\"c",' +
|
|
'"test2":123,' +
|
|
'"test3":true,' +
|
|
'"test4":null,' +
|
|
'"test5":[1,"a",12.345,"",{},[]],' +
|
|
'"test6":1.2345' +
|
|
'}';
|
|
TestStr2 = ' [ ' +
|
|
'1,-1,1.25,-1.25,1.2325e+02,-1.2325e+02 , 1E3 , 1E-3 , ' +
|
|
'9223372036854775807,-9223372036854775807,0' +
|
|
' ] '#13#10;
|
|
SchemaStr1 =
|
|
'{' +
|
|
'"properties":{' +
|
|
'"test0":{' +
|
|
'"type":"string",' +
|
|
'"required":false' +
|
|
'},' +
|
|
'"test1":{' +
|
|
'"type":"string",' +
|
|
'"required":true,' +
|
|
'"minLength":2,' +
|
|
'"maxLength":9' +
|
|
'},' +
|
|
'"test2":{' +
|
|
'"type":"integer",' +
|
|
'"required":true,' +
|
|
'"minimum":123,' +
|
|
'"maximum":123' +
|
|
'},' +
|
|
'"test3":{' +
|
|
'"type":"boolean"' +
|
|
'},' +
|
|
'"test4":{' +
|
|
'"type":"any",' +
|
|
'"required":true' +
|
|
'},' +
|
|
'"test5":{' +
|
|
'"type":"array",' +
|
|
'"required":true,' +
|
|
'"minItems":6,' +
|
|
'"maxItems":6,' +
|
|
'"items":[' +
|
|
'{ "type":"integer" },' +
|
|
'{ "type":"string",' +
|
|
' "enum":["a","b"],' +
|
|
' "maxLength":1 },' +
|
|
'{ "type":"number" },' +
|
|
'{ "type":"string" },' +
|
|
'{ "type":"object" },' +
|
|
'{ "type":"array",' +
|
|
' "minItems":0,' +
|
|
' "maxItems":0 }' +
|
|
']' +
|
|
'},' +
|
|
'"test6":{' +
|
|
'"type":"number",' +
|
|
'"required":true,' +
|
|
'"minimum":1.2,' +
|
|
'"maximum":1.3' +
|
|
'},' +
|
|
'"test7":{' +
|
|
'"type":"any",' +
|
|
'"required":false' +
|
|
'}' +
|
|
'}' +
|
|
'}';
|
|
var X : TJSONObject;
|
|
Y : TJSONArray;
|
|
P : TJSONParser;
|
|
A, B : TJSONValue;
|
|
begin
|
|
Assert(EscapedJSONStringValue('') = '');
|
|
Assert(EscapedJSONStringValue('abc') = 'abc');
|
|
Assert(EscapedJSONStringValue('a"c\/"') = 'a\"c\\\/\"');
|
|
Assert(EscapedJSONStringValue('abc'#13#10) = 'abc\r\n');
|
|
Assert(QuotedJSONStringValue('a"\"c') = '"a\"\\\"c"');
|
|
|
|
// TestStr1 construct
|
|
X := TJSONObject.Create;
|
|
X.Add('test1', TJSONString.Create('a"b"c'));
|
|
X.Add('test2', TJSONInteger.Create(123));
|
|
X.Add('test3', TJSONBoolean.Create(True));
|
|
X.Add('test4', TJSONNull.Create);
|
|
Y := TJSONArray.Create;
|
|
Assert(Y.ValueType = jvtArray);
|
|
Y.Append(TJSONInteger.Create(1));
|
|
Y.Append(TJSONString.Create('a'));
|
|
Y.Append(TJSONFloat.Create(12.345));
|
|
Y.Append(TJSONString.Create(''));
|
|
Y.Append(TJSONObject.Create);
|
|
Y.Append(TJSONArray.Create);
|
|
X.Add('test5', Y);
|
|
X.Add('test6', TJSONFloat.Create(1.2345));
|
|
Assert(X.GetJSONString = TestStr1);
|
|
X.Free;
|
|
|
|
// TestStr1 parse
|
|
P := TJSONParser.Create;
|
|
A := P.ParseText(TestStr1);
|
|
Assert(A.GetJSONString = TestStr1);
|
|
// Writeln(A.GetJSONString([jboIndent]));
|
|
Assert(A is TJSONObject);
|
|
Assert(A.ValueType = jvtObject);
|
|
X := TJSONObject(A);
|
|
Assert(not X.Exists('abc'));
|
|
Assert(X.GetItemAsInt('abc', -1) = -1);
|
|
Assert(X.Exists('test1'));
|
|
Assert(not X.Item['test1'].ValueIsNull);
|
|
Assert(X.Item['test1'].ValueType = jvtString);
|
|
Assert(X.Item['test1'].ValueStr = 'a"b"c');
|
|
Assert(X.GetItemAsStr('test1') = 'a"b"c');
|
|
Assert(X.Item['test2'].ValueType = jvtInteger);
|
|
Assert(X.Item['test2'].ValueInt = 123);
|
|
Assert(X.GetItemAsInt('test2') = 123);
|
|
Assert(X.Item['test3'].ValueType = jvtBoolean);
|
|
Assert(X.Item['test3'].ValueBoolean);
|
|
Assert(X.GetItemAsBoolean('test3'));
|
|
Assert(X.Item['test4'].ValueType = jvtNull);
|
|
Assert(X.Item['test4'].ValueIsNull);
|
|
Assert(X.Item['test5'].ValueType = jvtArray);
|
|
Assert(X.Item['test5'].ValueIsArray);
|
|
B := X.Item['test5'];
|
|
Assert(B is TJSONArray);
|
|
Assert(B.ValueType = jvtArray);
|
|
Y := TJSONArray(B);
|
|
Assert(Y.Count = 6);
|
|
Assert(Y.Item[0].ValueType = jvtInteger);
|
|
Assert(Y.Item[0].ValueInt = 1);
|
|
Assert(Y.ItemAsInt[0] = 1);
|
|
Assert(Y.Item[1].ValueStr = 'a');
|
|
Assert(Y.ItemAsStr[1] = 'a');
|
|
Assert(Y.Item[2].ValueType = jvtFloat);
|
|
Assert(Abs(Y.Item[2].ValueFloat - 12.345) < 1e-6);
|
|
Assert(Abs(Y.ItemAsFloat[2] - 12.345) < 1e-6);
|
|
Assert(Y.Item[3].ValueType = jvtString);
|
|
Assert(Y.Item[3].ValueStr = '');
|
|
Assert(Y.ItemAsStr[3] = '');
|
|
Assert(Y.Item[4].GetJSONString = '{}');
|
|
Assert(Y.Item[4].ValueIsObject);
|
|
Assert(Y.Item[5].GetJSONString = '[]');
|
|
Assert(Y.Item[5].ValueIsArray);
|
|
Assert(Y.Item[5].ValueType = jvtArray);
|
|
Assert(Abs(X.Item['test6'].ValueFloat - 1.2345) < 1e-6);
|
|
A.Free;
|
|
P.Free;
|
|
|
|
// TestStr2 parse
|
|
P := TJSONParser.Create;
|
|
A := P.ParseText(TestStr2);
|
|
Assert(A is TJSONArray);
|
|
Y := TJSONArray(A);
|
|
Assert(Y.Count = 11);
|
|
Assert(Y.Item[0].ValueInt = 1);
|
|
Assert(Y.Item[1].ValueInt = -1);
|
|
Assert(Y.Item[2].ValueFloat = 1.25);
|
|
Assert(Y.Item[3].ValueFloat = -1.25);
|
|
Assert(Abs(Y.Item[4].ValueFloat - 1.2325e+02) < 1e-08);
|
|
Assert(Abs(Y.Item[5].ValueFloat + 1.2325e+02) < 1e-08);
|
|
Assert(Y.Item[6].ValueFloat = 1e3);
|
|
Assert(Y.Item[7].ValueType = jvtFloat);
|
|
Assert(Abs(Y.Item[7].ValueFloat - 1e-3) < 1e-08);
|
|
Assert(Y.Item[8].ValueInt = 9223372036854775807);
|
|
Assert(Y.Item[9].ValueInt = -9223372036854775807);
|
|
Assert(Y.Item[10].ValueType = jvtInteger);
|
|
Assert(Y.Item[10].ValueInt = 0);
|
|
A.Free;
|
|
P.Free;
|
|
|
|
P := TJSONParser.Create;
|
|
try
|
|
// Parse empty text
|
|
A := P.ParseText('');
|
|
Assert(not Assigned(A));
|
|
A := P.ParseText(' ');
|
|
Assert(not Assigned(A));
|
|
|
|
// Various tests on schema schema
|
|
Assert(GetSchemaSchemaObj <> nil);
|
|
A := P.ParseText(SSchemaSchema);
|
|
B := P.ParseText(A.GetJSONString);
|
|
Assert(B.GetJSONString = A.GetJSONString);
|
|
Assert(B.Compare(A) = 0);
|
|
A.Validate(B as TJSONObject);
|
|
B.Free;
|
|
A.Free;
|
|
|
|
// Validate schema
|
|
P := TJSONParser.Create;
|
|
A := P.ParseText(SchemaStr1);
|
|
ValidateSchema(A as TJSONObject);
|
|
A.Free;
|
|
|
|
// Validate TestStr1 object against schema
|
|
A := P.ParseText(SchemaStr1);
|
|
B := P.ParseText(TestStr1);
|
|
B.Validate(A as TJSONObject);
|
|
B.Free;
|
|
A.Free;
|
|
finally
|
|
P.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
initialization
|
|
finalization
|
|
FreeAndNil(SchemaSchemaObj);
|
|
end.
|
|
|