Kindeditor自带ASP的JSON类

当前位置：洪哥笔记 > ASP > Kindeditor自带ASP的JSON类

关键词

Json类 ASP

摘要

本文介绍一个ASP下面的Json类，这个Json类是Kindeditor这个所见即所得的Web编辑器自带的。

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类，本文就介绍这么多，希望对您有所帮助，谢谢！