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