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

¡¡¡¡%>