Subversion Repositories DevTools

'June 2013 - Version 1.1 by Gerrit van Kuipers
Class aspJSON
        Public data
        Private p_JSONstring
        Private p_datatype
        private aj_in_string, aj_in_escape, aj_i_tmp, aj_char_tmp, aj_s_tmp, aj_line_tmp, aj_line, aj_lines, aj_currentlevel, aj_currentkey, aj_currentvalue, aj_newlabel

        Private Sub Class_Initialize()
                Set data = Collection()
                p_datatype = "{}"
        End Sub

        Private Sub Class_Terminate()
                Set data = Nothing
        End Sub

        Public Function loadJSON(strInput)
                if len(trim(strInput)) = 0 then Err.Raise 1, "loadJSON Error", "No data to load."
                p_JSONstring = CleanUpJSONstring(Trim(strInput))
                aj_lines = Split(p_JSONstring, Chr(13) & Chr(10))

                Dim level(99)
                aj_currentlevel = 1
                Set level(aj_currentlevel) = data
                For Each aj_line In aj_lines
                        aj_currentkey = ""
                        aj_currentvalue = ""
                        If Instr(aj_line, ":") > 0 Then
                                aj_in_string = False
                                aj_in_escape = False
                                For aj_i_tmp = 1 To Len(aj_line)
                                        If aj_in_escape Then
                                                aj_in_escape = False
                                        Else
                                                Select Case Mid(aj_line, aj_i_tmp, 1)
                                                        Case """"
                                                                aj_in_string = Not aj_in_string
                                                        Case ":"
                                                                If Not aj_in_escape Then
                                                                        aj_currentkey = Left(aj_line, aj_i_tmp - 1)
                                                                        aj_currentvalue = Mid(aj_line, aj_i_tmp + 1)
                                                                        Exit For
                                                                End If
                                                        Case "\"
                                                                aj_in_escape = True
                                                End Select
                                        End If
                                Next
                                aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey), """")
                                If Not level(aj_currentlevel).exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey, ""
                        End If
                        If right(aj_line,1) = "{" Or right(aj_line,1) = "[" Then
                                If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
                                Set level(aj_currentlevel).Item(aj_currentkey) = Collection()
                                Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey)
                                aj_currentlevel = aj_currentlevel + 1
                                aj_currentkey = ""
                        ElseIf right(aj_line,1) = "}" Or right(aj_line,1) = "]" or right(aj_line,2) = "}," Or right(aj_line,2) = "]," Then
                                aj_currentlevel = aj_currentlevel - 1
                        ElseIf Len(Trim(aj_line)) > 0 Then
                                if Len(aj_currentvalue) = 0 Then aj_currentvalue = getJSONValue(aj_line)
                                aj_currentvalue = getJSONValue(aj_currentvalue)

                                If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
                                level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue
                        End If
                Next
        End Function

        Public Function Collection()
                set Collection = CreateObject("Scripting.Dictionary")
        End Function

        Public Function AddToCollection(dictobj)
                if TypeName(dictobj) <> "Dictionary" then Err.Raise 1, "AddToCollection Error", "Not a collection."
                aj_newlabel = dictobj.Count
                dictobj.Add aj_newlabel, Collection()
                set AddToCollection = dictobj.item(aj_newlabel)
        end function

        Private Function CleanUpJSONstring(aj_originalstring)
                aj_originalstring = Replace(aj_originalstring, Chr(13) & Chr(10), "")
                p_datatype = Left(aj_originalstring, 1) & Right(aj_originalstring, 1)
                aj_originalstring = Mid(aj_originalstring, 2, Len(aj_originalstring) - 2)
                aj_in_string = False : aj_in_escape = False : aj_s_tmp = ""
                For aj_i_tmp = 1 To Len(aj_originalstring)
                        aj_char_tmp = Mid(aj_originalstring, aj_i_tmp, 1)
                        If aj_in_escape Then
                                aj_in_escape = False
                                aj_s_tmp = aj_s_tmp & aj_char_tmp
                        Else
                                Select Case aj_char_tmp
                                        Case "\" : aj_in_escape = True
                                        Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string
                                        Case "{", "["
                                                aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
                                        Case "}", "]"
                                                aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) & aj_char_tmp
                                        Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
                                        Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp
                                End Select
                        End If
                Next

                CleanUpJSONstring = ""
                aj_s_tmp = split(aj_s_tmp, Chr(13) & Chr(10))
                For Each aj_line_tmp In aj_s_tmp
                        aj_line_tmp = replace(replace(aj_line_tmp, chr(10), ""), chr(13), "")
                        CleanUpJSONstring = CleanUpJSONstring & Trim(aj_line_tmp) & Chr(13) & Chr(10)
                Next
        End Function

        Private Function getJSONValue(ByVal val)
                val = Trim(val)
                If Left(val,1) = ":"  Then val = Mid(val, 2)
                If Right(val,1) = "," Then val = Left(val, Len(val) - 1)
                val = Trim(val)

                Select Case val
                        Case "true"  : getJSONValue = True
                        Case "false" : getJSONValue = False
                        Case "null" : getJSONValue = Null
                        Case Else
                                If (Instr(val, """") = 0) Then
                                        If IsNumeric(val) Then
                                                getJSONValue = CDbl(val)
                                        Else
                                                getJSONValue = val
                                        End If
                                Else
                                        If Left(val,1) = """" Then val = Mid(val, 2)
                                        If Right(val,1) = """" Then val = Left(val, Len(val) - 1)
                                        getJSONValue = aj_JSONDecode(Trim(val))
                                End If
                End Select
        End Function

        Private JSONoutput_level
        Public Function JSONoutput()
                JSONoutput_level = 1
                JSONoutput = Left(p_datatype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(p_datatype, 1)
        End Function

        Private Function GetDict(objDict)
                dim aj_item, aj_keyvals, aj_label, aj_dicttype
                For Each aj_item In objDict
                        Select Case TypeName(objDict.Item(aj_item))
                                Case "Dictionary"
                                        GetDict = GetDict & Space(JSONoutput_level * 4)
                                        
                                        aj_dicttype = "[]"
                                        For Each aj_label In objDict.Item(aj_item).Keys
                                                 If Not IsInt(aj_label) Then aj_dicttype = "{}"
                                        Next

                                        If IsInt(aj_item) Then
                                                GetDict = GetDict & Left(aj_dicttype,1) & Chr(13) & Chr(10)
                                        Else
                                                GetDict = GetDict & """" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10)
                                        End If
                                        JSONoutput_level = JSONoutput_level + 1
                                        
                                        aj_keyvals = objDict.Keys
                                        GetDict = GetDict & GetSubDict(objDict.Item(aj_item)) & Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)
                                Case Else
                                        aj_keyvals =  objDict.Keys
                                        GetDict = GetDict & Space(JSONoutput_level * 4) & aj_InlineIf(IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)
                        End Select
                Next
        End Function

        Private Function IsInt(val)
                IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long")
        End Function

        Private Function GetSubDict(objSubDict)
                GetSubDict = GetDict(objSubDict)
                JSONoutput_level= JSONoutput_level -1
        End Function

        Private Function WriteValue(ByVal val)
                Select Case TypeName(val)
                        Case "Double", "Integer", "Long": WriteValue = val
                        Case "Null"                                             : WriteValue = "null"
                        Case "Boolean"                                  : WriteValue = aj_InlineIf(val, "true", "false")
                        Case Else                                               : WriteValue = """" & aj_JSONEncode(val) & """"
                End Select
        End Function

        Private Function aj_JSONEncode(ByVal val)
                val = Replace(val, "\", "\\")
                val = Replace(val, """", "\""")
                'val = Replace(val, "/", "\/")
                val = Replace(val, Chr(8), "\b")
                val = Replace(val, Chr(12), "\f")
                val = Replace(val, Chr(10), "\n")
                val = Replace(val, Chr(13), "\r")
                val = Replace(val, Chr(9), "\t")
                aj_JSONEncode = Trim(val)
        End Function

        Private Function aj_JSONDecode(ByVal val)
                val = Replace(val, "\""", """")
                val = Replace(val, "\\", "\")
                val = Replace(val, "\/", "/")
                val = Replace(val, "\b", Chr(8))
                val = Replace(val, "\f", Chr(12))
                val = Replace(val, "\n", Chr(10))
                val = Replace(val, "\r", Chr(13))
                val = Replace(val, "\t", Chr(9))
                aj_JSONDecode = Trim(val)
        End Function

        Private Function aj_InlineIf(condition, returntrue, returnfalse)
                If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse
        End Function

        Private Function aj_Strip(ByVal val, stripper)
                If Left(val, 1) = stripper Then val = Mid(val, 2)
                If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1)
                aj_Strip = val
        End Function
End Class