asp读取解析JSON的几种方法
2015-11-21 01:51
549 查看
方法一（使用MSScriptControl.ScriptControl）：
方法二：
<%
Dim sc4Json
Sub InitScriptControl
Set sc4Json = Server.CreateObject(“MSScriptControl.ScriptControl”)
sc4Json.Language
= “JavaScript”
sc4Json.AddCode
“var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}”
End Sub
Function getJSONObject(strJSON)
sc4Json.AddCode “var jsonObject = ” & strJSON
Set getJSONObject = sc4Json.CodeObject.jsonObject
End Function
Sub getJSArrayItem(objDest,objJSArray,index)
On Error Resume Next
sc4Json.Run “getJSArray”,objJSArray, index
Set objDest = sc4Json.CodeObject.itemTemp
If Err.number=0 Then Exit Sub
objDest = sc4Json.CodeObject.itemTemp
End Sub
Dim strTest
strTest = “{name:”"alonely”", age:24, email:[""ycplxl1314@163.com"",""ycplxl1314@gmail.com""], family:{parents:[""父亲"",""母亲""],toString:function(){return “”家庭成员”";}}}”
Dim objTest
Call InitScriptControl
Set objTest = getJSONObject(strTest)
%>
<%=objTest.name%& gt;的邮件地址是<%=sc4Json.eval_r(“jsonObject.email[0]“)%><BR>共有邮件地址& lt;%=objTest.email.length%>个<BR>
<%
Dim father
getJSArrayItem father, objTest.family.parents, 0
Response.Write father
%>
方法三（类库）：
<%
‘
‘ VBS JSON 2.0.3
‘ Copyright (c) 2009
‘ Under the MIT (MIT-LICENSE.txt) license.
‘
Const JSON_OBJECT = 0
Const JSON_ARRAY = 1
Class jsCore
Public Collection
Public Count
Public QuotedVars
Public Kind ‘ 0 = object, 1 = array
Private Sub Class_Initialize
Set Collection = CreateObject(“Scripting.Dictionary”)
QuotedVars = True
Count = 0
End Sub
Private Sub Class_Terminate
Set Collection = Nothing
End Sub
‘ counter
Private Property Get Counter
Counter = Count
Count = Count + 1
End Property
‘ – data maluplation
‘ — pair
Public Property Let Pair(p, v)
If IsNull(p) Then p = Counter
Collection(p) = v
End Property
Public Property Set Pair(p, v)
If IsNull(p) Then p = Counter
If TypeName(v) <> “jsCore” Then
Err.Raise &hD, “class: class”, “Incompatible types: ‘” & TypeName(v) & “‘”
End If
Set Collection(p) = v
End Property
Public Default Property Get Pair(p)
If IsNull(p) Then p = Count – 1
If IsObject(Collection(p)) Then
Set Pair = Collection(p)
Else
Pair = Collection(p)
End If
End Property
‘ — pair
Public Sub Clean
Collection.RemoveAll
End Sub
Public Sub Remove(vProp)
Collection.Remove vProp
End Sub
‘ data maluplation
‘ encoding
Function jsEncode(str)
Dim charmap(127), haystack()
charmap(8) = “\b”
charmap(9) = “\t”
charmap(10) = “\n”
charmap(12) = “\f”
charmap(13) = “\r”
charmap(34) = “\”"”
charmap(47) = “\/”
charmap(92) = “\\”
Dim strlen : strlen = Len(str) – 1
ReDim haystack(strlen)
Dim i, charcode
For i = 0 To strlen
haystack(i) = Mid(str, i + 1, 1)
charcode = AscW(haystack(i)) And 65535
If charcode < 127 Then
If Not IsEmpty(charmap(charcode)) Then
haystack(i) = charmap(charcode)
ElseIf charcode < 32 Then
haystack(i) = “\u” & Right(“000″ & Hex(charcode), 4)
End If
Else
haystack(i) = “\u” & Right(“000″ & Hex(charcode), 4)
End If
Next
jsEncode = Join(haystack, “”)
End Function
‘ converting
Public Function toJSON(vPair)
Select Case VarType(vPair)
Case 0 ’ Empty
toJSON = “null”
Case 1 ’ Null
toJSON = “null”
Case 7 ’ Date
‘ toJSON = “new Date(” & (vPair – CDate(25569)) * 86400000 & “)” ’ let in only utc time
toJSON = “”"” & CStr(vPair) & “”"”
Case 8 ’ String
toJSON = “”"” & jsEncode(vPair) & “”"”
Case 9 ’ Object
Dim bFI,i
bFI = True
If vPair.Kind Then toJSON = toJSON & “[" Else toJSON = toJSON & "{"
For Each i In vPair.Collection
If bFI Then bFI = False Else toJSON = toJSON & ","
If vPair.Kind Then
toJSON = toJSON & toJSON(vPair(i))
Else
If QuotedVars Then
toJSON = toJSON & """" & i & """:" & toJSON(vPair(i))
Else
toJSON = toJSON & i & ":" & toJSON(vPair(i))
End If
End If
Next
If vPair.Kind Then toJSON = toJSON & "]” Else toJSON = toJSON & “}”
Case 11
If vPair Then toJSON = “true” Else toJSON = “false”
Case 12, 8192, 8204
toJSON = RenderArray(vPair, 1, “”)
Case Else
toJSON = Replace(vPair, “,”, “.”)
End select
End Function
Function RenderArray(arr, depth, parent)
Dim first : first = LBound(arr, depth)
Dim last : last = UBound(arr, depth)
Dim index, rendered
Dim limiter : limiter = “,”
RenderArray = “["
For index = first To last
If index = last Then
limiter = ""
End If
On Error Resume Next
rendered = RenderArray(arr, depth + 1, parent & index & "," )
If Err = 9 Then
On Error GoTo 0
RenderArray = RenderArray & toJSON(Eval("arr(" & parent & index & ")")) & limiter
Else
RenderArray = RenderArray & rendered & "" & limiter
End If
Next
RenderArray = RenderArray & "]”
End Function
Public Property Get jsString
jsString = toJSON(Me)
End Property
Sub Flush
If TypeName(Response) <> “Empty” Then
Response.Write(jsString)
ElseIf WScript <> Empty Then
WScript.Echo(jsString)
End If
End Sub
Public Function Clone
Set Clone = ColClone(Me)
End Function
Private Function ColClone(core)
Dim jsc, i
Set jsc = new jsCore
jsc.Kind = core.Kind
For Each i In core.Collection
If IsObject(core(i)) Then
Set jsc(i) = ColClone(core(i))
Else
jsc(i) = core(i)
End If
Next
Set ColClone = jsc
End Function
End Class
Function jsObject
Set jsObject = new jsCore
jsObject.Kind = JSON_OBJECT
End Function
Function jsArray
Set jsArray = new jsCore
jsArray.Kind = JSON_ARRAY
End Function
Function toJSON(val)
toJSON = (new jsCore).toJSON(val)
End Function
%>
类库提供了两种js类型，object和array
使用方法如下：
Set hash = jsObject() ‘如果要输出array就写Set hash=jsArray()
hash(“error”) = 0
hash(“url”) = fileUrl
hash.Flush
Response.End
输出的就是json格式的字符串了
<%
Dim sc4Json,arr0,json
InitScriptControl
json="{""name"":""123"",""content"":[{""id"":""1""},{""id"":""2""}]}"
Set jsonobj=getJSONObject(json)
'方法一
getJSArrayItem arr0,jsonobj.content,0
response.write jsonobj.name&"<br/>"&arr0.id&"<br/>"
'方法二
response.write sc4Json.Eval("jsonObject.name")&"<br/>"
response.write sc4Json.Eval("jsonObject.content[1].id")
Sub InitScriptControl
Set sc4Json = Server.CreateObject("MSScriptControl.ScriptControl")
sc4Json.Language = "JavaScript"
sc4Json.AddCode "var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}"
End Sub
Function getJSONObject( strJSON )
sc4Json.AddCode "var jsonObject = " & strJSON
Set getJSONObject = sc4Json.CodeObject.jsonObject
End Function
Sub getJSArrayItem( objDest, objJSArray, index )
On Error Resume Next
sc4Json.Run "getJSArray",objJSArray, index
Set objDest = sc4Json.CodeObject.itemTemp
If Err.number=0 Then Exit Sub End If
objDest = sc4Json.CodeObject.itemTemp
End Sub%>方法二：
<%
Dim sc4Json
Sub InitScriptControl
Set sc4Json = Server.CreateObject(“MSScriptControl.ScriptControl”)
sc4Json.Language
= “JavaScript”
sc4Json.AddCode
“var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}”
End Sub
Function getJSONObject(strJSON)
sc4Json.AddCode “var jsonObject = ” & strJSON
Set getJSONObject = sc4Json.CodeObject.jsonObject
End Function
Sub getJSArrayItem(objDest,objJSArray,index)
On Error Resume Next
sc4Json.Run “getJSArray”,objJSArray, index
Set objDest = sc4Json.CodeObject.itemTemp
If Err.number=0 Then Exit Sub
objDest = sc4Json.CodeObject.itemTemp
End Sub
Dim strTest
strTest = “{name:”"alonely”", age:24, email:[""ycplxl1314@163.com"",""ycplxl1314@gmail.com""], family:{parents:[""父亲"",""母亲""],toString:function(){return “”家庭成员”";}}}”
Dim objTest
Call InitScriptControl
Set objTest = getJSONObject(strTest)
%>
<%=objTest.name%& gt;的邮件地址是<%=sc4Json.eval_r(“jsonObject.email[0]“)%><BR>共有邮件地址& lt;%=objTest.email.length%>个<BR>
<%
Dim father
getJSArrayItem father, objTest.family.parents, 0
Response.Write father
%>
方法三（类库）：
<%
‘
‘ VBS JSON 2.0.3
‘ Copyright (c) 2009
‘ Under the MIT (MIT-LICENSE.txt) license.
‘
Const JSON_OBJECT = 0
Const JSON_ARRAY = 1
Class jsCore
Public Collection
Public Count
Public QuotedVars
Public Kind ‘ 0 = object, 1 = array
Private Sub Class_Initialize
Set Collection = CreateObject(“Scripting.Dictionary”)
QuotedVars = True
Count = 0
End Sub
Private Sub Class_Terminate
Set Collection = Nothing
End Sub
‘ counter
Private Property Get Counter
Counter = Count
Count = Count + 1
End Property
‘ – data maluplation
‘ — pair
Public Property Let Pair(p, v)
If IsNull(p) Then p = Counter
Collection(p) = v
End Property
Public Property Set Pair(p, v)
If IsNull(p) Then p = Counter
If TypeName(v) <> “jsCore” Then
Err.Raise &hD, “class: class”, “Incompatible types: ‘” & TypeName(v) & “‘”
End If
Set Collection(p) = v
End Property
Public Default Property Get Pair(p)
If IsNull(p) Then p = Count – 1
If IsObject(Collection(p)) Then
Set Pair = Collection(p)
Else
Pair = Collection(p)
End If
End Property
‘ — pair
Public Sub Clean
Collection.RemoveAll
End Sub
Public Sub Remove(vProp)
Collection.Remove vProp
End Sub
‘ data maluplation
‘ encoding
Function jsEncode(str)
Dim charmap(127), haystack()
charmap(8) = “\b”
charmap(9) = “\t”
charmap(10) = “\n”
charmap(12) = “\f”
charmap(13) = “\r”
charmap(34) = “\”"”
charmap(47) = “\/”
charmap(92) = “\\”
Dim strlen : strlen = Len(str) – 1
ReDim haystack(strlen)
Dim i, charcode
For i = 0 To strlen
haystack(i) = Mid(str, i + 1, 1)
charcode = AscW(haystack(i)) And 65535
If charcode < 127 Then
If Not IsEmpty(charmap(charcode)) Then
haystack(i) = charmap(charcode)
ElseIf charcode < 32 Then
haystack(i) = “\u” & Right(“000″ & Hex(charcode), 4)
End If
Else
haystack(i) = “\u” & Right(“000″ & Hex(charcode), 4)
End If
Next
jsEncode = Join(haystack, “”)
End Function
‘ converting
Public Function toJSON(vPair)
Select Case VarType(vPair)
Case 0 ’ Empty
toJSON = “null”
Case 1 ’ Null
toJSON = “null”
Case 7 ’ Date
‘ toJSON = “new Date(” & (vPair – CDate(25569)) * 86400000 & “)” ’ let in only utc time
toJSON = “”"” & CStr(vPair) & “”"”
Case 8 ’ String
toJSON = “”"” & jsEncode(vPair) & “”"”
Case 9 ’ Object
Dim bFI,i
bFI = True
If vPair.Kind Then toJSON = toJSON & “[" Else toJSON = toJSON & "{"
For Each i In vPair.Collection
If bFI Then bFI = False Else toJSON = toJSON & ","
If vPair.Kind Then
toJSON = toJSON & toJSON(vPair(i))
Else
If QuotedVars Then
toJSON = toJSON & """" & i & """:" & toJSON(vPair(i))
Else
toJSON = toJSON & i & ":" & toJSON(vPair(i))
End If
End If
Next
If vPair.Kind Then toJSON = toJSON & "]” Else toJSON = toJSON & “}”
Case 11
If vPair Then toJSON = “true” Else toJSON = “false”
Case 12, 8192, 8204
toJSON = RenderArray(vPair, 1, “”)
Case Else
toJSON = Replace(vPair, “,”, “.”)
End select
End Function
Function RenderArray(arr, depth, parent)
Dim first : first = LBound(arr, depth)
Dim last : last = UBound(arr, depth)
Dim index, rendered
Dim limiter : limiter = “,”
RenderArray = “["
For index = first To last
If index = last Then
limiter = ""
End If
On Error Resume Next
rendered = RenderArray(arr, depth + 1, parent & index & "," )
If Err = 9 Then
On Error GoTo 0
RenderArray = RenderArray & toJSON(Eval("arr(" & parent & index & ")")) & limiter
Else
RenderArray = RenderArray & rendered & "" & limiter
End If
Next
RenderArray = RenderArray & "]”
End Function
Public Property Get jsString
jsString = toJSON(Me)
End Property
Sub Flush
If TypeName(Response) <> “Empty” Then
Response.Write(jsString)
ElseIf WScript <> Empty Then
WScript.Echo(jsString)
End If
End Sub
Public Function Clone
Set Clone = ColClone(Me)
End Function
Private Function ColClone(core)
Dim jsc, i
Set jsc = new jsCore
jsc.Kind = core.Kind
For Each i In core.Collection
If IsObject(core(i)) Then
Set jsc(i) = ColClone(core(i))
Else
jsc(i) = core(i)
End If
Next
Set ColClone = jsc
End Function
End Class
Function jsObject
Set jsObject = new jsCore
jsObject.Kind = JSON_OBJECT
End Function
Function jsArray
Set jsArray = new jsCore
jsArray.Kind = JSON_ARRAY
End Function
Function toJSON(val)
toJSON = (new jsCore).toJSON(val)
End Function
%>
类库提供了两种js类型，object和array
使用方法如下：
Set hash = jsObject() ‘如果要输出array就写Set hash=jsArray()
hash(“error”) = 0
hash(“url”) = fileUrl
hash.Flush
Response.End
输出的就是json格式的字符串了
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 新的Raspbian带来了性能的改进，更新了Raspberry Pi包
- msfcli 不能使用，在新版metasploit不再有效
- ASP.NET-MVC4-07-Models-in-mvc
- ASP.NET-MVC4-06-ViewData-ViewBag
- ASP.NET-MVC4-05-Views
- Asp.net MVC 中使用 Ninject 实现依赖注入
- ASP.NET MVC 项目中 一般处理程序ashx 获取Session
- ASP.NET MVC- HtmlHelper的用法
- 为什么casperjs比phantomjs好
- 让Windows Server 2008 + IIS 7+ ASP.NET 支持10万并发请求
- (一)【转】asp.net mvc生成验证码
- Aspose.Excel.dll Excel导入、导出
- Asp.Net Thread is being Aborted
- asp.net页面跳转sessionid会变
- asp.net微信开发（永久素材管理）
- asp.net 时间格式大全
- ASP.NET学习笔记[10] - asp.net报错“尝试读取或写入受保护的内存。这通常指示其他内存已损坏”的解决办法
- asp.net 动态压缩、切割图片，并做缓存处理机制
- ASP.NET 学习笔记（一）ASP.NET 概览
- asp.net MVC URL路由入门指南