Solved

JSON error

Posted on 2016-09-27
4
76 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
  • 3
4 Comments
 
LVL 51

Assisted Solution

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

Accepted Solution

by:
Ryan Chong earned 500 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 51

Expert Comment

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

Featured Post

Space-Age Communications Transitions to DevOps

ViaSat, a global provider of satellite and wireless communications, securely connects businesses, governments, and organizations to the Internet. Learn how ViaSat’s Network Solutions Engineer, drove the transition from a traditional network support to a DevOps-centric model.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Save ms data to server side. 19 59
Hide Table in merge 3 41
ASP and Extracting XML 7 30
PHP $_POST vs asp request 4 28
Hello, all! I just recently started using Microsoft's IIS 7.5 within Windows 7, as I just downloaded and installed the 90 day trial of Windows 7. (Got to love Microsoft for allowing 90 days) The main reason for downloading and testing Windows 7 is t…
I was asked about the differences between classic ASP and ASP.NET, so let me put them down here, for reference: Let's make the introductions... Classic ASP was launched by Microsoft in 1998 and dynamically generate web pages upon user interact…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…

726 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