ASP JSON类源码
发布时间:2011-04-30 16:38:00
<%'============================================================' 文件名称 : /Cls_Json.asp' 文件作用 : 系统JSON类文件' 文件版本 : VBS JSON(JavaScript Object Notation) Version 2.0.2' 程序修改 : Cloud.L' 最后更新 : 2009-05-12'============================================================' 程序核心 : JSON官方 http://www.json.org/' 作者博客 : Http://www.cnode.cn'============================================================Class Json_ClsPublic CollectionPublic CountPublic QuotedVars '是否为变量增加引号Public Kind ' 0 = object, 1 = arrayPrivate Sub Class_InitializeSet Collection = Server.CreateObject(GP_ScriptingDictionary)QuotedVars = TrueCount = 0End SubPrivate Sub Class_TerminateSet Collection = NothingEnd Sub' counterPrivate Property Get Counter Counter = CountCount = Count + 1End Property' 设置对象类型Public Property Let SetKind(ByVal fpKind)Select Case LCase(fpKind)Case "object":Kind=0Case "array":Kind=1End SelectEnd Property' - data maluplation' -- pairPublic Property Let Pair(p, v)If IsNull(p) Then p = CounterCollection(p) = vEnd PropertyPublic Property Set Pair(p, v)If IsNull(p) Then p = CounterIf TypeName(v) <> "Json_Cls" ThenErr.Raise &hD, "class: class", "class object: '" & TypeName(v) & "'"End IfSet Collection(p) = vEnd PropertyPublic Default Property Get Pair(p)If IsNull(p) Then p = Count - 1If IsObject(Collection(p)) ThenSet Pair = Collection(p)ElsePair = Collection(p)End IfEnd Property' -- pairPublic Sub CleanCollection.RemoveAllEnd SubPublic Sub Remove(vProp)Collection.Remove vPropEnd Sub' data maluplation' encodingPublic Function jsEncode(str)Dim i, j, aL1, aL2, c, paL1 = Array(&h22, &h5C, &h2F, &h08, &h0C, &h0A, &h0D, &h09)aL2 = Array(&h22, &h5C, &h2F, &h62, &h66, &h6E, &h72, &h74)For i = 1 To Len(str)p = Truec = Mid(str, i, 1)For j = 0 To 7If c = Chr(aL1(j)) ThenjsEncode = jsEncode & "\" & Chr(aL2(j))p = FalseExit ForEnd IfNextIf p Then Dim aa = AscW(c)If a > 31 And a < 127 ThenjsEncode = jsEncode & cElseIf a > -1 Or a < 65535 ThenjsEncode = jsEncode & "\u" & String(4 - Len(Hex(a)), "0") & Hex(a)End If End IfNextEnd Function' convertingPublic Function toJSON(vPair)Select Case VarType(vPair)Case 1' NulltoJSON = "null"Case 7' Date' yaz saati problemi var' jsValue = "new Date(" & Round((vVal - #01/01/1970 02:00#) * 86400000) & ")"toJSON = """" & CStr(vPair) & """"Case 8' StringtoJSON = """" & jsEncode(vPair) & """"Case 9' ObjectDim bFI,i bFI = TrueIf vPair.Kind Then toJSON = toJSON & "[" Else toJSON = toJSON & "{"For Each i In vPair.CollectionIf bFI Then bFI = False Else toJSON = toJSON & ","If vPair.Kind Then toJSON = toJSON & toJSON(vPair(i))ElseIf QuotedVars ThentoJSON = toJSON & """" & i & """:" & toJSON(vPair(i))ElsetoJSON = toJSON & i & ":" & toJSON(vPair(i))End IfEnd IfNextIf vPair.Kind Then toJSON = toJSON & "]" Else toJSON = toJSON & "}"Case 11If vPair Then toJSON = "true" Else toJSON = "false"Case 12, 8192, 8204Dim sEBtoJSON = MultiArray(vPair, 1, "", sEB)Case ElsetoJSON = Replace(vPair, ",", ".")End selectEnd FunctionPublic Function MultiArray(aBD, iBC, sPS, ByRef sPT)' Array BoDy, Integer BaseCount, String PoSitionDim iDU, iDL, i' Integer DimensionUBound, Integer DimensionLBoundOn Error Resume NextiDL = LBound(aBD, iBC)iDU = UBound(aBD, iBC)Dim sPB1, sPB2' String PointBuffer1, String PointBuffer2If Err = 9 ThensPB1 = sPT & sPSFor i = 1 To Len(sPB1)If i <> 1 Then sPB2 = sPB2 & ","sPB2 = sPB2 & Mid(sPB1, i, 1)NextMultiArray = MultiArray & toJSON(Eval("aBD(" & sPB2 & ")"))ElsesPT = sPT & sPSMultiArray = MultiArray & "["For i = iDL To iDUMultiArray = MultiArray & MultiArray(aBD, iBC + 1, i, sPT)If i < iDU Then MultiArray = MultiArray & ","NextMultiArray = MultiArray & "]"sPT = Left(sPT, iBC - 2)End IfEnd FunctionPublic Property Get ToStringToString = toJSON(Me)End PropertyPublic Sub FlushIf TypeName(Response) <> "Empty" Then Response.Write(ToString)ElseIf WScript <> Empty Then WScript.Echo(ToString)End IfEnd SubPublic Function CloneSet Clone = ColClone(Me)End FunctionPrivate Function ColClone(core)Dim jsc, iSet jsc = New Json_Clsjsc.Kind = core.KindFor Each i In core.CollectionIf IsObject(core(i)) ThenSet jsc(i) = ColClone(core(i))Elsejsc(i) = core(i)End IfNextSet ColClone = jscEnd FunctionPublic Function QueryToJSON(dbc, sql) Dim rs, jsa,col Set rs = dbc.Execute(sql) Set jsa = New Json_Cls jsa.SetKind="array" While Not (rs.EOF Or rs.BOF) Set jsa(Null) = New Json_Cls jsa(Null).SetKind="object" For Each col In rs.Fields jsa(Null)(col.Name) = col.Value Next rs.MoveNext Wend Set QueryToJSON = jsaEnd FunctionEnd Class%>
猜你喜欢
- 问:怎样解决mysql连接过多的错误?答:系统不能连接数据库,关键要看两个数据:1、数据库系统允许的最大可连接数max_connection
- 代码如下:function checkip(checkstring)'用正则判断IP是否合法 dim re1 set re1=new
- 创建用户定义函数,它是返回值的已保存的 Transact-SQL 例程。用户定义函数不能用于执行一组修改全局数据库状态的操作。与系统函数一样
- asp判断网址格式是否合法代码 具体实现办法见下列代码:<% function checki
- 我为一大型网站做了一个论坛,也顺利通过了测试。由于是第一次做这方面的数据库,我不知道比其它网站上数据库差距有多大,是不是够优化。能推荐或介绍
- 有三种主要的错误类型: 1.编译错误: 这种错误出现一般都是代码的语法问题。因为编译错误而导致辞ASP停止运行。 2.运行错误: 这个错误是
- 最近因工作需要,要在静态页面上实现分页,想了下,决定用AJAX来实现,所以就捣鼓了下面这么个东西,截图如下:更多关于分页的文章演示地址:ht
- 如何制作关联的下拉菜单?看看代码:<form name=f1 METHOD="POST">
- 密码强度是一个很普遍的功能,比较简单,主要是怎么制定这个强度规则。现在需要升级密码强度的验证,以前的验证比较简单,现在已经不能满足需求了,现
- 如何在线更改Windows2000管理者密码?changepwd.htm <html><head><title
- 分区表的概念 分区致力于解决支持极大表和索引的关键问题。它采用他们分解成较小和易于管理的称为分区的片(piece)的方法。一旦分区被定义,S
- 现在流行虚拟主机建站,我也有个网站,也算是个站长咯。当了近一年的站长,感到网站程序每次升级的时候颇为麻烦:先去官方看公告,然后下载升级包到本
- 1.1.1 摘要 Join是关系型数据库系统的重要操作之一,SQL Server中包含的常用Join:内联接、外联接和交叉联接等。如果我们想
- 了兑现我对大家的承诺,我们现在立即就将“借助数据库和ASP程序”编写出来的,可以同时适用于IIS和P
- 大家都知道,Dreamweaver是是一款专业的网页设计工具,提供了许多方便、实用的功能,使得以前许多网页效果的实现从繁琐的代码
- What's more important to your web site: pictures or text? If you h
- 假如读者已经熟悉了ASP 2.0,并正在寻找3.0版本中的实际改变的列表,那么将在下面发现这些信息。假如读者是一个ASP的初学者,可以越过本
- 原理:第一步:应用程序把查询SQL语句发给服务器端执行。我们在数据层执行SQL语句时,应用程序会连接到相应的数据库服务器,把SQL语句发送给
- “到底是什么将艺术和设计分开的?”这样一个话题听起来费解,长时间以来, 也已经被讨论过无数次。艺术家和设计师都是通过共通的知识和素养来创造视
- 有一个查询如下: 代码如下:SELECT c.CustomerId, CompanyName FROM Customers c