Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add Options #16

Merged
merged 4 commits into from
Nov 5, 2015
Merged

Add Options #16

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
3789e5a
Add JsonOptions for general options
timhall Nov 5, 2015
806ed8a
Fixed unquoted key name
May 18, 2015
eefef23
Add AllowUnquotedKeys options
timhall Nov 5, 2015
75609cd
Add option for escaping solidus
timhall Nov 5, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
104 changes: 69 additions & 35 deletions JsonConverter.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
' ============================================= '
Expand All @@ -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

Expand All @@ -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 '['")
Expand All @@ -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
Expand Down Expand Up @@ -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) & """"
Expand Down Expand Up @@ -233,17 +250,15 @@ 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

json_BufferAppend json_buffer, "]", json_BufferPosition, json_BufferLength
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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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

Expand All @@ -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
Expand All @@ -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 "{"
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
37 changes: 33 additions & 4 deletions specs/Specs.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -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
' ============================================= '
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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

' ============================================= '
Expand Down
Binary file modified specs/VBA-JSON - Specs.xlsm
View file
Open in desktop
Binary file not shown.