ASP JSON类源码分享

vPair Then toJSON = "true" Else toJSON = "false"
Case 12, 8192, 8204
Dim sEB
toJSON = MultiArray(vPair, 1, "", sEB)
Case Else
toJSON = Replace(vPair, ",", ".")
End select
End Function

Public Function MultiArray(aBD, iBC, sPS, ByRef sPT) '' Array BoDy, Integer BaseCount, String PoSition
Dim iDU, iDL, i '' Integer DimensionUBound, Integer DimensionLBound
On Error Resume Next
iDL = LBound(aBD, iBC)
iDU = UBound(aBD, iBC)

Dim sPB1, sPB2 '' String PointBuffer1, String PointBuffer2
If Err = 9 Then
sPB1 = sPT & sPS
For i = 1 To Len(sPB1)
If i <> 1 Then sPB2 = sPB2 & ","
sPB2 = sPB2 & Mid(sPB1, i, 1)
Next
MultiArray = MultiArray & toJSON(Eval("aBD(" & sPB2 & ")"))
Else
sPT = sPT & sPS
MultiArray = MultiArray & "["
For i = iDL To iDU
MultiArray = MultiArray & MultiArray(aBD, iBC + 1, i, sPT)
If i < iDU Then MultiArray = MultiArray & ","
Next
MultiArray = MultiArray & "]"
sPT = Left(sPT, iBC - 2)
End If
End Function

Public Property Get ToString
ToString = toJSON(Me)
End Property

Public Sub Flush
If TypeName(Response) <> "Empty" Then
Response.Write(ToString)
ElseIf WScript <> Empty Then
WScript.Echo(ToString)
End If
End Sub

Public Function Clone
Set Clone = ColClone(Me)
End Function

Private Function ColClone(core)
Dim jsc, i
Set jsc = New Json_Cls
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

Public Function QueryToJSON(dbc, sql)
Dim rs, jsa,col
Set rs = dbc.Execute(sql)
Set jsa = New Json_Cls
jsa.SetKind="array"
While Not (rs.EOF Or rs.BOF)
Set jsa(Null) = New Json_Cls
jsa(Null).SetKind="object"
For Each col In rs.Fields
jsa(Null)(col.Name) = col.Value
Next
rs.MoveNext
Wend
Set QueryToJSON = jsa
End Function

End Class
%>