在很久以前，我还在使用asp的时候，发现asp居然是没有处理json的库，但是因为json使用的频率是越来越高，每次后台处理这些json总是越来越麻烦，后来想了一下索性自己写了一个asp类，因为这个JSON类是我以前使用asp的时候自己设计的，但是因为我已经很久很久没使用Asp了，所以一直是没太更新。但一般的使用还是没问题的
<%
'
' 辛苦制作，请保留版权
' QQ:24722
'
Class jsCode
Public jsondb
Public Property Let show(db)
If Mid(db,1,1) = "{" Then
Set jsondb = tobj(db)
Else
jsondb = tobj(db)
End If
End Property
Public Default Property Get show
If Mid(db,1,1) = "{" Then
Set show = jsondb
Else
show = jsondb
End If
End Property
Private Function kh(db)
dim a,s,i,a1,a2,c
a = db
s = Array("","",0,0) '3 为开关，4为判断{
For i = 2 To Len(a)
If s(2) = 0 Then
If Mid(a,i,1) = ":" Then
s(2) = 1
s(0) = s(0) & "{{arr}}"
Else
s(0) = s(0) & Mid(a,i,1)
End If
Else
If Mid(a,i,1) = "{" Then
s(3) = s(3) + 1
ElseIf Mid(a,i,1) = "}" Then
s(3) = s(3) - 1
End If
If Mid(a,i,1) = "[" Then
s(3) = s(3) + 1
ElseIf Mid(a,i,1) = "]" Then
s(3) = s(3) - 1
End If
If Mid(a,i,1) = "," And s(3) <= 0 Then 'json结束标识为,
s(2) = 0
s(1) = s(1) & "{{arr}}"
Else
s(1) = s(1) & Mid(a,i,1)
End If
End If
Next
s(1) = Mid(s(1),1,Len(s(1)) - 1)
a1 = Split(Replace(s(0),"""",""),"{{arr}}")
a2 = Split(Replace(s(1),"""",""),"{{arr}}")
Set c = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(a1) - 1
c.Add a1(i), a2(i)
Next
Set kh = c
End Function
Private Function getarr(db)
Dim s,g,a,json,arr(),b,c
s = Array(0,0,0)
b = Array("[","]",0)
c = Array("""",0)
a = ""
For i = 2 To Len(db) - 1
g = Mid(db,i,1)
If (IsNumeric(g) Or g = "[" Or g = "{") And s(0) = 0 Then
a = a & g
s(0) = 1
If g = "[" Then
b(0) = "["
b(1) = "]"
b(2) = 1
s(1) = 1
ElseIf g = "{" Then
b(0) = "{"
b(1) = "}"
b(2) = 1
s(1) = 1
Else
s(1) = 0
End If
ElseIf g = """" And s(0) = 0 Then
s(1) = 2
s(0) = 1
c(0) = """"
c(1) = 1
ElseIf g = "'" And s(0) = 0 Then
s(1) = 2
s(0) = 1
c(0) = "'"
c(1) = 1
ElseIf s(0) = 1 Then
If s(1) = 0 Then '数字型
If g = "," Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
a = ""
s(0) = 0
Else
a = a & g
End If
If i = Len(db) - 1 Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
End If
ElseIf s(1) = 1 Then '对象型
If g = b(0) Then
b(2) = b(2) + 1
ElseIf g = b(1) Then
b(2) = b(2) - 1
End If
If g = "," And b(2) = 0 Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
a = ""
s(0) = 0
Else
a = a & g
End If
If i = Len(db) - 1 Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
End If
ElseIf s(1) = 2 Then '字符型
If g = c(0) Then
c(1) = c(1) - 1
ElseIf c(1) = 1 Then
a = a & g
End If
If g = "," And c(1) = 0 Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
a = ""
s(0) = 0
End If
If i = Len(db) - 1 Then
ReDim Preserve arr(s(2))
arr(s(2)) = a
s(2) = s(2) + 1
End If
End If
End If
Next
getarr = arr
End Function
Private Function getobj(db)
Dim arr(),g,c,s,k,b,i
kg = 0
s = Array(1,0,0, - 1)
k = db
g = Mid(k,2,1)
c = Mid(k,1,1)
b = 0
If c = "{" Then
b = 1
End If
If (g = "[" Or g = """" Or IsNumeric(g)) And b = 0 Then
getobj = getarr(db)
Exit Function
End If
For i = 1 To Len(db)
If kg = 0 Then
If Mid(k,i,1) = "{" Then
kg = 1
s(0) = i
s(2) = 1
End If
Else
s(2) = s(2) + 1
If Mid(k,i,1) = "{" Then
s(1) = s(1) + 1
ElseIf Mid(k,i,1) = "}" Then
If s(1) = 0 Then
s(3) = s(3) + 1
ReDim Preserve arr(s(3))
arr(s(3)) = Mid(k,s(0),s(2))
kg = 0
Else
s(1) = s(1) - 1
End If
End If
End If
Next
getobj = arr
End Function
Public Function tobj(db)
Dim arr,json(),g,i
g = Mid(db,2,1)
arr = getobj(db)
If g = "{" Then
For i = 0 To UBound(arr)
ReDim Preserve json(i)
Set json(i) = kh(arr(i))
Next
tobj = json
ElseIf Mid(db,1,1) = "{" Then
Set tobj = kh(db)
Else
For i = 0 To UBound(arr)
ReDim Preserve json(i)
json(i) = arr(i)
Next
tobj = json
End If
End Function
Public Function jsonstr(db)
Dim a,s
s = "["
For Each b In db
a = ""
For Each c In b
If c = "title" Then
a = a & """" & c & """:""" & tounicode(b(c)) & ""","
Else
a = a & """" & c & """:""" & b(c) & ""","
End If
Next
s = s & "{" & Mid(a,1,Len(a) - 1) & "},"
Next
jsonstr=Mid(s,1,Len(s) - 1) & "]"
End Function
End Class
function json(db)
dim j
set j=new jscode
j.show=db
if mid(db,1,1)="{" then
set json=j()
else
json=j()
End if
set j=nothing
'用法说明
'示例1：{user:1} 这种格式返回的是对象。调用需 set g=json(db) response.Write g("user")
'示例2：[1,"2",'3',{},[]] 这种格式返回的是数组。调用g=json(db) response.Write g(0)得到值1
'示例3：[{user:1},{user:2},{user:3}] 这种格式返回的是数组。调用g=json(db) response.Write g(0)("user")得到值为1
End function
%>