Prøv nedenstående kode. Jeg har selv flikket den sammen, så det kan godt være den ikke spiller helt, men umiddelbart synes jeg den kan klare de JSON-formaterede strenge jeg har smidt efter den.
<%
function getVBObject(s)
dim d
set d = Server.CreateObject("Scripting.Dictionary")
s = ltrim(replace(s, vbCrLf, ""))
do
' skip over { eller komma
s = ltrim(mid(s, 2))
if left(s, 1) <> "}" then
attr = getAttr(s)
d.add attr, getValue(s)
s = ltrim(s)
end if
loop until left(s, 1) = "}"
' skip over }
s = ltrim(mid(s, 2))
set getVBObject = d
end function
function getVBArray(s)
dim arr
arr = array()
s = ltrim(s)
do
' skip over [ eller komma
s = ltrim(mid(s, 2))
if left(s, 1) <> "]" then
redim preserve arr(ubound(arr) + 1)
if left(s, 1) = "{" then
set arr(ubound(arr)) = getValue(s)
else
arr(ubound(arr)) = getValue(s)
end if
s = ltrim(s)
end if
loop until left(s, 1) = "]"
' skip over ]
s = ltrim(mid(s, 2))
getVBArray = arr
end function
function getValue(s)
dim arr
s = ltrim(s)
' skip over kolon
if instr(",:", left(s,1)) > 0 then s = ltrim(mid(s, 2))
select case left(s, 1)
case "{" ' parse objekt
set getValue = getVBObject(s)
case "[" ' parse array
getValue = getVBArray(s)
case else ' find værdi
getValue = getSimpleValue(s)
end select
end function
' returner data frem til næste komma, } eller ]
' tag højde for strengværdier og escapede strengafgrænsere i strenge
function getSimpleValue(s)
dim rx,m
set rx = new RegExp
rx.Global = false
rx.IgnoreCase = true
rx.Multiline = false
if left(ltrim(s), 1) = """" then
' find streng afgrænset med anførselstegn
rx.Pattern = "\s*(?:"")([^""]|\\"")*(?:"")\s*(?=,|\]|\})"
elseif left(ltrim(s), 1) = "'" then
' find streng afgrænset med apostrof
rx.Pattern = "\s*(?:')([^']|\\')*(?:')\s*(?=,|\]|\})"
else
' find heltal, kommatal (engelsk format) eller boolske værdier
rx.Pattern = "\s*(\d+|\d*\.\d+|true|false|\w)\s*(?=,|\]|\})"
end if
set m = rx.Execute(s)
if m.count = 0 then
sv = ""
else
sv = m(0).Value
end if
s = ltrim(mid(s, len(sv) + 1))
getSimpleValue = trim(sv)
end function
function getAttr(s)
dim rx, m, attr
set rx = new RegExp
rx.Global = false
rx.IgnoreCase = true
rx.Multiline = false
rx.Pattern = "^(?:\s*(""|')*)[a-z0-9\$\_]+(?:(""|')*)(?=\s*:)"
set m = rx.Execute(s)
if m.count = 0 then
attr = ""
else
attr = m(0).Value
end if
s = ltrim(mid(s, len(attr) + 1))
attr = trim(attr)
getAttr = mid(attr,2,len(attr)-2)
end function
%>
Du kan evt. lægge den i en separat ASP-fil (som hedder JSON2VBObjects.asp) og så prøve at teste med nedenstående kodestump:
<!-- #include file="JSON2VBObjects.asp" -->
<%
' ======================================================================
' Simple tests til diverse funktioner
' ======================================================================
response.write "getAttr: " & getAttr("""test"":100") & "<br>"
response.write "getAttr: " & getAttr("'test':100") & "<br>"
response.write "getAttr: " & getAttr("test:100") & "<br>"
response.write "getSimpleValue: " & getSimpleValue("123,") & "<br>"
response.write "getSimpleValue: " & getSimpleValue("'tester en streng \' med escaped apostrof'}") & "<br>"
response.write "getSimpleValue: " & getSimpleValue("""tester en streng \"" med escaped anførselstegn""]") & "<br>"
dim s1
s1 = "'tester',""hvad"":1234}"
response.write "getSimpleValue: " & getSimpleValue(s1) & "<br>"
response.Write "s1 indeholder nu: " & s1 & "<br>"
dim o1, obj
o1 = "{" & vbCrLf & _
"""test"" : 123 , " & vbCrLf & _
"""obj"": {" & vbCrLf & _
"""attr"": ""tester en streng"" " & vbCrLf & _
"}," & vbCrLf & _
"""obj2"": {" & vbCrLf & _
"""attr1"": ""tester en anden streng"", " & vbCrLf & _
"""attr2"": true, " & vbCrLf & _
"""attr3"": false, " & vbCrLf & _
"""attr4"": 123.54, " & vbCrLf & _
"""attr4a"": .54, " & vbCrLf & _
"""attr5"": 0, " & vbCrLf & _
"""obj"": { " & vbCrLf & _
"""attr"": [{""v1"":10,""v2"":12},{""v1"":54,""v2"":0}], " & vbCrLf & _
"""attr1"": false, " & vbCrLf & _
"""attr2"": 'kjhsdfk shdfk hkshf \'kjhgjkhdg\'' " & vbCrLf & _
"}," & vbCrLf & _
"""attr6"": """" " & vbCrLf & _
"}," & vbCrLf & _
"""arr"" : [1,2,3]" & vbCrLf & _
"}"
set obj = getVBObject(o1)
response.Write "Egenskaber i objektet: " & obj.count & "<br>"
call visStruktur(obj)
response.Write "obj.obj.attr: " & obj("obj")("attr") & "<br>"
response.Write "obj.obj2.attr4: " & obj("obj2")("attr4") & "<br>"
response.Write "obj.obj2.obj.attr(0).v1: " & obj("obj2")("obj")("attr")(0)("v1") & "<br>"
response.Write "obj.arr(0): " & obj("arr")(0) & "<br>"
response.Write "obj.arr(1): " & obj("arr")(1) & "<br>"
sub visStruktur(obj)
dim i
response.Write "<ul>"
for each i in obj.keys
response.Write "<li>"
response.Write i & " = "
if isobject(obj(i)) then
response.Write "OBJECT"
call visStruktur(obj(i))
elseif isarray(obj(i)) then
response.Write "ARRAY"
call visArray(obj(i))
else
response.Write obj(i)
end if
response.Write "</li>"
next
response.Write "</ul>"
end sub
sub visArray(a)
dim v
response.Write "<ul>"
for each v in a
response.Write "<li>"
if isobject(v) then
response.Write "OBJECT"
call visStruktur(v)
elseif isarray(v) then
response.Write "ARRAY"
call visArray(v)
else
response.Write v
end if
response.Write "</li>"
next
response.Write "</ul>"
end sub
%>
Der gøres brug af rekursion til at parse JSON og Dictionary-objekter til at opbevare de enkelte objekters egenskaber og værdierne til disse.
Som du kan se er det muligt at traversere objekterne (visStruktur og visArray), samt tilgå de enkelte objekters egenskaber vha. indeksering ned i objekterne...
Lad mig høre om der opstår problemer eller spørgsmål til brugen.
NB: Der er ingen tvivl om, at koden kunne laves pænere og mere effektiv, men i første omgang var mit mål, at lave en løsning du kunne bruge, hvis du ikke kunne finde andet. Optimering på være en øvelse til fremtiden...
Ny bruger
Nybegynder
Opret
Preview
