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
%>
 
            
ASP接受XML数据
案例源码


<!--#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)
%>
 
            
ASP发送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, "utf-8")  
 '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  
 %> 
  
 
            
ASP接受JSON数据
案例源码


<%  
 dim scriptCtrl,getpostjson,readjson,json,fso,obj,title
 '获取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 
 
 '字节流转为字符串 
 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 
  
 %>