From c0b6310df2be05d7e27c891983323a9a3b765c90 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Mon, 22 Jul 2024 14:27:43 +0200 Subject: [PATCH] Updated JsonDataObjects to https://github.com/ahausladen/JsonDataObjects/commit/60c6604d650d553b49361651aaf0004d16cb5cc5 --- sources/JsonDataObjects.pas | 714 +++++++++++++++++++++--------------- 1 file changed, 419 insertions(+), 295 deletions(-) diff --git a/sources/JsonDataObjects.pas b/sources/JsonDataObjects.pas index 3f980b82..14108df8 100644 --- a/sources/JsonDataObjects.pas +++ b/sources/JsonDataObjects.pas @@ -37,8 +37,8 @@ unit JsonDataObjects; {$ELSE} {$IF CompilerVersion >= 24.0} // XE3 or newer {$LEGACYIFEND ON} - {$IF CompilerVersion >= 35.0} //11.0 - {$DEFINE USE_NATIVEINT} + {$IF CompilerVersion >= 35.0} // 11.0 or newer + {$DEFINE STREAM_USES_NATIVEINT} {$IFEND} {$IFEND} {$IF CompilerVersion >= 23.0} @@ -70,9 +70,6 @@ unit JsonDataObjects; {$UNDEF ASMSUPPORT} {$ENDIF EXTERNALLINKER} -// Enables the progress callback feature -{$DEFINE SUPPORT_PROGRESS} - // Sanity checks all array index accesses and raise an EListError exception. {$DEFINE CHECK_ARRAY_INDEX} @@ -141,7 +138,7 @@ uses {$ENDIF HAS_UNIT_SCOPE} {$HPPEMIT '#pragma link "Jsondataobjects"'} - + type TJsonBaseObject = class; TJsonObject = class; @@ -171,7 +168,33 @@ type property Position: NativeInt read FPosition; // base 0 Utf8Char/WideChar index end; - {$IFDEF SUPPORT_PROGRESS} + TJsonSerializationConfig = record + public + // LineBreak specifies what characters are used for line breaks in "Compact=False" mode. + // Default: #10 + LineBreak: string; + // IndentChar specifies what characters are used to indent lines in "Compact=False" mode. + // Default: #9 + IndentChar: string; + // If UseUtcTime is True, all TDateTime values will written in UTC timezone converted from the + // local timezone in the JSON string. Otherwise the timezone offset to the local timezone will + // be included. + // Default: True + UseUtcTime: Boolean; + // If EscapeAllNonASCIIChars is True, all characters >=#128 will be escaped when generating + // the JSON string. + // Default: False + EscapeAllNonASCIIChars: Boolean; + + procedure InitDefaults; + class function Default: TJsonSerializationConfig; static; + public + // If NullConvertsToValueTypes is True and an object is nil/null, a convertion to String, Int, + // Long, Float, DateTime, Boolean will return ''/0/False + // Default: False + NullConvertsToValueTypes: Boolean; // Isn't use for serialization. Should default to True and be deprecated. + end; + TJsonReaderProgressProc = procedure(Data: Pointer; Percentage: Integer; Position, Size: NativeInt); PJsonReaderProgressRec = ^TJsonReaderProgressRec; @@ -182,10 +205,10 @@ type function Init(AProgress: TJsonReaderProgressProc; AData: Pointer = nil; AThreshold: NativeInt = 0): PJsonReaderProgressRec; end; - {$ENDIF SUPPORT_PROGRESS} // TJsonOutputWriter is used to write the JSON data to a string, stream or TStrings in a compact // or human readable format. + PJsonOutputWriter = ^TJsonOutputWriter; TJsonOutputWriter = record private type TLastType = (ltInitial, ltIndent, ltUnindent, ltIntro, ltValue, ltSeparator); @@ -226,6 +249,7 @@ type FStringBuffer: TJsonStringBuilder; FLines: TStrings; FLastLine: TJsonStringBuilder; + FConfig: TJsonSerializationConfig; FStreamEncodingBuffer: PByte; FStreamEncodingBufferLen: NativeInt; @@ -243,7 +267,8 @@ type procedure AppendLine(AppendOn: TLastType; P: PChar; Len: Integer); overload; inline; procedure FlushLastLine; private // unit private - procedure Init(ACompact: Boolean; AStream: TStream; AEncoding: TEncoding; ALines: TStrings); + procedure Init(ACompact: Boolean; AStream: TStream; AEncoding: TEncoding; ALines: TStrings; + const Config: TJsonSerializationConfig); function Done: string; procedure StreamDone; procedure LinesDone; @@ -516,39 +541,45 @@ type // ParseXxx returns nil if the JSON string is empty or consists only of white chars. // If the JSON string starts with a "[" then the returned object is a TJsonArray otherwise // it is a TJsonObject. - class function ParseUtf8(S: PAnsiChar; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; overload; static; inline; + class function ParseUtf8(S: PAnsiChar; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; overload; static; inline; {$IFDEF SUPPORTS_UTF8STRING} - class function ParseUtf8(const S: UTF8String{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; overload; static; inline; + class function ParseUtf8(const S: UTF8String; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; overload; static; inline; {$ENDIF SUPPORTS_UTF8STRING} - class function ParseUtf8Bytes(S: PByte; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; static; - class function Parse(S: PWideChar; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; overload; static; - class function Parse(const S: UnicodeString{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; overload; static; inline; + class function ParseUtf8Bytes(S: PByte; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; static; + class function Parse(S: PWideChar; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; overload; static; + class function Parse(const S: UnicodeString; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; overload; static; inline; class function Parse(const Bytes: TBytes; Encoding: TEncoding = nil; ByteIndex: Integer = 0; - ByteCount: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; overload; static; - class function ParseFromFile(const FileName: string; Utf8WithoutBOM: Boolean = True{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; static; - class function ParseFromStream(Stream: TStream; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}): TJsonBaseObject; static; + ByteCount: Integer = -1; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; overload; static; + class function ParseFromFile(const FileName: string; Utf8WithoutBOM: Boolean = True; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; static; + class function ParseFromStream(Stream: TStream; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True; AProgress: PJsonReaderProgressRec = nil): TJsonBaseObject; static; - procedure LoadFromFile(const FileName: string; Utf8WithoutBOM: Boolean = True{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); - procedure LoadFromStream(Stream: TStream; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); - procedure SaveToFile(const FileName: string; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); - procedure SaveToStream(Stream: TStream; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); - procedure SaveToLines(Lines: TStrings); + procedure LoadFromFile(const FileName: string; Utf8WithoutBOM: Boolean = True; AProgress: PJsonReaderProgressRec = nil); + procedure LoadFromStream(Stream: TStream; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True; AProgress: PJsonReaderProgressRec = nil); + procedure SaveToFile(const FileName: string; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); overload; inline; + procedure SaveToFile(const FileName: string; const Config: TJsonSerializationConfig; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); overload; + procedure SaveToStream(Stream: TStream; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); overload; inline; + procedure SaveToStream(Stream: TStream; const Config: TJsonSerializationConfig; Compact: Boolean = True; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); overload; + procedure SaveToLines(Lines: TStrings); overload; inline; + procedure SaveToLines(Lines: TStrings; const Config: TJsonSerializationConfig); overload; // FromXxxJSON() raises an EJsonParserException if you try to parse an array JSON string into a // TJsonObject or a object JSON string into a TJsonArray. {$IFDEF SUPPORTS_UTF8STRING} - procedure FromUtf8JSON(const S: UTF8String{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); overload; inline; + procedure FromUtf8JSON(const S: UTF8String; AProgress: PJsonReaderProgressRec = nil); overload; inline; {$ENDIF SUPPORTS_UTF8STRING} - procedure FromUtf8JSON(S: PAnsiChar; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); overload; inline; - procedure FromUtf8JSON(S: PByte; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); overload; - procedure FromJSON(const S: UnicodeString{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); overload; - procedure FromJSON(S: PWideChar; Len: Integer = -1{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec = nil{$ENDIF}); overload; + procedure FromUtf8JSON(S: PAnsiChar; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil); overload; inline; + procedure FromUtf8JSON(S: PByte; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil); overload; + procedure FromJSON(const S: UnicodeString; AProgress: PJsonReaderProgressRec = nil); overload; + procedure FromJSON(S: PWideChar; Len: Integer = -1; AProgress: PJsonReaderProgressRec = nil); overload; - function ToJSON(Compact: Boolean = True): string; + function ToJSON(Compact: Boolean = True): string; overload; inline; + function ToJSON(const Config: TJsonSerializationConfig; Compact: Boolean = True): string; overload; {$IFDEF SUPPORTS_UTF8STRING} - function ToUtf8JSON(Compact: Boolean = True): UTF8String; overload; + function ToUtf8JSON(Compact: Boolean = True): UTF8String; overload; inline; + function ToUtf8JSON(const Config: TJsonSerializationConfig; Compact: Boolean = True): UTF8String; overload; {$ENDIF SUPPORTS_UTF8STRING} - procedure ToUtf8JSON(var Bytes: TBytes; Compact: Boolean = True); {$IFDEF SUPPORTS_UTF8STRING}overload;{$ENDIF} + procedure ToUtf8JSON(var Bytes: TBytes; Compact: Boolean = True); overload; inline; + procedure ToUtf8JSON(var Bytes: TBytes; const Config: TJsonSerializationConfig; Compact: Boolean = True); overload; // ToString() returns a compact JSON string function ToString: string; override; @@ -833,13 +864,6 @@ type property Capacity: Integer read FCapacity write SetCapacity; end; - TJsonSerializationConfig = record - LineBreak: string; - IndentChar: string; - UseUtcTime: Boolean; - NullConvertsToValueTypes: Boolean; - end; - // Rename classes because RTL classes have the same name TJDOJsonBaseObject = TJsonBaseObject; TJDOJsonObject = TJsonObject; @@ -850,6 +874,7 @@ var LineBreak: #10; IndentChar: #9; UseUtcTime: True; + EscapeAllNonASCIIChars: False; // If True all characters >= #128 will be escaped when generating the JSON string NullConvertsToValueTypes: False; // If True and an object is nil/null, a convertion to String, Int, Long, Float, DateTime, Boolean will return ''/0/False ); @@ -1014,12 +1039,10 @@ type FLineNum: Integer; FStart: Pointer; FLineStart: Pointer; - {$IFDEF SUPPORT_PROGRESS} FLastProgressValue: NativeInt; FSize: NativeInt; FProgress: PJsonReaderProgressRec; procedure CheckProgress(Position: Pointer); - {$ENDIF SUPPORT_PROGRESS} function GetLineColumn: NativeInt; function GetPosition: NativeInt; function GetCharOffset(StartPos: Pointer): NativeInt; virtual; abstract; @@ -1037,7 +1060,7 @@ type procedure FreeInstance; override; {$ENDIF USE_FAST_NEWINSTANCE} - constructor Create(AStart: Pointer{$IFDEF SUPPORT_PROGRESS}; ASize: NativeInt; AProgress: PJsonReaderProgressRec{$ENDIF}); + constructor Create(AStart: Pointer; ASize: NativeInt; AProgress: PJsonReaderProgressRec); destructor Destroy; override; procedure Parse(Data: TJsonBaseObject); end; @@ -1055,7 +1078,7 @@ type procedure LexNumber(P: PByte{$IFDEF CPUARM}; EndP: PByte{$ENDIF}); procedure LexIdent(P: PByte{$IFDEF CPUARM}; EndP: PByte{$ENDIF}); public - constructor Create(S: PByte; Len: NativeInt{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); + constructor Create(S: PByte; Len: NativeInt; AProgress: PJsonReaderProgressRec); end; TStringJsonReader = class sealed(TJsonReader) @@ -1071,7 +1094,7 @@ type procedure LexNumber(P: PChar{$IFDEF CPUARM}; EndP: PChar{$ENDIF}); procedure LexIdent(P: PChar{$IFDEF CPUARM}; EndP: PChar{$ENDIF}); public - constructor Create(S: PChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); + constructor Create(S: PChar; Len: Integer; AProgress: PJsonReaderProgressRec); end; TMemoryStreamAccess = class(TMemoryStream); @@ -1081,7 +1104,7 @@ type private FDataString: UTF8String; protected - function Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; + function Realloc(var NewCapacity: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; public constructor Create; property DataString: UTF8String read FDataString; @@ -1092,7 +1115,7 @@ type private FBytes: TBytes; protected - function Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; + function Realloc(var NewCapacity: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; override; public constructor Create; property Bytes: TBytes read FBytes; @@ -1446,50 +1469,6 @@ begin end; {$ENDIF MSWINDOWS} -class function TJsonBaseObject.UtcDateTimeToJSON(const UtcDateTime: TDateTime): string; -var - Year, Month, Day, Hour, Minute, Second, Milliseconds: Word; -begin - DecodeDate(UtcDateTime, Year, Month, Day); - DecodeTime(UtcDateTime, Hour, Minute, Second, MilliSeconds); - Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%dZ', - [Year, Month, Day, Hour, Minute, Second, Milliseconds]); -end; - -function TJsonBaseObject.Clone: TJsonBaseObject; -begin - if Self is TJsonArray then - Result := TJsonArray(Self).Clone - else - Result := TJsonObject(Self).Clone; -end; - -class function TJsonBaseObject.DateTimeToJSON(const Value: TDateTime; UseUtcTime: Boolean): string; -{$IFDEF MSWINDOWS} -var - LocalTime, UtcTime: TSystemTime; -begin - if UseUtcTime then - begin - DateTimeToSystemTime(Value, LocalTime); - if not TzSpecificLocalTimeToSystemTime(nil, LocalTime, UtcTime) then - UtcTime := LocalTime; - Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%dZ', - [UtcTime.wYear, UtcTime.wMonth, UtcTime.wDay, - UtcTime.wHour, UtcTime.wMinute, UtcTime.wSecond, UtcTime.wMilliseconds]); - end - else - Result := DateTimeToISO8601(Value); -end; -{$ELSE} -begin - if UseUtcTime then - Result := UtcDateTimeToJSON(TTimeZone.Local.ToUniversalTime(Value)) - else - Result := DateTimeToISO8601(Value); -end; -{$ENDIF MSWINDOWS} - function ParseDateTimePart(P: PChar; var Value: Integer; MaxLen: Integer): PChar; var V: Integer; @@ -1530,104 +1509,6 @@ begin end; end; -class function TJsonBaseObject.JSONToDateTime(const Value: string; ConvertToLocalTime: Boolean): TDateTime; -var - P: PChar; - MSecsSince1970: Int64; - Year, Month, Day, Hour, Min, Sec, MSec: Integer; - OffsetHour, OffsetMin: Integer; - Sign: Double; -begin - Result := 0; - if Value = '' then - Exit; - - P := PChar(Value); - if (P^ = '/') and (StrLComp('Date(', P + 1, 5) = 0) then // .NET: milliseconds since 1970-01-01 - begin - Inc(P, 6); - MSecsSince1970 := 0; - while (P^ <> #0) and (P^ in ['0'..'9']) do - begin - MSecsSince1970 := MSecsSince1970 * 10 + (Ord(P^) - Ord('0')); - Inc(P); - end; - if (P^ = '+') or (P^ = '-') then // timezone information - begin - Inc(P); - while (P^ <> #0) and (P^ in ['0'..'9']) do - Inc(P); - end; - if (P[0] = ')') and (P[1] = '/') and (P[2] = #0) then - begin - Result := UnixDateDelta + (MSecsSince1970 / MSecsPerDay); - if ConvertToLocalTime then - Result := UtcDateTimeToLocalDateTime(Result); - end - else - Result := 0; // invalid format - end - else - begin - // "2015-02-01T16:08:19.202Z" - if P^ = '-' then // negative year - Inc(P); - P := ParseDateTimePart(P, Year, 4); - if P^ <> '-' then - Exit; // invalid format - P := ParseDateTimePart(P + 1, Month, 2); - if P^ <> '-' then - Exit; // invalid format - P := ParseDateTimePart(P + 1, Day, 2); - - Hour := 0; - Min := 0; - Sec := 0; - MSec := 0; - Result := EncodeDate(Year, Month, Day); - - if P^ = 'T' then - begin - P := ParseDateTimePart(P + 1, Hour, 2); - if P^ <> ':' then - Exit; // invalid format - P := ParseDateTimePart(P + 1, Min, 2); - if P^ = ':' then - begin - P := ParseDateTimePart(P + 1, Sec, 2); - if P^ = '.' then - P := ParseDateTimePart(P + 1, MSec, 3); - end; - Result := Result + EncodeTime(Hour, Min, Sec, MSec); - if (P^ <> 'Z') and (P^ <> #0) then - begin - if (P^ = '+') or (P^ = '-') then - begin - if P^ = '+' then - Sign := -1 // +0100 means that the time is 1 hour later than UTC - else - Sign := 1; - - P := ParseDateTimePart(P + 1, OffsetHour, 2); - if P^ = ':' then - Inc(P); - ParseDateTimePart(P, OffsetMin, 2); - - Result := Result + (EncodeTime(OffsetHour, OffsetMin, 0, 0) * Sign); - end - else - begin - Result := 0; // invalid format - Exit; - end; - end; - - if ConvertToLocalTime then - Result := UtcDateTimeToLocalDateTime(Result); - end; - end; -end; - {$IFDEF NEXTGEN} function Utf8StrLen(P: PByte): Integer; begin @@ -1688,7 +1569,22 @@ begin SetLength(S, OldLen); end; -{$IFDEF SUPPORT_PROGRESS} +{ TJsonSerializationConfig } + +procedure TJsonSerializationConfig.InitDefaults; +begin + LineBreak := #10; + IndentChar := #9; + UseUtcTime := True; + EscapeAllNonASCIIChars := False; + NullConvertsToValueTypes := False; +end; + +class function TJsonSerializationConfig.Default: TJsonSerializationConfig; +begin + Result.InitDefaults; +end; + { TJsonReaderProgressRec } function TJsonReaderProgressRec.Init(AProgress: TJsonReaderProgressProc; AData: Pointer = nil; AThreshold: NativeInt = 0): PJsonReaderProgressRec; @@ -1698,7 +1594,6 @@ begin Self.Progress := AProgress; Result := @Self; end; -{$ENDIF SUPPORT_PROGRESS} { TJsonReader } @@ -1719,7 +1614,7 @@ begin end; {$ENDIF ~USE_FAST_NEWINSTANCE} -constructor TJsonReader.Create(AStart: Pointer{$IFDEF SUPPORT_PROGRESS}; ASize: NativeInt; AProgress: PJsonReaderProgressRec{$ENDIF}); +constructor TJsonReader.Create(AStart: Pointer; ASize: NativeInt; AProgress: PJsonReaderProgressRec); begin //inherited Create; {$IFDEF USE_FAST_NEWINSTANCE} @@ -1734,13 +1629,11 @@ begin FLineNum := 1; // base 1 FLineStart := nil; - {$IFDEF SUPPORT_PROGRESS} FSize := ASize; FProgress := AProgress; FLastProgressValue := 0; // class is not zero-filled if (FProgress <> nil) and Assigned(FProgress.Progress) then FProgress.Progress(FProgress.Data, 0, 0, FSize); - {$ENDIF SUPPORT_PROGRESS} end; destructor TJsonReader.Destroy; @@ -1753,14 +1646,11 @@ begin FIdents.Done; {$ENDIF USE_STRINGINTERN_FOR_NAMES} - {$IFDEF SUPPORT_PROGRESS} if (FLook.Kind = jtkEof) and (FProgress <> nil) and Assigned(FProgress.Progress) then FProgress.Progress(FProgress.Data, 100, FSize, FSize); - {$ENDIF SUPPORT_PROGRESS} //inherited Destroy; end; -{$IFDEF SUPPORT_PROGRESS} procedure TJsonReader.CheckProgress(Position: Pointer); var NewPercentage: NativeInt; @@ -1791,7 +1681,6 @@ begin end; end; end; -{$ENDIF SUPPORT_PROGRESS} function TJsonReader.GetLineColumn: NativeInt; begin @@ -2804,9 +2693,20 @@ begin end; end; -function DoubleToText(Buffer: PChar; const Value: Extended): Integer; inline; +function DoubleToText(Buffer: PChar; const Value: Extended): Integer; {inline;} +var + I: Integer; begin Result := FloatToText(Buffer, Value, fvExtended, ffGeneral, 15, 0, JSONFormatSettings); + + // Add the decimal separator if FloatToText didn't add it, so that the data type of + // the property doesn't change to Integer/Int64 if it is read again. + for I := Result - 1 downto 0 do + if Buffer[I] = '.' then + Exit; + Buffer[Result] := '.'; + Buffer[Result + 1] := '0'; + Inc(Result, 2); end; const @@ -2904,7 +2804,7 @@ end; procedure TJsonDataValue.InternToJSON(var Writer: TJsonOutputWriter); var - Buffer: array[0..63] of Char; + Buffer: array[0..63 + 2] of Char; P, BufEnd: PChar; begin case FTyp of @@ -2982,6 +2882,148 @@ begin end; {$ENDIF USE_FAST_AUTOREFCOUNT} +class function TJsonBaseObject.UtcDateTimeToJSON(const UtcDateTime: TDateTime): string; +var + Year, Month, Day, Hour, Minute, Second, Milliseconds: Word; +begin + DecodeDate(UtcDateTime, Year, Month, Day); + DecodeTime(UtcDateTime, Hour, Minute, Second, MilliSeconds); + Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%dZ', + [Year, Month, Day, Hour, Minute, Second, Milliseconds]); +end; + +function TJsonBaseObject.Clone: TJsonBaseObject; +begin + if Self is TJsonArray then + Result := TJsonArray(Self).Clone + else + Result := TJsonObject(Self).Clone; +end; + +class function TJsonBaseObject.DateTimeToJSON(const Value: TDateTime; UseUtcTime: Boolean): string; +{$IFDEF MSWINDOWS} +var + LocalTime, UtcTime: TSystemTime; +begin + if UseUtcTime then + begin + DateTimeToSystemTime(Value, LocalTime); + if not TzSpecificLocalTimeToSystemTime(nil, LocalTime, UtcTime) then + UtcTime := LocalTime; + Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%dZ', + [UtcTime.wYear, UtcTime.wMonth, UtcTime.wDay, + UtcTime.wHour, UtcTime.wMinute, UtcTime.wSecond, UtcTime.wMilliseconds]); + end + else + Result := DateTimeToISO8601(Value); +end; +{$ELSE} +begin + if UseUtcTime then + Result := UtcDateTimeToJSON(TTimeZone.Local.ToUniversalTime(Value)) + else + Result := DateTimeToISO8601(Value); +end; +{$ENDIF MSWINDOWS} + +class function TJsonBaseObject.JSONToDateTime(const Value: string; ConvertToLocalTime: Boolean): TDateTime; +var + P: PChar; + MSecsSince1970: Int64; + Year, Month, Day, Hour, Min, Sec, MSec: Integer; + OffsetHour, OffsetMin: Integer; + Sign: Double; +begin + Result := 0; + if Value = '' then + Exit; + + P := PChar(Value); + if (P^ = '/') and (StrLComp('Date(', P + 1, 5) = 0) then // .NET: milliseconds since 1970-01-01 + begin + Inc(P, 6); + MSecsSince1970 := 0; + while (P^ <> #0) and (P^ in ['0'..'9']) do + begin + MSecsSince1970 := MSecsSince1970 * 10 + (Ord(P^) - Ord('0')); + Inc(P); + end; + if (P^ = '+') or (P^ = '-') then // timezone information + begin + Inc(P); + while (P^ <> #0) and (P^ in ['0'..'9']) do + Inc(P); + end; + if (P[0] = ')') and (P[1] = '/') and (P[2] = #0) then + begin + Result := UnixDateDelta + (MSecsSince1970 / MSecsPerDay); + if ConvertToLocalTime then + Result := UtcDateTimeToLocalDateTime(Result); + end + else + Result := 0; // invalid format + end + else + begin + // "2015-02-01T16:08:19.202Z" + if P^ = '-' then // negative year + Inc(P); + P := ParseDateTimePart(P, Year, 4); + if P^ <> '-' then + Exit; // invalid format + P := ParseDateTimePart(P + 1, Month, 2); + if P^ <> '-' then + Exit; // invalid format + P := ParseDateTimePart(P + 1, Day, 2); + + Hour := 0; + Min := 0; + Sec := 0; + MSec := 0; + Result := EncodeDate(Year, Month, Day); + + if P^ = 'T' then + begin + P := ParseDateTimePart(P + 1, Hour, 2); + if P^ <> ':' then + Exit; // invalid format + P := ParseDateTimePart(P + 1, Min, 2); + if P^ = ':' then + begin + P := ParseDateTimePart(P + 1, Sec, 2); + if P^ = '.' then + P := ParseDateTimePart(P + 1, MSec, 3); + end; + Result := Result + EncodeTime(Hour, Min, Sec, MSec); + if (P^ <> 'Z') and (P^ <> #0) then + begin + if (P^ = '+') or (P^ = '-') then + begin + if P^ = '+' then + Sign := -1 // +0100 means that the time is 1 hour later than UTC + else + Sign := 1; + + P := ParseDateTimePart(P + 1, OffsetHour, 2); + if P^ = ':' then + Inc(P); + ParseDateTimePart(P, OffsetMin, 2); + + Result := Result + (EncodeTime(OffsetHour, OffsetMin, 0, 0) * Sign); + end + else + begin + Result := 0; // invalid format + Exit; + end; + end; + + if ConvertToLocalTime then + Result := UtcDateTimeToLocalDateTime(Result); + end; + end; +end; + class procedure TJsonBaseObject.StrToJSONStr(const AppendMethod: TWriterAppendMethod; const S: string); var P, EndP, F: PChar; @@ -2997,12 +3039,25 @@ begin // DCC64 generates "bt mem,reg" code // while (P < EndP) and not (P^ in [#0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}]) do // Inc(P); - while P < EndP do - case P^ of - #0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}: Break; - else - Inc(P); - end; + + if PJsonOutputWriter(TMethod(AppendMethod).Data).FConfig.EscapeAllNonASCIIChars then + begin + while P < EndP do + case Ord(P^) of + 0..31, Ord('\'), Ord('"') {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, Ord('/'){$ENDIF}, $0080..$FFFF: Break; + else + Inc(P); + end; + end + else + begin + while P < EndP do + case P^ of + #0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}: Break; + else + Inc(P); + end; + end; // nothing found, than it is easy if P = EndP then @@ -3018,7 +3073,7 @@ class procedure TJsonBaseObject.DateTimeToJSONStr(const AppendMethod: TWriterApp var S: string; begin - S := TJsonBaseObject.DateTimeToJSON(Value, JsonSerializationConfig.UseUtcTime); + S := TJsonBaseObject.DateTimeToJSON(Value, PJsonOutputWriter(TMethod(AppendMethod).Data).FConfig.UseUtcTime); // StrToJSONStr isn't necessary because the date-time string doesn't contain any char // that must be escaped. AppendMethod(PChar(S), Length(S)); @@ -3043,11 +3098,14 @@ var {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN} StartP: PChar; {$ENDIF ESCAPE_SLASH_AFTER_LESSTHAN} + EscapeAllNonASCIIChars: Boolean; begin {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN} StartP := F; {$ENDIF ESCAPE_SLASH_AFTER_LESSTHAN} + EscapeAllNonASCIIChars := PJsonOutputWriter(TMethod(AppendMethod).Data).FConfig.EscapeAllNonASCIIChars; + Buf.Init; try repeat @@ -3079,17 +3137,36 @@ begin end; {$ENDIF ESCAPE_SLASH_AFTER_LESSTHAN} end; + if (Ord(Ch) >= $0080) and EscapeAllNonASCIIChars then + begin + Buf.Append('\u', 2); + Buf.Append2(HexChars[(Word(Ch) shr 12) and $F], HexChars[(Word(Ch) shr 8) and $F]); + Buf.Append2(HexChars[(Word(Ch) shr 4) and $F], HexChars[Word(Ch) and $F]); + end; + Inc(P); F := P; -// DCC64 generates "bt mem,reg" code -// while (P < EndP) and not (P^ in [#0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}]) do -// Inc(P); - while P < EndP do - case P^ of - #0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}: Break; - else - Inc(P); - end; + if EscapeAllNonASCIIChars then + begin + while P < EndP do + case Ord(P^) of + 0..31, Ord('\'), Ord('"') {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, Ord('/'){$ENDIF}, $80..$FFFF: Break; + else + Inc(P); + end; + end + else + begin + // DCC64 generates "bt mem,reg" code + // while (P < EndP) and not (P^ in [#0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}]) do + // Inc(P); + while P < EndP do + case P^ of + #0..#31, '\', '"' {$IFDEF ESCAPE_SLASH_AFTER_LESSTHAN}, '/'{$ENDIF}: Break; + else + Inc(P); + end; + end; end else Break; @@ -3100,19 +3177,19 @@ begin end; end; -class function TJsonBaseObject.ParseUtf8(S: PAnsiChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.ParseUtf8(S: PAnsiChar; Len: Integer; AProgress: PJsonReaderProgressRec): TJsonBaseObject; begin - Result := ParseUtf8Bytes(PByte(S), Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := ParseUtf8Bytes(PByte(S), Len, AProgress); end; {$IFDEF SUPPORTS_UTF8STRING} -class function TJsonBaseObject.ParseUtf8(const S: UTF8String{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.ParseUtf8(const S: UTF8String; AProgress: PJsonReaderProgressRec): TJsonBaseObject; begin - Result := ParseUtf8Bytes(PByte(S), Length(S){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := ParseUtf8Bytes(PByte(S), Length(S), AProgress); end; {$ENDIF SUPPORTS_UTF8STRING} -class function TJsonBaseObject.ParseUtf8Bytes(S: PByte; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.ParseUtf8Bytes(S: PByte; Len: Integer; AProgress: PJsonReaderProgressRec): TJsonBaseObject; var P: PByte; L: Integer; @@ -3146,10 +3223,10 @@ begin Result := TJsonObject.Create; {$IFDEF AUTOREFCOUNT} - Result.FromUtf8JSON(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result.FromUtf8JSON(S, Len, AProgress); {$ELSE} try - Result.FromUtf8JSON(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result.FromUtf8JSON(S, Len, AProgress); except Result.Free; raise; @@ -3159,12 +3236,12 @@ begin end; end; -class function TJsonBaseObject.Parse(const S: UnicodeString{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.Parse(const S: UnicodeString; AProgress: PJsonReaderProgressRec): TJsonBaseObject; begin - Result := Parse(PWideChar(Pointer(S)), Length(S){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := Parse(PWideChar(Pointer(S)), Length(S), AProgress); end; -class function TJsonBaseObject.Parse(S: PWideChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.Parse(S: PWideChar; Len: Integer; AProgress: PJsonReaderProgressRec): TJsonBaseObject; var P: PWideChar; L: Integer; @@ -3192,10 +3269,10 @@ begin Result := TJsonObject.Create; {$IFDEF AUTOREFCOUNT} - Result.FromJSON(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result.FromJSON(S, Len, AProgress); {$ELSE} try - Result.FromJSON(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result.FromJSON(S, Len, AProgress); except Result.Free; raise; @@ -3206,7 +3283,7 @@ begin end; class function TJsonBaseObject.Parse(const Bytes: TBytes; Encoding: TEncoding; ByteIndex: Integer; - ByteCount: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; + ByteCount: Integer; AProgress: PJsonReaderProgressRec): TJsonBaseObject; var L: Integer; begin @@ -3218,27 +3295,30 @@ begin else begin if (Encoding = TEncoding.UTF8) or (Encoding = nil) then - Result := ParseUtf8Bytes(PByte(@Bytes[ByteIndex]), ByteCount{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + Result := ParseUtf8Bytes(PByte(@Bytes[ByteIndex]), ByteCount, AProgress) else if Encoding = TEncoding.Unicode then - Result := Parse(PWideChar(@Bytes[ByteIndex]), ByteCount div SizeOf(WideChar){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + Result := Parse(PWideChar(@Bytes[ByteIndex]), ByteCount div SizeOf(WideChar), AProgress) else - Result := Parse(Encoding.GetString(Bytes, ByteIndex, ByteCount){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := Parse(Encoding.GetString(Bytes, ByteIndex, ByteCount), AProgress); end; end; -class function TJsonBaseObject.ParseFromFile(const FileName: string; Utf8WithoutBOM: Boolean{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.ParseFromFile(const FileName: string; Utf8WithoutBOM: Boolean; + AProgress: PJsonReaderProgressRec): TJsonBaseObject; var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try - Result := ParseFromStream(Stream, nil, Utf8WithoutBOM{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := ParseFromStream(Stream, nil, Utf8WithoutBOM, AProgress); finally Stream.Free; end; end; -class function TJsonBaseObject.ParseFromStream(Stream: TStream; Encoding: TEncoding; Utf8WithoutBOM: Boolean{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}): TJsonBaseObject; +class function TJsonBaseObject.ParseFromStream(Stream: TStream; Encoding: TEncoding; + Utf8WithoutBOM: Boolean; AProgress: PJsonReaderProgressRec +): TJsonBaseObject; var StreamInfo: TStreamInfo; S: string; @@ -3247,9 +3327,9 @@ begin GetStreamBytes(Stream, Encoding, Utf8WithoutBOM, StreamInfo); try if Encoding = TEncoding.UTF8 then - Result := ParseUtf8Bytes(StreamInfo.Buffer, StreamInfo.Size{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + Result := ParseUtf8Bytes(StreamInfo.Buffer, StreamInfo.Size, AProgress) else if Encoding = TEncoding.Unicode then - Result := Parse(PWideChar(Pointer(StreamInfo.Buffer)), StreamInfo.Size div SizeOf(WideChar){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + Result := Parse(PWideChar(Pointer(StreamInfo.Buffer)), StreamInfo.Size div SizeOf(WideChar), AProgress) else begin L := TEncodingStrictAccess(Encoding).GetCharCountEx(StreamInfo.Buffer, StreamInfo.Size); @@ -3263,7 +3343,7 @@ begin FreeMem(StreamInfo.AllocationBase); StreamInfo.AllocationBase := nil; - Result := Parse(S{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Result := Parse(S, AProgress); end; finally FreeMem(StreamInfo.AllocationBase); @@ -3271,18 +3351,18 @@ begin end; {$IFDEF SUPPORTS_UTF8STRING} -procedure TJsonBaseObject.FromUtf8JSON(const S: UTF8String{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.FromUtf8JSON(const S: UTF8String; AProgress: PJsonReaderProgressRec); begin - FromUtf8JSON(PAnsiChar(Pointer(S)), Length(S){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + FromUtf8JSON(PAnsiChar(Pointer(S)), Length(S), AProgress); end; {$ENDIF SUPPORTS_UTF8STRING} -procedure TJsonBaseObject.FromUtf8JSON(S: PAnsiChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.FromUtf8JSON(S: PAnsiChar; Len: Integer; AProgress: PJsonReaderProgressRec); begin - FromUtf8JSON(PByte(S), Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + FromUtf8JSON(PByte(S), Len, AProgress); end; -procedure TJsonBaseObject.FromUtf8JSON(S: PByte; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.FromUtf8JSON(S: PByte; Len: Integer; AProgress: PJsonReaderProgressRec); var Reader: TJsonReader; begin @@ -3294,7 +3374,7 @@ begin Len := StrLen(PAnsiChar(S)); {$ENDIF NEXTGEN} end; - Reader := TUtf8JsonReader.Create(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Reader := TUtf8JsonReader.Create(S, Len, AProgress); try Reader.Parse(Self); finally @@ -3302,18 +3382,18 @@ begin end; end; -procedure TJsonBaseObject.FromJSON(const S: UnicodeString{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.FromJSON(const S: UnicodeString; AProgress: PJsonReaderProgressRec); begin - FromJSON(PWideChar(S), Length(S){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + FromJSON(PWideChar(S), Length(S), AProgress); end; -procedure TJsonBaseObject.FromJSON(S: PWideChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.FromJSON(S: PWideChar; Len: Integer; AProgress: PJsonReaderProgressRec); var Reader: TJsonReader; begin if Len < 0 then Len := StrLen(S); - Reader := TStringJsonReader.Create(S, Len{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + Reader := TStringJsonReader.Create(S, Len, AProgress); try Reader.Parse(Self); finally @@ -3321,13 +3401,13 @@ begin end; end; -procedure TJsonBaseObject.LoadFromFile(const FileName: string; Utf8WithoutBOM: Boolean{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.LoadFromFile(const FileName: string; Utf8WithoutBOM: Boolean; AProgress: PJsonReaderProgressRec); var Stream: TFileStream; begin Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try - LoadFromStream(Stream, nil, Utf8WithoutBOM{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + LoadFromStream(Stream, nil, Utf8WithoutBOM, AProgress); finally Stream.Free; end; @@ -3445,7 +3525,8 @@ begin end; end; -procedure TJsonBaseObject.LoadFromStream(Stream: TStream; Encoding: TEncoding; Utf8WithoutBOM: Boolean{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +procedure TJsonBaseObject.LoadFromStream(Stream: TStream; Encoding: TEncoding; Utf8WithoutBOM: Boolean; + AProgress: PJsonReaderProgressRec); var StreamInfo: TStreamInfo; S: string; @@ -3454,9 +3535,9 @@ begin GetStreamBytes(Stream, Encoding, Utf8WithoutBOM, StreamInfo); try if Encoding = TEncoding.UTF8 then - FromUtf8JSON(StreamInfo.Buffer, StreamInfo.Size{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + FromUtf8JSON(StreamInfo.Buffer, StreamInfo.Size, AProgress) else if Encoding = TEncoding.Unicode then - FromJSON(PWideChar(Pointer(StreamInfo.Buffer)), StreamInfo.Size div SizeOf(WideChar){$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}) + FromJSON(PWideChar(Pointer(StreamInfo.Buffer)), StreamInfo.Size div SizeOf(WideChar), AProgress) else begin L := TEncodingStrictAccess(Encoding).GetCharCountEx(StreamInfo.Buffer, StreamInfo.Size); @@ -3470,26 +3551,40 @@ begin FreeMem(StreamInfo.AllocationBase); StreamInfo.AllocationBase := nil; - FromJSON(S{$IFDEF SUPPORT_PROGRESS}, AProgress{$ENDIF}); + FromJSON(S, AProgress); end; finally FreeMem(StreamInfo.AllocationBase); end; end; -procedure TJsonBaseObject.SaveToFile(const FileName: string; Compact: Boolean; Encoding: TEncoding; Utf8WithoutBOM: Boolean); +procedure TJsonBaseObject.SaveToFile(const FileName: string; Compact: Boolean; Encoding: TEncoding; + Utf8WithoutBOM: Boolean); +begin + SaveToFile(FileName, JsonSerializationConfig, Compact, Encoding, Utf8WithoutBOM); +end; + +procedure TJsonBaseObject.SaveToFile(const FileName: string; const Config: TJsonSerializationConfig; + Compact: Boolean; Encoding: TEncoding; Utf8WithoutBOM: Boolean); var Stream: TStream; begin Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); try - SaveToStream(Stream, Compact, Encoding, Utf8WithoutBOM); + SaveToStream(Stream, Config, Compact, Encoding, Utf8WithoutBOM); finally Stream.Free; end; end; -procedure TJsonBaseObject.SaveToStream(Stream: TStream; Compact: Boolean; Encoding: TEncoding; Utf8WithoutBOM: Boolean); +procedure TJsonBaseObject.SaveToStream(Stream: TStream; Compact: Boolean; Encoding: TEncoding; + Utf8WithoutBOM: Boolean); +begin + SaveToStream(Stream, JsonSerializationConfig, Compact, Encoding, Utf8WithoutBOM); +end; + +procedure TJsonBaseObject.SaveToStream(Stream: TStream; const Config: TJsonSerializationConfig; + Compact: Boolean; Encoding: TEncoding; Utf8WithoutBOM: Boolean); var Preamble: TBytes; Writer: TJsonOutputWriter; @@ -3506,7 +3601,7 @@ begin Stream.Write(Preamble[0], Length(Preamble)); end; - Writer.Init(Compact, Stream, Encoding, nil); + Writer.Init(Compact, Stream, Encoding, nil, Config); try InternToJSON(Writer); finally @@ -3515,10 +3610,15 @@ begin end; procedure TJsonBaseObject.SaveToLines(Lines: TStrings); +begin + SaveToLines(Lines, JsonSerializationConfig); +end; + +procedure TJsonBaseObject.SaveToLines(Lines: TStrings; const Config: TJsonSerializationConfig); var Writer: TJsonOutputWriter; begin - Writer.Init(False, nil, nil, Lines); + Writer.Init(False, nil, nil, Lines, Config); try InternToJSON(Writer); finally @@ -3527,10 +3627,15 @@ begin end; function TJsonBaseObject.ToJSON(Compact: Boolean): string; +begin + Result := ToJSON(JsonSerializationConfig, Compact); +end; + +function TJsonBaseObject.ToJSON(const Config: TJsonSerializationConfig; Compact: Boolean): string; var Writer: TJsonOutputWriter; begin - Writer.Init(Compact, nil, nil, nil); + Writer.Init(Compact, nil, nil, nil, Config); try InternToJSON(Writer); finally @@ -3539,14 +3644,19 @@ begin end; {$IFDEF SUPPORTS_UTF8STRING} -function TJsonBaseObject.ToUtf8JSON(Compact: Boolean = True): UTF8String; +function TJsonBaseObject.ToUtf8JSON(Compact: Boolean): UTF8String; +begin + Result := ToUtf8JSON(JsonSerializationConfig, Compact); +end; + +function TJsonBaseObject.ToUtf8JSON(const Config: TJsonSerializationConfig; Compact: Boolean): UTF8String; var Stream: TJsonUtf8StringStream; Size: NativeInt; begin Stream := TJsonUtf8StringStream.Create; try - SaveToStream(Stream, Compact, nil, True); + SaveToStream(Stream, Config, Compact, nil, True); Result := Stream.DataString; Size := Stream.Size; finally @@ -3557,14 +3667,20 @@ begin end; {$ENDIF SUPPORTS_UTF8STRING} -procedure TJsonBaseObject.ToUtf8JSON(var Bytes: TBytes; Compact: Boolean = True); +procedure TJsonBaseObject.ToUtf8JSON(var Bytes: TBytes; Compact: Boolean); +begin + ToUtf8JSON(Bytes, JsonSerializationConfig, Compact); +end; + +procedure TJsonBaseObject.ToUtf8JSON(var Bytes: TBytes; const Config: TJsonSerializationConfig; + Compact: Boolean); var Stream: TJsonBytesStream; Size: NativeInt; begin Stream := TJsonBytesStream.Create; try - SaveToStream(Stream, Compact, nil, True); + SaveToStream(Stream, Config, Compact, nil, True); Size := Stream.Size; Bytes := Stream.Bytes; finally @@ -5619,11 +5735,13 @@ end; { TJsonOutputWriter } -procedure TJsonOutputWriter.Init(ACompact: Boolean; AStream: TStream; AEncoding: TEncoding; ALines: TStrings); +procedure TJsonOutputWriter.Init(ACompact: Boolean; AStream: TStream; AEncoding: TEncoding; + ALines: TStrings; const Config: TJsonSerializationConfig); begin FCompact := ACompact; FStream := AStream; FEncoding := AEncoding; + FConfig := Config; if ALines <> nil then begin @@ -5650,10 +5768,10 @@ begin FIndents := AllocMem(5 * SizeOf(string)); FIndentsLen := 5; //FIndents[0] := ''; - FIndents[1] := JsonSerializationConfig.IndentChar; - FIndents[2] := FIndents[1] + JsonSerializationConfig.IndentChar; - FIndents[3] := FIndents[2] + JsonSerializationConfig.IndentChar; - FIndents[4] := FIndents[3] + JsonSerializationConfig.IndentChar; + FIndents[1] := FConfig.IndentChar; + FIndents[2] := FIndents[1] + FIndents[1]; + FIndents[3] := FIndents[2] + FIndents[1]; + FIndents[4] := FIndents[3] + FIndents[1]; end; end; @@ -5711,7 +5829,7 @@ begin if FLines = nil then begin FLastLine.FlushToStringBuffer(FStringBuffer); - FStringBuffer.Append(JsonSerializationConfig.LineBreak); + FStringBuffer.Append(FConfig.LineBreak); end else begin @@ -5761,7 +5879,7 @@ begin Inc(FIndentsLen); ReallocMem(Pointer(FIndents), FIndentsLen * SizeOf(string)); Pointer(FIndents[FIndent]) := nil; - FIndents[FIndent] := FIndents[FIndent - 1] + JsonSerializationConfig.IndentChar; + FIndents[FIndent] := FIndents[FIndent - 1] + FConfig.IndentChar; end; procedure TJsonOutputWriter.AppendLine(AppendOn: TLastType; const S: string); @@ -5932,9 +6050,9 @@ end; { TUtf8JsonReader } -constructor TUtf8JsonReader.Create(S: PByte; Len: NativeInt{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +constructor TUtf8JsonReader.Create(S: PByte; Len: NativeInt; AProgress: PJsonReaderProgressRec); begin - inherited Create(S{$IFDEF SUPPORT_PROGRESS}, Len * SizeOf(Byte), AProgress{$ENDIF}); + inherited Create(S, Len * SizeOf(Byte), AProgress); FText := S; FTextEnd := S + Len; end; @@ -6028,25 +6146,19 @@ EndReached: Ord('"'): // String begin LexString(P{$IFDEF CPUARM}, EndP{$ENDIF}); - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end; Ord('-'), Ord('0')..Ord('9'), Ord('.'): // Number begin LexNumber(P{$IFDEF CPUARM}, EndP{$ENDIF}); - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end else LexIdent(P{$IFDEF CPUARM}, EndP{$ENDIF}); // Ident/Bool/NULL - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end; Result := True; end @@ -6498,9 +6610,9 @@ end; { TStringJsonReader } -constructor TStringJsonReader.Create(S: PChar; Len: Integer{$IFDEF SUPPORT_PROGRESS}; AProgress: PJsonReaderProgressRec{$ENDIF}); +constructor TStringJsonReader.Create(S: PChar; Len: Integer; AProgress: PJsonReaderProgressRec); begin - inherited Create(S{$IFDEF SUPPORT_PROGRESS}, Len * SizeOf(WideChar), AProgress{$ENDIF}); + inherited Create(S, Len * SizeOf(WideChar), AProgress); FText := S; FTextEnd := S + Len; end; @@ -6555,25 +6667,19 @@ begin '"': // String begin LexString(P{$IFDEF CPUARM}, EndP{$ENDIF}); - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end; '-', '0'..'9', '.': // Number begin LexNumber(P{$IFDEF CPUARM}, EndP{$ENDIF}); - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end else LexIdent(P{$IFDEF CPUARM}, EndP{$ENDIF}); // Ident/Bool/NULL - {$IFDEF SUPPORT_PROGRESS} if FProgress <> nil then CheckProgress(FText); - {$ENDIF SUPPORT_PROGRESS} end; Result := True; end @@ -7079,6 +7185,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7117,6 +7225,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7155,6 +7265,8 @@ end; // Result.FData.FName := ''; // Result.FData.FNameResolver := nil; // Result.FData.FIntern := nil; +// if Result.FData.FValue <> '' then +// Result.FData.FValue := ''; // {$IFDEF AUTOREFCOUNT} // if Result.FData.FObj <> nil then // Result.FData.FObj := nil; @@ -7193,6 +7305,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7231,6 +7345,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7269,6 +7385,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7309,6 +7427,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7347,10 +7467,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; - {$IFDEF AUTOREFCOUNT} if Result.FData.FValue <> '' then Result.FData.FValue := ''; - {$ENDIF AUTOREFCOUNT} Result.FData.FTyp := jdtArray; Result.FData.FObj := Value; end; @@ -7375,10 +7493,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; - {$IFDEF AUTOREFCOUNT} if Result.FData.FValue <> '' then Result.FData.FValue := ''; - {$ENDIF AUTOREFCOUNT} Result.FData.FTyp := jdtObject; Result.FData.FObj := Value; end; @@ -7403,10 +7519,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; - {$IFDEF AUTOREFCOUNT} if Result.FData.FValue <> '' then Result.FData.FValue := ''; - {$ENDIF AUTOREFCOUNT} Result.FData.FTyp := jdtObject; Result.FData.FObj := nil; end; @@ -7454,6 +7568,8 @@ begin Result.FData.FName := ''; Result.FData.FNameResolver := nil; Result.FData.FIntern := nil; + if Result.FData.FValue <> '' then + Result.FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if Result.FData.FObj <> nil then Result.FData.FObj := nil; @@ -7465,7 +7581,7 @@ begin Result.FData.FTyp := LTyp; case LTyp of jdtString: - string(Result.FData.FValue) := Value; + Result.FData.FValue := Value; jdtInt: Result.FData.FIntValue := Value; jdtLong: @@ -7478,6 +7594,10 @@ begin Result.FData.FDateTimeValue := Value; jdtBool: Result.FData.FBoolValue := Value; + {$IFNDEF AUTOREFCOUNT} + jdtObject: + Result.FData.FObj := nil; + {$ENDIF ~AUTOREFCOUNT} end; end; end; @@ -7563,6 +7683,8 @@ begin FData.FName := ''; FData.FNameResolver := nil; FData.FIntern := nil; + if FData.FValue <> '' then + FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if FData.FObj <> nil then FData.FObj := nil; @@ -7637,6 +7759,8 @@ begin FData.FName := ''; FData.FNameResolver := nil; FData.FIntern := nil; + if FData.FValue <> '' then + FData.FValue := ''; {$IFDEF AUTOREFCOUNT} if FData.FObj <> nil then FData.FObj := nil; @@ -8236,9 +8360,9 @@ begin SetPointer(nil, 0); end; -function TJsonUTF8StringStream.Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; +function TJsonUTF8StringStream.Realloc(var NewCapacity: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; var - L: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; + L: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; begin if NewCapacity <> Capacity then begin @@ -8274,9 +8398,9 @@ begin SetPointer(nil, 0); end; -function TJsonBytesStream.Realloc(var NewCapacity: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; +function TJsonBytesStream.Realloc(var NewCapacity: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}): Pointer; var - L: {$IF Defined(USE_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; + L: {$IF Defined(STREAM_USES_NATIVEINT)}NativeInt{$ELSE}Longint{$IFEND}; begin if NewCapacity <> Capacity then begin