JSON asp(vbs)源文件

本文介绍了一个用于将 ASP 数据类型转换为 JSON 格式的实用工具类。该工具支持多种 ASP 数据结构,包括数组、记录集等,并能正确处理特殊字符以确保符合 JSON 规范。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

<%
'**********************************************************************************************
'* GAB_LIBRARY Copyright (C) 2003 - This file is part of GAB_LIBRARY       
'* For license refer to the license.txt                                       
'***********************************************************************************************

'****************************************************************************************

'' @CLASSTITLE:        JSON
'' @CREATOR:        Michal Gabrukiewicz (gabru at grafix.at), Michael Rebec
'' @CONTRIBUTORS:    - Cliff Pruitt (opensource at crayoncowboy.com)
''                    - Sylvain Lafontaine
'' @CREATEDON:        2007-04-26 12:46
'' @CDESCRIPTION:    Comes up with functionality for JSON (http://json.org) to use within ASP.
''                     Correct escaping of characters, generating JSON Grammer out of ASP datatypes and structures
'' @REQUIRES:        -
'' @OPTIONEXPLICIT:    yes
'' @VERSION:        1.4

'****************************************************************************************
class JSON

'private members
private output, innerCall

'public members
public toResponse        ''[bool] should generated results be directly written to the response? default = false

'*********************************************************************************
'* constructor
'*********************************************************************************
public sub class_initialize()
        newGeneration()
        toResponse = false
end sub

'******************************************************************************************
'' @SDESCRIPTION:    STATIC! takes a given string and makes it JSON valid
'' @DESCRIPTION:    all characters which needs to be escaped are beeing replaced by their
''                    unicode representation according to the
''                    RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627
'' @PARAM:            val [string]: value which should be escaped
'' @RETURN:            [string] JSON valid string
'' asc 函数被替换成ascw函数以便支持中文
'******************************************************************************************
public function escape(val)
dim cDoubleQuote, cRevSolidus, cSolidus
        cDoubleQuote = &h22
        cRevSolidus = &h5C
        cSolidus = &h2F

dim i, currentDigit
for i = 1 to (len(val))
            currentDigit = mid(val, i, 1)
if ascw(currentDigit) > &h00 and ascw(currentDigit) < &h1F then
                currentDigit = escapequence(currentDigit)
elseif ascw(currentDigit) >= &hC280 and ascw(currentDigit) <= &hC2BF then
                currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)
elseif ascw(currentDigit) >= &hC380 and ascw(currentDigit) <= &hC3BF then
                currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC2C0), 2, 0), 2)
else
select case ascw(currentDigit)
case cDoubleQuote: currentDigit = escapequence(currentDigit)
case cRevSolidus: currentDigit = escapequence(currentDigit)
case cSolidus: currentDigit = escapequence(currentDigit)
end select
end if
            escape = escape & currentDigit
next
end function

'******************************************************************************
'' @SDESCRIPTION:    generates a representation of a name value pair in JSON grammer
'' @DESCRIPTION:    the generation is done fully recursive so the value can be a complex datatype as well. e.g.
''                    toJSON("n", array(array(), 2, true), false) or toJSON("n", array(RS, dict, false), false), etc.
'' @PARAM:            name [string]: name of the value (accessible with javascript afterwards). leave empty to get just the value
'' @PARAM:            val [variant], [int], [float], [array], [object], [dictionary], [recordset]: value which needs
''                    to be generated. Conversation of the data types (ASP datatype -> Javascript datatype):
''                    NOTHING, NULL -> null, ARRAY -> array, BOOL -> bool, OBJECT -> name of the type,
''                    MULTIDIMENSIONAL ARRAY -> generates a 1 dimensional array (flat) with all values of the multidim array
''                    DICTIONARY -> valuepairs. each key is accessible as property afterwards
''                    RECORDSET -> array where each row of the recordset represents a field in the array.
''                    fields have properties named after the column names of the recordset (LOWERCASED!)
''                    e.g. generate(RS) can be used afterwards r[0].ID
''                    INT, FLOAT -> number
''                    OBJECT with reflect() method -> returned as object which can be used within JavaScript
'' @PARAM:            nested [bool]: is the value pair already nested within another? if yes then the {} are left out.
'' @RETURN:            [string] returns a JSON representation of the given name value pair
''                    (if toResponse is on then the return is written directly to the response and nothing is returned)
'*******************************************************************************************
public function toJSON(name, val, nested)
if not nested and not isEmpty(name) then write("{")
if not isEmpty(name) then write("""" & escape(name) & """: ")
        generateValue(val)
if not nested and not isEmpty(name) then write("}")
        toJSON = output

if innerCall = 0 then newGeneration()
end function

'*********************************************************************************
'* generate
'******************************************************************************
private function generateValue(val)
if isNull(val) then
            write("null")
elseif isArray(val) then
            generateArray(val)
elseif isObject(val) then
if val is nothing then
                write("null")
elseif typename(val) = "Dictionary" then
                generateDictionary(val)
elseif typename(val) = "Recordset" then
                generateRecordset(val)
else
                generateObject(val)
end if
else
'bool
            varTyp = varType(val)
if varTyp = 11 then
if val then write("true") else write("false")
'int, long, byte
elseif varTyp = 2 or varTyp = 3 or varTyp = 17 or varTyp = 19 then
                write(cLng(val))
'single, double, currency
elseif varTyp = 4 or varTyp = 5 or varTyp = 6 or varTyp = 14 then
                write(replace(cDbl(val), ",", "."))
else
                write("""" & escape(val & "") & """")
end if
end if
        generateValue = output
end function

'*****************************************************************************
'* generateArray
'*****************************************************************************
private sub generateArray(val)
dim item, i
        write("[")
        i = 0
'the for each allows us to support also multi dimensional arrays
for each item in val
if i > 0 then write(",")
            generateValue(item)
            i = i + 1
next
        write("]")
end sub

'*********************************************************************************
'* generateDictionary
'**************************************************************************
private sub generateDictionary(val)
dim keys, i
        innerCall = innerCall + 1
        write("{")
        keys = val.keys
for i = 0 to uBound(keys)
if i > 0 then write(",")
            toJSON keys(i), val(keys(i)), true
next
        write("}")
        innerCall = innerCall - 1
end sub

'*******************************************************************
'* generateRecordset
'*******************************************************************
private sub generateRecordset(val)
dim i
        write("[")
while not val.eof
            innerCall = innerCall + 1
            write("{")
for i = 0 to val.fields.count - 1
if i > 0 then write(",")
                toJSON lCase(val.fields(i).name), val.fields(i).value, true
next
            write("}")
            val.movenext()
if not val.eof then write(",")
            innerCall = innerCall - 1
wend
        write("]")
end sub

'*******************************************************************************
'* generateObject
'*******************************************************************************
private sub generateObject(val)
dim props
on error resume next
set props = val.reflect()
if err = 0 then
on error goto 0
            innerCall = innerCall + 1
            toJSON empty, props, true
            innerCall = innerCall - 1
else
on error goto 0
            write("""" & escape(typename(val)) & """")
end if
end sub

'*******************************************************************************
'* newGeneration
'*******************************************************************************
private sub newGeneration()
        output = empty
        innerCall = 0
end sub

'*******************************************************************************
'* JsonEscapeSquence
'*******************************************************************************
private function escapequence(digit)
        escapequence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)
end function

'*****************************************************************************
'* padLeft
'*****************************************************************************
private function padLeft(value, totalLength, paddingChar)
        padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
end function

'*****************************************************************************
'* clone
'******************************************************************************************
public function clone(byVal str, n)
dim i
for i = 1 to n : clone = clone & str : next
end function

'******************************************************************************************
'* write
'******************************************************************************************
private sub write(val)
if toResponse then
            response.write(val)
else
            output = output & val
end if
end sub

end class
%>

Asp 这个老古懂估计没几个人在用了。几年没写代码了,最近要弄个小东西,给手机端提供json数据,不想麻烦别人,自己又只会asp,没办法就自己动手了。网上找了好久都没有一个人能完整的把asp操作json说清楚。最后还是自己搞定的。整出来共享给大家。(ps,还有个原因csdn的分不够用啦,大家看着给点吧。写这个说明文档都用了我两小时。^_^) 以下是示例代码 '说明:json.asp中引用了json.js.asp '其他见文档 '手机很多时候不认gb2312,跳入json的坑就忘记gb2312吧,讨厌的是,如果代码报错,iis会输出gb2312,结果就是乱码,有点烦。 '自己想办法解决吧 response.Charset= "utf-8" dim strJsonData,ovbJson,j dim arrTemp,varname ,i set ovbJson=new vbJson 'asp recrodset和数组转json字符 arrTemp=array("a","{""oa"":""我是oa""}","c") strJsonData=ovbjson.toJson(empty,arrTemp,true) '转换为Json格式的字符串,有兴趣可以自己输出看看是什么 set j=json.parse(strJsonData) '序列化为json对象(或者是数组对象) response.Write(j.get(1)&"") '别用vb数组来存json对象,不然得每个元素去重新序列化,这里如果想j.get(1).oa就不行了。必须对j.get(1)单独序列才行 '----recrodset就不演示了,懒得连数据库 '---自定义操作方法的演示--- strJsonData="{a:1,b:[{c:'我是数组中的点c'}]}" set j=json.parsestr(strJsonData) response.Write(j.b.get(0).c&"") '添加节点的时候注意,如果值是null,会被忽然,这个节点会不存在的。在添加之前记得先检查值 set j=json.add(j,"new","我是新加的节点") response.Write(j.new&"") '下面这句注掉了,是因为这个操作是无效的因为j.b是数组,不能add 'set j=json.add(j.b,"new1","我是加不进的节点") set j.b=j.b.put(j.b.length,j.b.get(0)) response.Write(j.b.get(1).c&",我是新加的数组元素") '因为数组的get方法不允许被赋值,所以不能像下面这样写 'set j.b.get(0)=json.add(j.b.get(0),"new","我会报错") json.add j.b.get(0),"new","我是新加的new我不会报错" json.add j.b.get(0),"new1","我是通过变量取出来的哦" response.Write(j.b.get(0).new&"") varname="new1" response.Write(json.byname(j.b.get(0),varname)&"") for i=0 to j.b.length-1 varname="c" response.Write(json.byname(j.b.get(i),varname)&"我是循环出来的c,索引:"&i&" ") next '最后完整的输出给手机就这样: response.Write json.stringify(j)
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值