ASP发送和接受XML和JSON请求，完整代码和案例 ， 下载案例源码>>
案例源码
<%
response.addheader "Content-Type", "text/html; charset=utf-8"
'回复文本信息'
function getTextXMLStr()
dim c
c="<xml><appid><![CDATA[wxca2d333338f中文]]></appid>" & vbcrlf
c=c & "<attach><![CDATA[333]]></attach>" & vbcrlf
c=c & "</xml>" & vbcrlf
getTextXMLStr=c
end function
call moSiPostXmlTest()
'模似发送xml文件，调试微信公众号里用到'
Function moSiPostXmlTest()
dim postData,signValue,post_url,sign,returnXml,xml_dom,return_code,result_code,get_prepay_id,attach
' postData=readfile("fkm.txt","utf-8")
postData=getTextXMLStr()
' response.Write("show=" & post_url & "<hr>")
' returnXml=Get_code_url(apiurl,post_url,postData)
call response.write("返回值=" & PostURL("http://xiyueta/6.asp",postData))
End Function
'POST过程
Function Get_code_url(apiurl,url,xml)
Dim code_url,data
data =Response_Data(xml,url,1)
code_url = PostURL(apiurl,data)
Get_code_url = code_url
End Function
'整合POST数据
Function Response_Data(xml,url,cert)
dim domain:domain=Request.ServerVariables("HTTP_HOST")
If cert=1 Then
Response_Data = "xml="&xml&"&url="&url&"&domain="&domain&"&cert=1"
Else
Response_Data = "xml="&xml&"&url="&url&"&domain="&domain&"&cert=0"
End If
End Function
'获取POST返回数据
Function PostURL(url,PostStr)
dim http
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
With http
.Open "POST", url, false ,"" ,""
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send(PostStr)
PostURL = .responsetext
End With
Set http = Nothing
End Function
%>
案例源码
<!--#include file="inc/config.asp"-->
<%
dim xml_dom,strsend,appid
set xml_dom = Server.CreateObject("MSXML2.DOMDocument")'此处根据您的实际服务器情况改写
xml_dom.load request
call xml_dom.Save(handlepath("123.txt")) '保存结构 20230427'
appid=xml_dom.getelementsbytagname("appid").item(0).text '发送者微信账号
response.write("appid=" & appid)
%>
案例源码
注意：Response.AddHeader "Content-Type", "application/json" '以json文件格式输出，网页里调用直接以json对象使用'
<%
Response.AddHeader "Content-Type", "application/json" '以json文件格式输出，网页里调用直接以json对象使用'
postUrl="http://xiyueta/4.asp"
postStr="{""title"":""php"",""b"":""mysql"",""c"":3}"
set http = createObject("Microsoft.XMLHTTP")
call http.open("POST", postUrl, false)
call http.setRequestHeader("cache-control", "no-cache")
call http.setRequestHeader("Content-Type", "application/json")
call http.setRequestHeader("Connection", "close")
call http.setRequestHeader("Content-Length", len(postStr)) '可以不需要
call http.send(cStr(postStr)) '转成字符，为了在vb.net里可以用，晕，不知道为什么20161025
if http.readyState <> 4 then
content = "error"
else
content = bytesToBstr(http.responseBody, "gb2312")
'content = bytes2BSTR(Http.responseBody) '这个要比上面那个好用 有时也不好用
end if
response.write(content)
function bytesToBstr(byteArr, cset)
dim objStream
if isNul(byteArr) then exit function '为空则退出
set objStream = createObject("ADODB.Stream")
objStream.type = 1
objStream.mode = 3
objStream.open
call objStream.write(byteArr)
objStream.position = 0
objStream.type = 2
objStream.charset = cset
bytesToBstr = objStream.readText
objStream.close
set objStream = nothing
end function
'判断是否为空
function isNul(byVal s)
on error resume next : if err.number <> 0 then err.clear
isNul = false
select case varType(s)
case vbEmpty, vbNull
isNul = true : exit function
case vbString
if s = "" then isNul = true : exit function
case vbObject
select case typeName(s)
case "Nothing", "Empty"
isNul = true : exit function
case "Recordset"
if s.state = 0 then isNul = true : exit function
if s.BOF and s.EOF then isNul = true : exit function
case "Dictionary"
if s.count = 0 then isNul = true : exit function
end select
case vbArray, 8194, 8204, 8209
if uBound(s) = -1 then isNul = true : exit function
end select
on error goto 0
end function
%>
案例源码
<!--#Include virtual = "/inc/config.asp"-->
<%
dim scriptCtrl
call run()
function run()
dim getpostjson,readjson,json,fso,obj,title,fText,createFile
'获取Post中的字节流大小
getpostjson=Request.TotalBytes
if getpostjson=0 then
response.Write("json null")
response.End()
end if
'读取POST所传递的字节流
readjson=Request.BinaryRead(getpostjson)
'将字节流转为字符串
json = bytes2bstr(readjson)
' response.write(json)
set fso = createObject("Scripting.FileSystemObject")
set fText = fso.createTextFile(server.mapPath("1.txt"), true)
fText.writeLine(json)
createFile = true
set fText = nothing
set fso = nothing
'解析JSON
Set obj = parseJSON(json)
title=obj.title '标题
set fso = createObject("Scripting.FileSystemObject")
set fText = fso.createTextFile(server.mapPath("2.txt"), true)
fText.writeLine(title)
createFile = true
set fText = nothing
set fso = nothing
response.write("标题 = " & title)
Set obj = Nothing
end function
'字节流转为字符串
function bytes2bstr(vin)
dim bytesstream,stringreturn
set bytesstream = server.CreateObject("adodb.stream")
bytesstream.type = 2
bytesstream.open
bytesstream.writeText vin
bytesstream.position = 0
bytesstream.charset = "utf-8"'或者gb2312
bytesstream.position = 2
stringreturn = bytesstream.readtext
bytesstream.close
set bytesstream = nothing
bytes2bstr = stringreturn
end function
'解析json
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
%>