diff --git a/JsonConverter.bas b/JsonConverter.bas index bd636e7..f284420 100644 --- a/JsonConverter.bas +++ b/JsonConverter.bas @@ -47,10 +47,14 @@ Attribute VB_Name = "JsonConverter" ' === VBA-UTC Headers #If Mac Then -Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" (ByVal utc_Command As String, ByVal utc_Mode As String) As Long -Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" (ByVal utc_File As Long) As Long -Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long -Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" (ByVal utc_File As Long) As Long +Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ + (ByVal utc_Command As String, ByVal utc_Mode As String) As Long +Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ + (ByVal utc_File As Long) As Long +Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ + (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long +Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ + (ByVal utc_File As Long) As Long #ElseIf VBA7 Then @@ -121,6 +125,19 @@ Private Declare Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ #End If +Private Type json_Options + ' VBA only stores 15 significant digits, so any numbers larger than that are truncated + ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits + ' See: http://support.microsoft.com/kb/269370 + ' + ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits + ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True` + UseDoubleForLargeNumbers As Boolean + AllowUnquotedKeys As Boolean + EscapeSolidus As Boolean +End Type +Public JsonOptions As json_Options + ' ============================================= ' ' Public Methods ' ============================================= ' @@ -133,7 +150,7 @@ Private Declare Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ ' @return {Object} (Dictionary or Collection) ' @throws 10001 - JSON parse error '' -Public Function ParseJson(ByVal json_String As String, Optional json_ConvertLargeNumbersToString As Boolean = True) As Object +Public Function ParseJson(ByVal json_String As String) As Object Dim json_Index As Long json_Index = 1 @@ -143,9 +160,9 @@ Public Function ParseJson(ByVal json_String As String, Optional json_ConvertLarg json_SkipSpaces json_String, json_Index Select Case VBA.Mid$(json_String, json_Index, 1) Case "{" - Set ParseJson = json_ParseObject(json_String, json_Index, json_ConvertLargeNumbersToString) + Set ParseJson = json_ParseObject(json_String, json_Index) Case "[" - Set ParseJson = json_ParseArray(json_String, json_Index, json_ConvertLargeNumbersToString) + Set ParseJson = json_ParseArray(json_String, json_Index) Case Else ' Error: Invalid JSON string Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{' or '['") @@ -159,7 +176,7 @@ End Function ' @param {Variant} json_DictionaryCollectionOrArray (Dictionary, Collection, or Array) ' @return {String} '' -Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, Optional json_ConvertLargeNumbersFromString As Boolean = True) As String +Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant) As String Dim json_buffer As String Dim json_BufferPosition As Long Dim json_BufferLength As Long @@ -192,7 +209,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, ConvertToJson = """" & json_DateStr & """" Case VBA.vbString ' String (or large number encoded as string) - If json_ConvertLargeNumbersFromString And json_StringIsLargeNumber(json_DictionaryCollectionOrArray) Then + If Not JsonConverter.JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(json_DictionaryCollectionOrArray) Then ConvertToJson = json_DictionaryCollectionOrArray Else ConvertToJson = """" & json_Encode(json_DictionaryCollectionOrArray) & """" @@ -233,8 +250,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, End If json_BufferAppend json_buffer, _ - ConvertToJson(json_DictionaryCollectionOrArray(json_Index, json_Index2D), _ - json_ConvertLargeNumbersFromString), _ + ConvertToJson(json_DictionaryCollectionOrArray(json_Index, json_Index2D)), _ json_BufferPosition, json_BufferLength Next json_Index2D @@ -242,8 +258,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, json_IsFirstItem2D = True Else json_BufferAppend json_buffer, _ - ConvertToJson(json_DictionaryCollectionOrArray(json_Index), _ - json_ConvertLargeNumbersFromString), _ + ConvertToJson(json_DictionaryCollectionOrArray(json_Index)), _ json_BufferPosition, json_BufferLength End If Next json_Index @@ -268,7 +283,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, End If json_BufferAppend json_buffer, _ - """" & json_Key & """:" & ConvertToJson(json_DictionaryCollectionOrArray(json_Key), json_ConvertLargeNumbersFromString), _ + """" & json_Key & """:" & ConvertToJson(json_DictionaryCollectionOrArray(json_Key)), _ json_BufferPosition, json_BufferLength Next json_Key json_BufferAppend json_buffer, "}", json_BufferPosition, json_BufferLength @@ -284,7 +299,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, End If json_BufferAppend json_buffer, _ - ConvertToJson(json_Value, json_ConvertLargeNumbersFromString), _ + ConvertToJson(json_Value), _ json_BufferPosition, json_BufferLength Next json_Value json_BufferAppend json_buffer, "]", json_BufferPosition, json_BufferLength @@ -303,7 +318,7 @@ End Function ' Private Functions ' ============================================= ' -Private Function json_ParseObject(json_String As String, ByRef json_Index As Long, Optional json_ConvertLargeNumbersToString As Boolean = True) As Dictionary +Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary Dim json_Key As String Dim json_NextChar As String @@ -327,15 +342,15 @@ Private Function json_ParseObject(json_String As String, ByRef json_Index As Lon json_Key = json_ParseKey(json_String, json_Index) json_NextChar = json_Peek(json_String, json_Index) If json_NextChar = "[" Or json_NextChar = "{" Then - Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index, json_ConvertLargeNumbersToString) + Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) Else - json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index, json_ConvertLargeNumbersToString) + json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) End If Loop End If End Function -Private Function json_ParseArray(json_String As String, ByRef json_Index As Long, Optional json_ConvertLargeNumbersToString As Boolean = True) As Collection +Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection Set json_ParseArray = New Collection json_SkipSpaces json_String, json_Index @@ -354,12 +369,12 @@ Private Function json_ParseArray(json_String As String, ByRef json_Index As Long json_SkipSpaces json_String, json_Index End If - json_ParseArray.Add json_ParseValue(json_String, json_Index, json_ConvertLargeNumbersToString) + json_ParseArray.Add json_ParseValue(json_String, json_Index) Loop End If End Function -Private Function json_ParseValue(json_String As String, ByRef json_Index As Long, Optional json_ConvertLargeNumbersToString As Boolean = True) As Variant +Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant json_SkipSpaces json_String, json_Index Select Case VBA.Mid$(json_String, json_Index, 1) Case "{" @@ -379,7 +394,7 @@ Private Function json_ParseValue(json_String As String, ByRef json_Index As Long json_ParseValue = Null json_Index = json_Index + 4 ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then - json_ParseValue = json_ParseNumber(json_String, json_Index, json_ConvertLargeNumbersToString) + json_ParseValue = json_ParseNumber(json_String, json_Index) Else Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['") End If @@ -446,7 +461,7 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon Loop End Function -Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long, Optional json_ConvertLargeNumbersToString As Boolean = True) As Variant +Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant Dim json_Char As String Dim json_Value As String @@ -465,7 +480,7 @@ Private Function json_ParseNumber(json_String As String, ByRef json_Index As Lon ' See: http://support.microsoft.com/kb/269370 ' ' Fix: Parse -> String, Convert -> String longer than 15 characters containing only numbers and decimal points -> Number - If json_ConvertLargeNumbersToString And Len(json_Value) >= 16 Then + If Not JsonConverter.JsonOptions.UseDoubleForLargeNumbers And Len(json_Value) >= 16 Then json_ParseNumber = json_Value Else ' VBA.Val does not use regional settings, so guard for comma is not needed @@ -478,7 +493,22 @@ End Function Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String ' Parse key with single or double quotes - json_ParseKey = json_ParseString(json_String, json_Index) + If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then + json_ParseKey = json_ParseString(json_String, json_Index) + ElseIf JsonConverter.JsonOptions.AllowUnquotedKeys Then + Dim json_Char As String + Do While json_Index > 0 And json_Index <= Len(json_String) + json_Char = VBA.Mid$(json_String, json_Index, 1) + If (json_Char <> " ") And (json_Char <> ":") Then + json_ParseKey = json_ParseKey & json_Char + json_Index = json_Index + 1 + Else + Exit Do + End If + Loop + Else + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''") + End If ' Check for colon and skip if present or throw if not present json_SkipSpaces json_String, json_Index @@ -510,33 +540,37 @@ Private Function json_Encode(ByVal json_Text As Variant) As String json_AscCode = json_AscCode + 65536 End If + ' From spec, ", \, and control characters must be escaped (solidus is optional) + Select Case json_AscCode - ' " -> 34 -> \" Case 34 + ' " -> 34 -> \" json_Char = "\""" - ' \ -> 92 -> \\ Case 92 + ' \ -> 92 -> \\ json_Char = "\\" - ' / -> 47 -> \/ Case 47 - json_Char = "\/" - ' backspace -> 8 -> \b + ' / -> 47 -> \/ (optional) + If JsonConverter.JsonOptions.EscapeSolidus Then + json_Char = "\/" + End If Case 8 + ' backspace -> 8 -> \b json_Char = "\b" - ' form feed -> 12 -> \f Case 12 + ' form feed -> 12 -> \f json_Char = "\f" - ' line feed -> 10 -> \n Case 10 + ' line feed -> 10 -> \n json_Char = "\n" - ' carriage return -> 13 -> \r Case 13 + ' carriage return -> 13 -> \r json_Char = "\r" - ' tab -> 9 -> \t Case 9 + ' tab -> 9 -> \t json_Char = "\t" - ' Non-ascii characters -> convert to 4-digit hex Case 0 To 31, 127 To 65535 + ' Non-ascii characters -> convert to 4-digit hex json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4) End Select diff --git a/specs/Specs.bas b/specs/Specs.bas index f14f06e..69462f6 100644 --- a/specs/Specs.bas +++ b/specs/Specs.bas @@ -103,11 +103,13 @@ Public Function Specs() As SpecSuite .Expect(JsonObject(1)).ToEqual "123456789012345678901234567890" .Expect(JsonObject(2)).ToEqual "1.123456789012345678901234567890" + JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True JsonString = "[123456789012345678901234567890]" - Set JsonObject = JsonConverter.ParseJson(JsonString, False) + Set JsonObject = JsonConverter.ParseJson(JsonString) .Expect(JsonObject).ToNotBeUndefined .Expect(JsonObject(1)).ToEqual 1.23456789012346E+29 + JsonConverter.JsonOptions.UseDoubleForLargeNumbers = False End With With Specs.It("should parse double-backslash as backslash") @@ -139,6 +141,19 @@ Public Function Specs() As SpecSuite .Expect(JsonObject("a b c")).ToEqual "d e f" End With + With Specs.It("should allow unquoted keys with option") + JsonConverter.JsonOptions.AllowUnquotedKeys = True + JsonString = "{a:""a"",b :""b""}" + Set JsonObject = JsonConverter.ParseJson(JsonString) + + .Expect(JsonObject).ToNotBeUndefined + .Expect(JsonObject.Exists("a")).ToEqual True + .Expect(JsonObject("a")).ToEqual "a" + .Expect(JsonObject.Exists("b")).ToEqual True + .Expect(JsonObject("b")).ToEqual "b" + JsonConverter.JsonOptions.AllowUnquotedKeys = False + End With + ' ============================================= ' ' ConvertTOJSON ' ============================================= ' @@ -189,8 +204,10 @@ Public Function Specs() As SpecSuite JsonString = JsonConverter.ConvertToJson(Array("123456789012345678901234567890", "1.123456789012345678901234567890", "1234567890123456F")) .Expect(JsonString).ToEqual "[123456789012345678901234567890,1.123456789012345678901234567890,""1234567890123456F""]" - JsonString = JsonConverter.ConvertToJson(Array("123456789012345678901234567890"), False) + JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True + JsonString = JsonConverter.ConvertToJson(Array("123456789012345678901234567890")) .Expect(JsonString).ToEqual "[""123456789012345678901234567890""]" + JsonConverter.JsonOptions.UseDoubleForLargeNumbers = False End With With Specs.It("should convert dates to ISO 8601") @@ -235,10 +252,22 @@ Public Function Specs() As SpecSuite With Specs.It("should json-encode strings") Dim Strings As Variant - Strings = Array("""\/" & vbCrLf & vbTab & vbBack & vbFormFeed, ChrW(128) & ChrW(32767), "#$%&{|}~") + Strings = Array("""\" & vbCrLf & vbTab & vbBack & vbFormFeed, ChrW(128) & ChrW(32767), "#$%&{|}~") + + JsonString = JsonConverter.ConvertToJson(Strings) + .Expect(JsonString).ToEqual "[""\""\\\r\n\t\b\f"",""\u0080\u7FFF"",""#$%&{|}~""]" + End With + + With Specs.It("should escape solidus with option") + Strings = Array("a/b") + + JsonString = JsonConverter.ConvertToJson(Strings) + .Expect(JsonString).ToEqual "[""a/b""]" + JsonConverter.JsonOptions.EscapeSolidus = True JsonString = JsonConverter.ConvertToJson(Strings) - .Expect(JsonString).ToEqual "[""\""\\\/\r\n\t\b\f"",""\u0080\u7FFF"",""#$%&{|}~""]" + .Expect(JsonString).ToEqual "[""a\/b""]" + JsonConverter.JsonOptions.EscapeSolidus = False End With ' ============================================= ' diff --git a/specs/VBA-JSON - Specs.xlsm b/specs/VBA-JSON - Specs.xlsm index 2652aa5..0d6b918 100644 Binary files a/specs/VBA-JSON - Specs.xlsm and b/specs/VBA-JSON - Specs.xlsm differ