1、json官网下载了ASP专用的json.asp,代码如下
<%
'**********************************************************************************************
'* 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
%>
2、集成了一个Function.asp，生成token,根据token生成订单、更新订单，记录日志，日志每天生成1个文本文件。
<!-- #include file = "json.asp" -->
<%
Function newtoken()
dim HttpReq,jsonObj,json_ret,PostData,strXML,jsonstr
set HttpReq = server.CreateObject("Msxml2.ServerXMLHTTP")
url="接口网址"
set jsonObj = new json
jsonObj.toResponse = false
Set json_ret = server.createobject("scripting.dictionary")
json_ret.Add "参数名","参数值"
json_ret.Add "参数名","参数值"
PostData = jsonObj.toJSON(Empty,json_ret,False)
HttpReq.open "POST",url,False
HttpReq.setRequestHeader "Content-Type","application/json"
HttpReq.send PostData
strXML = HttpReq.responseText
Set jsonstr = parseJSON(strXML)
if jsonstr.statusCode=200 then
Session("newtoken")=jsonstr.data
else
response.write "当前可能连接不上，清稍后再试！"
end if
end Function
Function neworder(projectCode,plannedNum,planStartTime,planEndTime)
if Session("newtoken")="" THEN
newtoken()
else
dim HttpReq,jsonObj,json_ret,PostData,strXML,jsonstr
set HttpReq = server.CreateObject("Msxml2.ServerXMLHTTP")
url="接口网址"
set jsonObj = new json
jsonObj.toResponse = false
Set json_ret = server.createobject("scripting.dictionary")
json_ret.Add "projectCode",projectCode
json_ret.Add "productCode","001"
json_ret.Add "plannedNum",plannedNum
json_ret.Add "planStartTime",planStartTime
json_ret.Add "planEndTime",planEndTime
PostData = jsonObj.toJSON(Empty,json_ret,False)
HttpReq.open "POST",url,False
HttpReq.setRequestHeader "X-AUTH",Session("newtoken")
HttpReq.setRequestHeader "Content-Type","application/json"
HttpReq.send PostData
strXML = HttpReq.responseText
Set jsonstr = parseJSON(strXML)
if jsonstr.code="200" then
dolog "neworder成功-"&projectCode
response.write "成功！"
else
newtoken()
dolog "neworder失败-"&projectCode&"-错误号："& jsonstr.code
response.write "出错了！错误号："& jsonstr.code
end if
end if
End Function
Function uporder(projectCode,plannedNum,planStartTime,planEndTime)
if Session("newtoken")="" THEN
newtoken()
else
dim HttpReq,jsonObj,json_ret,PostData,strXML,jsonstr
set HttpReq = server.CreateObject("Msxml2.ServerXMLHTTP")
url="接口网址"
set jsonObj = new json
jsonObj.toResponse = false
Set json_ret = server.createobject("scripting.dictionary")
json_ret.Add "projectCode",projectCode
json_ret.Add "productCode","001"
json_ret.Add "plannedNum",plannedNum
json_ret.Add "planStartTime",planStartTime
json_ret.Add "planEndTime",planEndTime
PostData = jsonObj.toJSON(Empty,json_ret,False)
HttpReq.open "POST",url,False
HttpReq.setRequestHeader "X-AUTH",Session("newtoken")
HttpReq.setRequestHeader "Content-Type","application/json"
HttpReq.send PostData
strXML = HttpReq.responseText
response.write strXML
Set jsonstr = parseJSON(strXML)
if jsonstr.code="200" then
dolog "uporder成功-"&projectCode
response.write "成功！"
else
newtoken()
dolog "uporder失败-"&projectCode&"-错误号："& jsonstr.code
response.write "出错了！错误号："&jsonstr.code
end if
end if
End Function
Function dolog(str)
aaa=right(year(now()),2)&"."&month(now())&"."&day(now())
way=server.MapPath ("/")&"\log\"&aaa&".txt"
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(way, 8, True)
f.WriteLine(aaa&"-"&str)
f.Close
End Function
Dim scriptCtrl
Function parseJSON(str)
If Not IsObject(scriptCtrl) Then
Set scriptCtrl = Server.CreateObject("MSScriptControl.ScriptControl")
scriptCtrl.Language = "JScript"
scriptCtrl.AddCode "Array.prototype.get = function(x) { return this[x]; }; var result = null;"
End If
scriptCtrl.ExecuteStatement "result = " & str & ";"
Set parseJSON = scriptCtrl.CodeObject.result
End Function
%>
3、业务里的调用
<!-- #include file = "Function.asp" --> <% '调用newtoken方法 newtoken() '调用neworder方法 neworder var3,var4,var5,var6 '调用uporder方法 uporder var3,var4,var5,var6 %>
来源：https://blog.csdn.net/yftyzs/article/details/129351025