ASP JSON类源码推荐

发布时间：2023-06-20 15:14:31 所属栏目：Asp教程来源：

导读：ASP JSON类源码分享，需要的朋友可以参考下。

复制代码代码如下:

<%

'============================================================

' 文件名称 : /Cls_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 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

%>

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!