ASP JSON类源码分享

鉴于大家对ASP十分关注，我们编辑小组在此为大家搜集整理了“asp JSON类源码分享”一文，供大家参考学习!

复制代码 代码如下:
<%
''============================================================
'' 文件名称 : /Cls_Json.asp
'' 文件作用 : 系统JSON类文件
'' 文件版本 : VBS JSON(JavaScript Object Notation) Version 2.0.2
'' 程序修改 : Cloud.L
'' 最后更新 : 2009-05-12
''============================================================
'' 程序核心 : JSON官方　http://www.json.org/
'' 作者博客 : Http://www.cnode.cn
''============================================================
Class Json_Cls

Public Collection
Public Count
Public QuotedVars ''是否为变量增加引号
Public Kind '' 0 = object, 1 = array

Private Sub Class_Initialize
Set Collection = Server.CreateObject(GP_ScriptingDictionary)
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

'' 设置对象类型
Public Property Let SetKind(ByVal fpKind)
Select Case LCase(fpKind)
Case "object":Kind=0
Case "array":Kind=1
End Select
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) <> "Json_Cls" Then
Err.Raise &hD, "class: class", "class object: ''" & 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
Public Function jsEncode(str)
Dim i, j, aL1, aL2, c, p

aL1 = Array(&h22, &h5C, &h2F, &h08, &h0C, &h0A, &h0D, &h09)
aL2 = Array(&h22, &h5C, &h2F, &h62, &h66, &h6E, &h72, &h74)
For i = 1 To Len(str)
p = True
c = Mid(str, i, 1)
For j = 0 To 7
If c = Chr(aL1(j)) Then
jsEncode = jsEncode & "\" & Chr(aL2(j))
p = False
Exit For
End If
Next

If p Then
Dim a
a = AscW(c)
If a > 31 And a < 127 Then
jsEncode = jsEncode & c
ElseIf a > -1 Or a < 65535 Then
jsEncode = jsEncode & "\u" & String(4 - Len(Hex(a)), "0") & Hex(a)
End If
End If
Next
End Function

'' converting
Public Function toJSON(vPair)
Select Case VarType(vPair)
Case 1 '' Null
toJSON = "null"
Case 7 '' Date
'' yaz saati problemi var
'' jsValue = "new Date(" & Round((vVal - #01/01/1970 02:00#) * 86400000) & ")"
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