mali-ui-plus 1.0.82 → 1.0.84

package/kindeditor/asp/JSON_2.0.4.asp

@@ -0,0 +1,210 @@
+<%
+'
+'	VBS JSON 2.0.3
+'	Copyright (c) 2009 Tu�rul Topuz
+'	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
+%>