Avatar billede MrLund Nybegynder
07. januar 2011 - 17:14 Der er 6 kommentarer

ASP og JSON

Hej

Er der nogen der ligger inde med gode link, hvor jeg kan lære at læse JSON i ASP.

Jeg finder mange steder på nettet hvor man kan generere JSON med ASP, bare ikke omvendt.
Avatar billede softspot Forsker
07. januar 2011 - 18:47 #1
Hvilken (type) opgave er det helt konkret du vil have løst ved at sende en JSON-streng til serveren?

Jeg har typisk ikke haft behov for at tolke JSON-formateret data på serveren, i den indkommende strøm af data. Her modtages data typisk i de standard-objekter ASP frameworket (og andre frameworks) stiller til rådighed (dvs. Request.Form og Request.QueryString). Når man f.eks., med jQuery's .ajax-metode, sender et JSON-objekt til serveren, omdanner jQuery det til en standard name/value-blok af data (i et format som dette eksempel: name=value&name2=value2).
Avatar billede MrLund Nybegynder
07. januar 2011 - 21:05 #2
Jeg skal lave lidt forskelligt udtræk fra denne API
http://www.withings.com/da/api/bodyscale

Det kommer i JSON format, og er så usikker på hvordan jeg håndterer de data jeg får.

Primært skal jeg have trukket datoer og vægtdata ud til en liste.
Avatar billede MrLund Nybegynder
07. januar 2011 - 21:07 #3
Og her http://lund.dk/weight.asp der kan du se de data jeg modtager
Avatar billede softspot Forsker
08. januar 2011 - 01:58 #4
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...
Avatar billede softspot Forsker
08. januar 2011 - 02:05 #5
Ja, så har jeg da allerede en rettelse til funktionen getAttr:

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)
  if instr("""'",left(attr,1)) > 0 then
    getAttr = mid(attr,2,len(attr)-2)
  else
    getAttr = attr
  end if
end function
Avatar billede softspot Forsker
08. januar 2011 - 03:51 #6
Jeg har lavet en relevant performanceoptimering, så du får lige den seneste version af parseren:

<%
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 m
  if left(ltrim(s), 1) = """" then
    ' find streng afgrænset med anførselstegn
    rxSimple.Pattern = "\s*(?:"")([^""]|\\"")*(?:"")\s*(?=,|\]|\})"
  elseif left(ltrim(s), 1) = "'" then
    ' find streng afgrænset med apostrof
    rxSimple.Pattern = "\s*(?:')([^']|\\')*(?:')\s*(?=,|\]|\})"
  else
    ' find heltal, kommatal (engelsk format) eller boolske værdier
    rxSimple.Pattern = "\s*((\-|)\d+|(\-|)\d*\.\d+|true|false|\w)\s*(?=,|\]|\})"
  end if
 
  set m = rxSimple.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)
  'response.Write trim(sv) & "<br>"
end function

function getAttr(s)
  dim m, attr
 
  set m = rxAttr.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)
  if instr("""'",left(attr,1)) > 0 then
    getAttr = mid(attr,2,len(attr)-2)
  else
    getAttr = attr
  end if
  'response.Write "attr: " & attr & " --&gt; "
end function

dim rxAttr, rxSimple
set rxAttr = new RegExp
with rxAttr
  .Global = false
  .IgnoreCase = true
  .Multiline = false
  .Pattern = "^(?:\s*(""|')*)[a-z0-9\$\_]+(?:(""|')*)(?=\s*:)"
end with 

set rxSimple = new RegExp
with rxSimple
  .Global = false
  .IgnoreCase = true
  .Multiline = false
end with
%>

Det er oprettelsen af RegExp-objekterne der nu kun sker én gang.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester