diff --git a/JsonConverter.bas b/JsonConverter.bas index 876b865..edb9601 100644 --- a/JsonConverter.bas +++ b/JsonConverter.bas @@ -224,8 +224,19 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_UBound2D = -1 json_IsFirstItem2D = True json_PrettyPrint = Not IsMissing(Whitespace) + + Dim VarType As Integer + VarType = VBA.VarType(JsonValue) + + ' Hack for bug in VBA/COM/.Net + ' Even though Stack/Queue are objects, varType returns 8(string). + ' Override it to 9(Object) + + If TypeName(JsonValue) = "Stack" Or TypeName(JsonValue) = "Queue" Then + VarType = 9 + End If - Select Case VBA.VarType(JsonValue) + Select Case VarType Case VBA.vbNull ConvertToJson = "null" Case VBA.vbDate @@ -361,9 +372,20 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp End If ' Dictionary - If VBA.TypeName(JsonValue) = "Dictionary" Then + If VBA.TypeName(JsonValue) = "Dictionary" Or VBA.TypeName(JsonValue) = "Hashtable" Or VBA.TypeName(JsonValue) = "SortedList" Then + Dim dKeys As Variant + If VBA.TypeName(JsonValue) = "Hashtable" Then + Set dKeys = CreateObject("System.Collections.ArrayList") + dKeys.AddRange JsonValue.Keys + ElseIf VBA.TypeName(JsonValue) = "Dictionary" Then + dKeys = JsonValue.Keys() + ElseIf VBA.TypeName(JsonValue) = "SortedList" Then + Set dKeys = CreateObject("System.Collections.ArrayList") + dKeys.AddRange JsonValue.GetKeyList + End If + json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength - For Each json_Key In JsonValue.Keys + For Each json_Key In dKeys ' For Objects, undefined (Empty/Nothing) is not added to object json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) If json_Converted = "" Then @@ -402,7 +424,10 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength ' Collection - ElseIf VBA.TypeName(JsonValue) = "Collection" Then + ElseIf VBA.TypeName(JsonValue) = "Collection" Or VBA.TypeName(JsonValue) = "ArrayList" Or VBA.TypeName(JsonValue) = "Stack" Or TypeName(JsonValue) = "Queue" Then + If VBA.TypeName(JsonValue) = "Stack" Or TypeName(JsonValue) = "Queue" Then + JsonValue = JsonValue.ToArray + End If json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength For Each json_Value In JsonValue If json_IsFirstItem Then diff --git a/specs/Specs.bas b/specs/Specs.bas index 893f878..f5885a3 100644 --- a/specs/Specs.bas +++ b/specs/Specs.bas @@ -202,6 +202,37 @@ Public Function Specs() As SpecSuite .Expect(JsonString).ToEqual "[1,3.14,""abc"",false,[1,2,3],{""a"":1},null]" End With + With Specs.It("should convert System.Collections.* to string (BitArray not supported)") + Set JsonObject = New Collection + JsonObject.Add (CreateObject("System.Collections.ArrayList")) + JsonObject(1).Add ("1") + JsonObject(1).Add ("2") + JsonObject(1).Add ("3") + Dim obj As Object + Set obj = CreateObject("System.Collections.HashTable") + obj.Add "a", "Algeria" + obj.Add "b", "Bermuda" + JsonObject.Add obj + Set obj = CreateObject("System.Collections.SortedList") + obj.Add "z", "Z" + obj.Add "y", "Y" + obj.Add "x", "X" + JsonObject.Add obj + Set obj = CreateObject("System.Collections.Stack") + obj.Push "aa" + obj.Push "bb" + obj.Push "cc" + JsonObject.Add obj + Set obj = CreateObject("System.Collections.Queue") + obj.Enqueue "a1" + obj.Enqueue "b2" + obj.Enqueue "c3" + JsonObject.Add obj + JsonString = JsonConverter.ConvertToJson(JsonObject) + .Expect(JsonString).ToEqual "[[""1"",""2"",""3""],{""a"":""Algeria"",""b"":""Bermuda""},{""x"":""X"",""y"":""Y"",""z"":""Z""},[""cc"",""bb"",""aa""],[""a1"",""b2"",""c3""]]" + End With + + With Specs.It("should convert array to string") JsonString = JsonConverter.ConvertToJson(Array(1, 3.14, "abc", False, Array(1, 2, 3))) .Expect(JsonString).ToEqual "[1,3.14,""abc"",false,[1,2,3]]" diff --git a/specs/VBA-JSON - Specs.xlsm b/specs/VBA-JSON - Specs.xlsm index 7551d8b..5be1bdc 100644 Binary files a/specs/VBA-JSON - Specs.xlsm and b/specs/VBA-JSON - Specs.xlsm differ