Kindeditor自带的ASP语言的Json类,是洪哥见过的比较好的ASP语言下的Json类。我们都知道Json是很多Javascript特效的都使用的简单数据对象,非常轻便好用。在很多场合,比XML还要犀利!

洪哥特地把Kindeditor自带ASP的JSON类的源代码贴在此,供大家参考。也许您看到这篇文章时,此类已经不是最新的了,那你可以去Kindeditor的最新版本中找一找。

该Json类的文件名为:JSON_2.0.4.asp,源码如下:

<%

'

' VBS JSON 2.0.3

' Copyright (c) 2009

' Under the MIT (MIT-LICENSE.txt) license.

'

Const JSON_OBJECT = 0

Const JSON_ARRAY = 1

Class jsCore

 Public Collection

 Public Count

 Public QuotedVars

 Public Kind ' 0 = object, 1 = array

 Private Sub Class_Initialize

  Set Collection = CreateObject("Scripting.Dictionary")

  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

 ' - 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) <> "jsCore" Then

   Err.Raise &hD, "class: class", "Incompatible types: '" & 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

 Function jsEncode(str)

  Dim charmap(127), haystack()

  charmap(8)  = "\b"

  charmap(9)  = "\t"

  charmap(10) = "\n"

  charmap(12) = "\f"

  charmap(13) = "\r"

  charmap(34) = "\"""

  charmap(47) = "\/"

  charmap(92) = "\\"

  Dim strlen : strlen = Len(str) - 1

  ReDim haystack(strlen)

  Dim i, charcode

  For i = 0 To strlen

   haystack(i) = Mid(str, i + 1, 1)

   charcode = AscW(haystack(i)) And 65535

   If charcode < 127 Then

    If Not IsEmpty(charmap(charcode)) Then

     haystack(i) = charmap(charcode)

    ElseIf charcode < 32 Then

     haystack(i) = "\u" & Right("000" & Hex(charcode), 4)

    End If

   Else

    haystack(i) = "\u" & Right("000" & Hex(charcode), 4)

   End If

  Next

  jsEncode = Join(haystack, "")

 End Function

 ' converting

 Public Function toJSON(vPair)

  Select Case VarType(vPair)

   Case 0 ' Empty

    toJSON = "null"

   Case 1 ' Null

    toJSON = "null"

   Case 7 ' Date

    ' toJSON = "new Date(" & (vPair - CDate(25569)) * 86400000 & ")" ' let in only utc time

    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

    toJSON = RenderArray(vPair, 1, "")

   Case Else

    toJSON = Replace(vPair, ",", ".")

  End select

 End Function

 Function RenderArray(arr, depth, parent)

  Dim first : first = LBound(arr, depth)

  Dim last : last = UBound(arr, depth)

  Dim index, rendered

  Dim limiter : limiter = ","

  RenderArray = "["

  For index = first To last

   If index = last Then

    limiter = ""

   End If

   On Error Resume Next

   rendered = RenderArray(arr, depth + 1, parent & index & "," )

   If Err = 9 Then

    On Error GoTo 0

    RenderArray = RenderArray & toJSON(Eval("arr(" & parent & index & ")")) & limiter

   Else

    RenderArray = RenderArray & rendered & "" & limiter

   End If

  Next

  RenderArray = RenderArray & "]"

 End Function

 Public Property Get jsString

  jsString = toJSON(Me)

 End Property

 Sub Flush

  If TypeName(Response) <> "Empty" Then

   Response.Write(jsString)

  ElseIf WScript <> Empty Then

   WScript.Echo(jsString)

  End If

 End Sub

 Public Function Clone

  Set Clone = ColClone(Me)

 End Function

 Private Function ColClone(core)

  Dim jsc, i

  Set jsc = new jsCore

  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

End Class

Function jsObject

 Set jsObject = new jsCore

 jsObject.Kind = JSON_OBJECT

End Function

Function jsArray

 Set jsArray = new jsCore

 jsArray.Kind = JSON_ARRAY

End Function

Function toJSON(val)

 toJSON = (new jsCore).toJSON(val)

End Function

关于Kindeditor自带ASP的JSON类,本文就介绍这么多,希望对您有所帮助,谢谢!

03-14 12:22