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