?
Solved

JSON error

Posted on 2016-09-27
4
Medium Priority
?
110 Views
Last Modified: 2016-09-27
Hi there, I am getting an error and cannot figure out where I am going wrong:

It seems that IF I put aspJSON within the IF statement of (If Not CheckCurrUptoDate.EOF Then) it errors, outside of IF, it works..?

Code:
<%
	Dim oJSON
	Set oJSON = New aspJSON

	Set oConn=Server.CreateObject("ADODB.Connection")
	oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath("core/allcore.mdb")

	Set CheckCurrUptoDate=oConn.Execute("SELECT * FROM site_curr WHERE DateDiff ( 'n', curr_update, now)  >60")
	If Not CheckCurrUptoDate.EOF Then
		Set Currencies=oConn.Execute("SELECT ticket_curr FROM tickets WHERE ticket_from>Now() AND ticket_live=TRUE AND ticket_soldout=FALSE Group By ticket_curr Order By ticket_curr")
		CurrCount=0
		Do Until Currencies.EOF
		If CurrCount=0 Then
			Curr=Currencies("ticket_curr")
		Else
			Curr=Curr&","&Currencies("ticket_curr")
		End If
		Set CheckCurr=oConn.Execute("SELECT * FROM site_curr WHERE curr_ID='"&Currencies("ticket_curr")&"'")
		If CheckCurr.EOF Then
			oConn.Execute("INSERT INTO site_curr(curr_ID) VALUES('"&Currencies("ticket_curr")&"')")
		End If
		CurrCount=CurrCount+1
		Currencies.MoveNext
			Loop

    Set oXMLHTTPClient=CreateObject("MSXML2.ServerXMLHTTP")
    ClientCurrAPI="http://apilayer.net/api/live?access_key=4f9c228b9150f1fbde0fe2f265ee8850&currencies="&Curr&"&source=USD&format=1"
    oXMLHTTPClient.Open "GET",ClientCurrAPI, False
    oXMLHTTPClient.Send
    If oXMLHTTPClient.Status=200 Then
	    GetTextFromUrlClient=oXMLHTTPClient.responseText
        oJSON.loadJSON( GetTextFromUrlClient )
        keys = oJSON.data("quotes").Keys
        values = oJSON.data("quotes").Items
        FOR i = 0 to oJSON.data("quotes").count - 1
					oConn.Execute("UPDATE site_curr SET curr_convert = " & values(i) & " WHERE curr_ID = '" & right(keys(i), 3) & "' ")
				NEXT
				oConn.Execute("UPDATE site_curr SET curr_update=#"&Now()&"#,curr_uptime=#"&Time()&"#")
    End If

'Februari 2014 - Version 1.17 by Gerrit van Kuipers
		Class aspJSON
			Public data
			Private p_JSONstring
			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, aj_XmlHttp, aj_RegExp, aj_colonfound
		
			Private Sub Class_Initialize()
				Set data = Collection()
		
			    Set aj_RegExp = new regexp
			    aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}"
			    aj_RegExp.Global = False
			    aj_RegExp.IgnoreCase = True
			    aj_RegExp.Multiline = True
			End Sub
		
			Private Sub Class_Terminate()
				Set data = Nothing
			    Set aj_RegExp = Nothing
			End Sub
		
			Public Sub loadJSON(inputsource)
				inputsource = aj_MultilineTrim(inputsource)
				If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load."
				
				select case Left(inputsource, 1)
					case "{", "["
					case else
						Set aj_XmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
						aj_XmlHttp.open "GET", inputsource, False
						aj_XmlHttp.setRequestHeader "Content-Type", "text/json"
						aj_XmlHttp.setRequestHeader "CharSet", "UTF-8"
						aj_XmlHttp.Send
						inputsource = aj_XmlHttp.responseText
						set aj_XmlHttp = Nothing
				end select
		
				p_JSONstring = CleanUpJSONstring(inputsource)
				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
						aj_colonfound = 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 And Not aj_in_string Then
											aj_currentkey = Left(aj_line, aj_i_tmp - 1)
											aj_currentvalue = Mid(aj_line, aj_i_tmp + 1)
											aj_colonfound = True
											Exit For
										End If
									Case "\"
										aj_in_escape = True
								End Select
							End If
						Next
						if aj_colonfound then
							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
					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 = 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 Sub
		
			Public Function Collection()
				set Collection = Server.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), "")
				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_s_tmp = aj_s_tmp & aj_char_tmp : 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 & aj_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()
				dim wrap_dicttype, aj_label
				JSONoutput_level = 1
				wrap_dicttype = "[]"
				For Each aj_label In data
					 If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
				Next
				JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 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 aj_IsInt(aj_label) Then aj_dicttype = "{}"
							Next
							If aj_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(aj_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 aj_IsInt(val)
				aj_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
		
			Private Function aj_MultilineTrim(TextData)
				aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1")
			End Function
		
			private function aj_Trim(val)
				aj_Trim = Trim(val)
				Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop
				Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop
				aj_Trim = Trim(aj_Trim)
			end function
		End Class
	End If
%>

Open in new window

Error:
Microsoft VBScript compilation error '800a03ea'

Syntax error

/currAPItest.asp, line 42

Class aspJSON
^

Open in new window

0
Comment
Question by:Graeme
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
4 Comments
 
LVL 53

Assisted Solution

by:Ryan Chong
Ryan Chong earned 2000 total points
ID: 41817350
i see... you need to put the Class definition outside of the If statement.
0
 
LVL 53

Accepted Solution

by:
Ryan Chong earned 2000 total points
ID: 41817351
try:
<%
	Dim oJSON
	Set oJSON = New aspJSON

	Set oConn=Server.CreateObject("ADODB.Connection")
	oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath("core/allcore.mdb")

	Set CheckCurrUptoDate=oConn.Execute("SELECT * FROM site_curr WHERE DateDiff ( 'n', curr_update, now)  >60")
	If Not CheckCurrUptoDate.EOF Then
		Set Currencies=oConn.Execute("SELECT ticket_curr FROM tickets WHERE ticket_from>Now() AND ticket_live=TRUE AND ticket_soldout=FALSE Group By ticket_curr Order By ticket_curr")
		CurrCount=0
		Do Until Currencies.EOF
		If CurrCount=0 Then
			Curr=Currencies("ticket_curr")
		Else
			Curr=Curr&","&Currencies("ticket_curr")
		End If
		Set CheckCurr=oConn.Execute("SELECT * FROM site_curr WHERE curr_ID='"&Currencies("ticket_curr")&"'")
		If CheckCurr.EOF Then
			oConn.Execute("INSERT INTO site_curr(curr_ID) VALUES('"&Currencies("ticket_curr")&"')")
		End If
		CurrCount=CurrCount+1
		Currencies.MoveNext
			Loop

    Set oXMLHTTPClient=CreateObject("MSXML2.ServerXMLHTTP")
    ClientCurrAPI="http://apilayer.net/api/live?access_key=4f9c228b9150f1fbde0fe2f265ee8850&currencies="&Curr&"&source=USD&format=1"
    oXMLHTTPClient.Open "GET",ClientCurrAPI, False
    oXMLHTTPClient.Send
    If oXMLHTTPClient.Status=200 Then
	    GetTextFromUrlClient=oXMLHTTPClient.responseText
        oJSON.loadJSON( GetTextFromUrlClient )
        keys = oJSON.data("quotes").Keys
        values = oJSON.data("quotes").Items
        FOR i = 0 to oJSON.data("quotes").count - 1
					oConn.Execute("UPDATE site_curr SET curr_convert = " & values(i) & " WHERE curr_ID = '" & right(keys(i), 3) & "' ")
				NEXT
				oConn.Execute("UPDATE site_curr SET curr_update=#"&Now()&"#,curr_uptime=#"&Time()&"#")
    End If


	End If
	
	
	'Februari 2014 - Version 1.17 by Gerrit van Kuipers
		Class aspJSON
			Public data
			Private p_JSONstring
			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, aj_XmlHttp, aj_RegExp, aj_colonfound
		
			Private Sub Class_Initialize()
				Set data = Collection()
		
			    Set aj_RegExp = new regexp
			    aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}"
			    aj_RegExp.Global = False
			    aj_RegExp.IgnoreCase = True
			    aj_RegExp.Multiline = True
			End Sub
		
			Private Sub Class_Terminate()
				Set data = Nothing
			    Set aj_RegExp = Nothing
			End Sub
		
			Public Sub loadJSON(inputsource)
				inputsource = aj_MultilineTrim(inputsource)
				If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load."
				
				select case Left(inputsource, 1)
					case "{", "["
					case else
						Set aj_XmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
						aj_XmlHttp.open "GET", inputsource, False
						aj_XmlHttp.setRequestHeader "Content-Type", "text/json"
						aj_XmlHttp.setRequestHeader "CharSet", "UTF-8"
						aj_XmlHttp.Send
						inputsource = aj_XmlHttp.responseText
						set aj_XmlHttp = Nothing
				end select
		
				p_JSONstring = CleanUpJSONstring(inputsource)
				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
						aj_colonfound = 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 And Not aj_in_string Then
											aj_currentkey = Left(aj_line, aj_i_tmp - 1)
											aj_currentvalue = Mid(aj_line, aj_i_tmp + 1)
											aj_colonfound = True
											Exit For
										End If
									Case "\"
										aj_in_escape = True
								End Select
							End If
						Next
						if aj_colonfound then
							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
					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 = 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 Sub
		
			Public Function Collection()
				set Collection = Server.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), "")
				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_s_tmp = aj_s_tmp & aj_char_tmp : 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 & aj_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()
				dim wrap_dicttype, aj_label
				JSONoutput_level = 1
				wrap_dicttype = "[]"
				For Each aj_label In data
					 If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
				Next
				JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 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 aj_IsInt(aj_label) Then aj_dicttype = "{}"
							Next
							If aj_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(aj_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 aj_IsInt(val)
				aj_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
		
			Private Function aj_MultilineTrim(TextData)
				aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1")
			End Function
		
			private function aj_Trim(val)
				aj_Trim = Trim(val)
				Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop
				Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop
				aj_Trim = Trim(aj_Trim)
			end function
		End Class
%>

Open in new window

0
 

Author Closing Comment

by:Graeme
ID: 41817352
Yep that works a treat, just didnt think of such a simple issue and yet I was testing it like that! haha cheers!
0
 
LVL 53

Expert Comment

by:Ryan Chong
ID: 41817353
no worries man, that's the learning curve we going through = )
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

We will take a look at the d3.js library for visualizations.  I will provide a walkthrough of a short bar graph example as well as introduce you to the d3.js API.  We also will explore links of other examples and further information regarding SVG's.
Nothing in an HTTP request can be trusted, including HTTP headers and form data.  A form token is a tool that can be used to guard against request forgeries (CSRF).  This article shows an improved approach to form tokens, making it more difficult to…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

718 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question