Gemeinsame Nutzung des Quellcodes der ASP-JSON-Klasse, Freunde in Not können darauf verweisen. Kopieren Sie den Codecode wie folgt:
<%
'============================================== = ===========
'Dateiname: /Cls_Json.asp
'Dateirolle: System-JSON-Klassendatei
' Dateiversion: VBS JSON (JavaScript Object Notation) Version 2.0.2
'Programmänderung: Cloud.L
' Letzte Aktualisierung: 12.05.2009
'============================================== = ===========
'Programmkern: JSON offiziell http://www.json.org/
' Blog des Autors: http://www.cnode.cn
'============================================== = ===========
Klasse Json_Cls
Öffentliche Sammlung
Öffentliche Zählung
Public QuotedVars 'Ob Anführungszeichen zu Variablen hinzugefügt werden sollen
Öffentliche Art ' 0 = Objekt, 1 = Array
Private Sub Class_Initialize
Set Collection = Server.CreateObject(GP_ScriptingDictionary)
QuotedVars = True
Anzahl = 0
Sub beenden
Private Unterklasse_Terminate
Sammlung = Nichts festlegen
Sub beenden
' Schalter
Privateigentum erhalten Zähler
Zähler=Anzahl
Anzahl = Anzahl + 1
End-Eigenschaft
'Objekttyp festlegen
Öffentliche Eigenschaft Let SetKind(ByVal fpKind)
Fall auswählen LCase(fpKind)
Fallobjekt:Kind=0
Fallarray:Art=1
Endauswahl
End-Eigenschaft
'-Datenfehler
' -- Paar
Öffentliches Eigentum Let Pair(p, v)
Wenn IsNull(p), dann ist p = Zähler
Sammlung(p) = v
End-Eigenschaft
Öffentliches Eigenschaftssatzpaar (p, v)
Wenn IsNull(p), dann ist p = Zähler
Wenn TypeName(v) <> Json_Cls, dann
Err.Raise &hD, Klasse: Klasse, Klassenobjekt: ' & TypeName(v) & '
Ende wenn
Setze Collection(p) = v
End-Eigenschaft
Öffentliche Standardeigenschaft Get Pair(p)
Wenn IsNull(p), dann ist p = Anzahl - 1
Wenn IsObject(Collection(p)) Dann
Paar = Sammlung(p) festlegen
Anders
Paar = Sammlung(p)
Ende wenn
End-Eigenschaft
' -- Paar
Öffentliche Subreinigung
Collection.RemoveAll
Sub beenden
Öffentliches Sub-Entfernen (vProp)
Collection.Remove vProp
Sub beenden
'Datenfehler
'Codierung
Öffentliche Funktion 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)
Für i = 1 Zu Len(str)
p=Wahr
c = Mid(str, i, 1)
Für j = 0 bis 7
Wenn c = Chr(aL1(j)) Dann
jsEncode = jsEncode & / & Chr(aL2(j))
p = Falsch
Ausgang für
Ende wenn
Nächste
Wenn p Dann
Dim a
a = AscW(c)
Wenn a > 31 und a < 127, dann
jsEncode = jsEncode & c
ElseIf a > -1 Oder a < 65535 Dann
jsEncode = jsEncode & /u & String(4 - Len(Hex(a)), 0) & Hex(a)
Ende wenn
Ende wenn
Nächste
Funktion beenden
' Konvertieren
Öffentliche Funktion toJSON(vPair)
Fall-VarType(vPair) auswählen
Fall 1' Null
toJSON = null
Fall 7 „Datum
'yaz saati problemi var
' jsValue = new Date( & Round((vVal - #01/01/1970 02:00#) * 86400000) & )
toJSON = & CStr(vPair) &
Fall 8' String
toJSON = & jsEncode(vPair) &
Fall 9 „Objekt
Dim bFI, ich
bFI=Wahr
Wenn vPair.Kind, dann toJSON = toJSON & [ Else toJSON = toJSON & {
Für jedes i in vPair.Collection
Wenn bFI, dann bFI = False, sonst toJSON = toJSON &,
Wenn vPair.Kind, dann
toJSON = toJSON & toJSON(vPair(i))
Anders
Wenn QuotedVars Dann
toJSON = toJSON & & i & : & toJSON(vPair(i))
Anders
toJSON = toJSON & i & : & toJSON(vPair(i))
Ende wenn
Ende wenn
Nächste
Wenn vPair.Kind, dann toJSON = toJSON & ] Else toJSON = toJSON & }
Fall 11
Wenn vPair, dann toJSON = true, sonst toJSON = false
Fall 12, 8192, 8204
Dimmen Sie sEB
toJSON = MultiArray(vPair, 1, , sEB)
Fall anders
toJSON = Ersetzen(vPair, ,, .)
Auswahl beenden
Funktion beenden
Öffentliche Funktion MultiArray(aBD, iBC, sPS, ByRef sPT) ' Array BoDy, Integer BaseCount, String PoSition
Dim iDU, iDL, i ' Integer DimensionUBound, Integer DimensionLBound
Bei Fehler Weiter fortsetzen
iDL = LBound(aBD, iBC)
iDU = UBound(aBD, iBC)
Dim sPB1, sPB2 ' String PointBuffer1, String PointBuffer2
Wenn Err = 9, dann
sPB1 = sPT & sPS
Für i = 1 To Len(sPB1)
Wenn i <> 1, dann sPB2 = sPB2 & ,
sPB2 = sPB2 & Mid(sPB1, i, 1)
Nächste
MultiArray = MultiArray & toJSON(Eval(aBD( & sPB2 & )))
Anders
sPT = sPT & sPS
MultiArray = MultiArray & [
Für i = iDL zu iDU
MultiArray = MultiArray & MultiArray(aBD, iBC + 1, i, sPT)
Wenn i < iDU, dann MultiArray = MultiArray & ,
Nächste
MultiArray = MultiArray & ]
sPT = Left(sPT, iBC - 2)
Ende wenn
Funktion beenden
Öffentliche Eigenschaft GetToString
ToString = toJSON(Me)
End-Eigenschaft
Öffentliche Unterspülung
Wenn TypeName(Response) <> Leer ist, dann
Response.Write(ToString)
ElseIf WScript <> Empty Then
WScript.Echo(ToString)
Ende wenn
Sub beenden
Öffentlicher Funktionsklon
Clone = ColClone(Me) festlegen
Funktion beenden
Private Funktion ColClone(core)
Dim jsc,i
Setze jsc = New Json_Cls
jsc.Kind = core.Kind
Für jedes i in core.Collection
Wenn IsObject(core(i)) Dann
Setze jsc(i) = ColClone(core(i))
Anders
jsc(i) = core(i)
Ende wenn
Nächste
Setzen Sie ColClone = jsc
Funktion beenden
Öffentliche Funktion QueryToJSON(dbc, sql)
Dim rs, jsa,col
Setze rs = dbc.Execute(sql)
Setze jsa = New Json_Cls
jsa.SetKind=Array
Während nicht (rs.EOF oder rs.BOF)
Setze jsa(Null) = New Json_Cls
jsa(Null).SetKind=Objekt
Für jede Spalte in rs.Fields
jsa(Null)(col.Name) = col.Value
Nächste
rs.MoveNext
Wend
Legen Sie QueryToJSON = jsa fest
Funktion beenden
Unterricht beenden
%>