当前位置：文章中心 - ASP编程 - asp处理xml数据的发送、接收类
相关文章
这里放搜索
最新文章
asp处理xml数据的发送、接收类
关键词：asp,xml,发送,接收 时间:2008年09月15日 星期一 阅读:198

本asp类可以用来处理xml包的发送与接收。可用于各种异构系统之间API接口间通讯，以及处理Web Service的调用与接收。

属性：

URL : 发送xml的接收地址

String
只写

Message : 系统错误信息
String
只读

XmlNode:获取发送包XML中节点的值
String
只读
参数：Str:节点名称

GetXmlData: 获取返回XML数据对象
XMLDom
只读


方法：

LoadXmlFromFile : 从外部xml文件填充XmlDoc对象
参数 Path:xml路径
Void

LoadXmlFromString : 用字符串填充XmlDoc对象
参数 Str:xml字符串
Void


NodeValue 设置node的参数


参数

NodeName 节点名

NodeText 值

NodeType 保存类型 [text=0,cdata=1]

blnEncode 是否编码 [true,false]
Void


SendHttpData : 发送xml包

PrintSendXmlData : 打印发送请求XML数据

PrintGetXmlData : 打印返回XML数据

SaveSendXmlDataToFile : 保存发送请求xml数据到文件，文件名为sendxml_日期.txt


 

SaveGetXmlDataToFile : 保存返回XML数据到文件，文件名为getxml_日期.txt

GetSingleNode : 获取返回xml的节点信息
参数 Nodestring：节点名

AcceptHttpData : 接收XML包，错误信息通过Message对象获取

AcceptSingleNode: 返回接收XML包节点信息
参数 Nodestring：节点名

PrintAcceptXmlData : 打印接收端接收到的XML数据

SaveAcceptXmlDataToFile : 保存接收的XML包数据到文件，文件名为acceptxml_日期.txt


SaveDebugStringToFile : 保存调试数据到文件，文件名为debugnote_日期.txt
参数 Debugstr：调试信息

xmlcls.asp

  1. <%  
  2. Rem 处理xml数据的发送、接收类  
  3. '--------------------------------------------------  
  4. '转载的时候请保留版权信息  
  5. '作者:walkman  
  6. '网址:手机主题网:http://www.shouji138.com  
  7. '版本:ver1.0  
  8. '--------------------------------------------------  
  9. Class XmlClass  
  10. Rem 变量定义  
  11. Private XmlDoc,XmlHttp  
  12. Private MessageCode,SysKey,XmlPath  
  13. Private m_GetXmlDoc,m_url  
  14. Private m_XmlDocAccept  
  15.  
  16. Rem 初始化   
  17. Private Sub Class_Initialize()  
  18.    On Error Resume Next   
  19.    MessageCode = "" 
  20.    XmlPath = "" 
  21.    Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")  
  22.    XmlDoc.ASYNC = False 
  23. End Sub 
  24.  
  25. Rem 销毁对象  
  26. Private Sub Class_Terminate()  
  27.    If IsObject(XmlDoc) Then Set XmlDoc = Nothing 
  28.    If IsObject(m_XmlDocAccept) Then Set m_XmlDocAccept = Nothing 
  29.    If IsObject(m_GetXmlDoc) Then Set m_GetXmlDoc = Nothing     
  30. End Sub 
  31.  
  32.  
  33.  
  34. '公共属性定义开始--------------------------  
  35. Rem 错误信息  
  36. Public Property Get Message()  
  37.    Message = MessageCode  
  38. End Property 
  39.  
  40.  
  41. Rem 发送xml的地址  
  42. Public Property Let URL(str)  
  43.    m_url = str   
  44. End Property 
  45. '公共属性定义结束--------------------------  
  46.  
  47.    
  48.  
  49.    
  50.  
  51. '私有过程、方法开始--------------------------   
  52. Rem 加载xml  
  53. Private Sub LoadXmlData()  
  54.    If XmlPath <> "" Then   
  55.     If Not XmlDoc.Load(XmlPath) Then 
  56.      XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>" 
  57.     End If 
  58.    Else 
  59.     XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>" 
  60.    End If   
  61. End Sub 
  62.  
  63. Rem 字符转化  
  64. Private Function AnsiToUnicode(ByVal str)  
  65.    Dim i, j, c, i1, i2, u, fs, f, p  
  66.    AnsiToUnicode = "" 
  67.    p = "" 
  68.    For i = 1 To Len(str)  
  69.     c = Mid(str, i, 1)  
  70.     j = AscW(c)  
  71.     If j < 0 Then 
  72.      j = j + 65536  
  73.     End If 
  74.     If j >= 0 And j <= 128 Then 
  75.      If p = "c" Then 
  76.       AnsiToUnicode = " " & AnsiToUnicode  
  77.       p = "e" 
  78.      End If 
  79.      AnsiToUnicode = AnsiToUnicode & c  
  80.     Else 
  81.      If p = "e" Then 
  82.       AnsiToUnicode = AnsiToUnicode & " " 
  83.       p = "c" 
  84.      End If 
  85.      AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")  
  86.     End If 
  87.    Next 
  88. End Function 
  89.  
  90. Rem 字符转化  
  91. Private Function strAnsi2Unicode(asContents)  
  92.    Dim len1,i,varchar,varasc  
  93.    strAnsi2Unicode = "" 
  94.    len1=LenB(asContents)  
  95.    If len1=0 Then Exit Function 
  96.     For i=1 to len1  
  97.     varchar=MidB(asContents,i,1)  
  98.     varasc=AscB(varchar)  
  99.     If varasc > 127 Then 
  100.      If MidB(asContents,i+1,1)<>"" Then 
  101.       strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))  
  102.      End If 
  103.      i=i+1  
  104.     Else 
  105.      strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)  
  106.     End If   
  107.    Next 
  108. End Function 
  109.  
  110.  
  111. Rem 往文件中追加字符  
  112. Private Sub WriteStringToFile(filename,str)  
  113.    On Error Resume Next   
  114.    Dim fs,ts  
  115.    Set fs= createobject("scripting.filesystemobject")  
  116.    If Not IsObject(fs) Then Exit Sub     
  117.    Set ts=fs.OpenTextFile(Server.MapPath(filename),8,True)  
  118.    ts.writeline(str)  
  119.    ts.close  
  120.    Set ts=Nothing 
  121.    Set fs=Nothing 
  122. End Sub   
  123. '私有过程、方法结束--------------------------  
  124.  
  125.    
  126.  
  127.    
  128.  
  129. '公共方法开始--------------------------  
  130.  
  131.  
  132. '''''''''''发送xml部分开始  
  133. Rem 从外部xml文件填充XmlDoc对象  
  134. Public Sub LoadXmlFromFile(path)  
  135.    XmlPath = Server.MapPath(path)  
  136.    LoadXmlData()  
  137. End Sub   
  138.  
  139. Rem 用字符串填充XmlDoc对象  
  140. Public Sub LoadXmlFromString(str)  
  141.    XmlDoc.LoadXml str  
  142. End Sub   
  143.  
  144. Rem 设置node的参数 如 NodeValue "appID",AppID,1,False 
  145. '--------------------------------------------------  
  146. '参数 ：  
  147. 'NodeName 节点名  
  148. 'NodeText 值  
  149. 'NodeType 保存类型 [text=0,cdata=1]   
  150. 'blnEncode 是否编码 [true,false]  
  151. '--------------------------------------------------  
  152. Public Sub NodeValue(Byval NodeName,Byval NodeText,Byval NodeType ,Byval blnEncode)  
  153.    Dim ChildNode,CreateCDATASection  
  154.    NodeName = Lcase(NodeName)  
  155.    If XmlDoc.documentElement.selectSingleNode(NodeName) is nothing Then 
  156.     Set ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))  
  157.    Else 
  158.     Set ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)  
  159.    End If 
  160.    If blnEncode = True Then 
  161.     NodeText = AnsiToUnicode(NodeText)  
  162.    End If 
  163.    If NodeType = 1 Then 
  164.     ChildNode.Text = "" 
  165.     Set CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]&gt;"))  
  166.     ChildNode.appendChild(createCDATASection)  
  167.    Else 
  168.     ChildNode.Text = NodeText  
  169.    End If 
  170. End Sub 
  171.  
  172.  
  173. '--------------------------------------------------  
  174. '获取发送包XML中节点的值  
  175. '参数 ：  
  176. 'Str 节点名  
  177. '--------------------------------------------------  
  178. Public Property Get XmlNode(Byval Str)  
  179.    If XmlDoc.documentElement.selectSingleNode(Str) is Nothing Then 
  180.     XmlNode = "Null" 
  181.    Else 
  182.     XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text  
  183.    End If 
  184. End Property 
  185.  
  186. '--------------------------------------------------  
  187. '获取返回XML数据对象  
  188. '例：  
  189. '当GetXmlData不为NULL时，GetXmlData为XML对象  
  190. '--------------------------------------------------  
  191. Public Property Get GetXmlData()  
  192.    Set GetXmlData = m_GetXmlDoc  
  193. End Property 
  194.  
  195.  
  196. '--------------------------------------------------  
  197. '发送xml包  
  198. '--------------------------------------------------  
  199. Public Sub SendHttpData()  
  200.    Dim i,GetXmlDoc,LoadAppid  
  201.    Set Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")  
  202.    Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' 返回xml包  
  203.     XmlHttp.Open "POST", m_url, false 
  204.     XmlHttp.SetRequestHeader "content-type", "text/xml" 
  205.     XmlHttp.Send XmlDoc  
  206.     'Response.Write strAnsi2Unicode(xmlhttp.responseBody)  
  207.     If GetXmlDoc.load(XmlHttp.responseXML) Then 
  208.      Set m_GetXmlDoc = GetXmlDoc  
  209.     Else 
  210.      MessageCode = "请求数据错误！" 
  211.      Exit Sub   
  212.     End If 
  213.    Set GetXmlDoc = Nothing 
  214.    Set XmlHttp = Nothing 
  215. End Sub 
  216.  
  217.    
  218.  
  219. '--------------------------------------------------  
  220. '打印发送请求XML数据  
  221. '--------------------------------------------------  
  222. Public Sub PrintSendXmlData()  
  223.    Response.Clear  
  224.    Response.ContentType = "text/xml" 
  225.    Response.CharSet = "gb2312" 
  226.    Response.Expires = 0  
  227.    Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine  
  228.    Response.Write XmlDoc.documentElement.XML  
  229. End Sub 
  230.  
  231. '--------------------------------------------------  
  232. '打印返回XML数据  
  233. '--------------------------------------------------  
  234. Public Sub PrintGetXmlData()  
  235.     
  236.    Response.Clear  
  237.    Response.ContentType = "text/xml" 
  238.    Response.CharSet = "gb2312" 
  239.    Response.Expires = 0  
  240.    If IsObject(m_GetXmlDoc) Then 
  241.     Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine  
  242.     Response.Write m_GetXmlDoc.documentElement.XML  
  243.    Else 
  244.     Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>" 
  245.    End If   
  246. End Sub 
  247.  
  248.  
  249. Rem 保存发送请求xml数据到文件，文件名为sendxml_日期.txt  
  250. Public Sub SaveSendXmlDataToFile()  
  251.    Dim filename,str  
  252.    filename = "sendxml_" & DateValue(now) & ".txt" 
  253.    str = "" 
  254.    str = str & ""& Now() & vbNewLine  
  255.    str = str & "---------------------------------------------"& vbNewLine  
  256.    str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine  
  257.    str = str & XmlDoc.documentElement.XML & vbNewLine  
  258.    str = str & "---------------------------------------------"& vbNewLine  
  259.    str = str & vbNewLine & vbNewLine & vbNewLine  
  260.    WriteStringToFile filename,str  
  261. End Sub 
  262.  
  263.  
  264. Rem 保存返回XML数据到文件，文件名为getxml_日期.txt  
  265. Public Sub SaveGetXmlDataToFile()  
  266.    Dim filename,str  
  267.    filename = "getxml_" & DateValue(now) & ".txt" 
  268.    str = "" 
  269.    str = str & ""& Now() & vbNewLine  
  270.    str = str & "---------------------------------------------"& vbNewLine  
  271.    If IsObject(m_GetXmlDoc) Then 
  272.     str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine  
  273.     str = str & m_GetXmlDoc.documentElement.XML  
  274.    Else 
  275.     str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>" 
  276.    End If   
  277.    str = str & vbNewLine  
  278.    str = str & "---------------------------------------------"& vbNewLine  
  279.    str = str & vbNewLine & vbNewLine & vbNewLine  
  280.    WriteStringToFile filename,str  
  281. End Sub 
  282.  
  283.  
  284.  
  285. '--------------------------------------------------  
  286. '获取返回xml的节点信息  
  287. 'XmlClassObj.GetSingleNode("//msg")  
  288. '--------------------------------------------------  
  289. Public Function GetSingleNode(nodestring)  
  290.    If IsObject(m_GetXmlDoc) Then 
  291.     GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text  
  292.    Else 
  293.     GetSingleNode = "" 
  294.    End If   
  295. End Function   
  296. ''''''''''''''''''发送xml部分结束  
  297.  
  298.  
  299. ''''''''''''''''''接收xml部分开始  
  300. '--------------------------------------------------  
  301. '接收XML包，错误信息通过Message对象获取  
  302. '--------------------------------------------------  
  303. Public Function AcceptHttpData()  
  304.    Dim XMLdom  
  305.    Set XMLdom = Server.CreateObject("Microsoft.XMLDOM")  
  306.    XMLdom.Async = False 
  307.    XMLdom.Load(Request)  
  308.    If XMLdom.parseError.errorCode <> 0 Then 
  309.     MessageCode = "不能正确接收数据" & "Description: " & XMLdom.parseError.reason & "<br>Line: " & XMLdom.parseError.Line  
  310.     Set m_XmlDocAccept = Null   
  311.    Else 
  312.     Set m_XmlDocAccept = XMLdom  
  313.    End If   
  314. End Function 
  315.  
  316. '--------------------------------------------------  
  317. '返回接收XML包节点信息  
  318. 'XmlClassObj.GetSingleNode("//msg")  
  319. '--------------------------------------------------  
  320. Public Function AcceptSingleNode(nodestring)  
  321.    If IsObject(m_XmlDocAccept) Then 
  322.     AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text  
  323.    Else 
  324.     AcceptSingleNode = "" 
  325.    End If   
  326. End Function 
  327.  
  328.  
  329. '--------------------------------------------------  
  330. '打印接收端接收到的XML数据  
  331. '--------------------------------------------------  
  332. Public Sub PrintAcceptXmlData()  
  333.    Response.Clear  
  334.    Response.ContentType = "text/xml" 
  335.    Response.CharSet = "gb2312" 
  336.    Response.Expires = 0  
  337.    If IsObject(m_XmlDocAccept) Then 
  338.     Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine  
  339.     Response.Write m_XmlDocAccept.documentElement.XML  
  340.    Else 
  341.     Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>" 
  342.    End If   
  343. End Sub 
  344.  
  345.  
  346. Rem 保存接收的XML包数据到文件，文件名为acceptxml_日期.txt  
  347. Public Sub SaveAcceptXmlDataToFile()  
  348.    Dim filename,str  
  349.    filename = "acceptxml_" & DateValue(now) & ".txt" 
  350.    str = "" 
  351.    str = str & ""& Now() & vbNewLine  
  352.    str = str & "---------------------------------------------"& vbNewLine  
  353.    If IsObject(m_XmlDocAccept) Then 
  354.     str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine  
  355.     str = str & m_XmlDocAccept.documentElement.XML  
  356.    Else 
  357.     str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>" 
  358.    End If   
  359.    str = str & vbNewLine  
  360.    str = str & "---------------------------------------------"& vbNewLine  
  361.    str = str & vbNewLine & vbNewLine & vbNewLine  
  362.    WriteStringToFile filename,str  
  363. End Sub   
  364.  
  365. ''''''''''''''''''接收xml部分结束  
  366.  
  367. Rem 保存调试数据到文件，文件名为debugnote_日期.txt  
  368. Public Sub SaveDebugStringToFile(debugstr)  
  369.    Dim filename,str  
  370.    filename = "debugnote_" & DateValue(now) & ".txt" 
  371.    str = "" 
  372.    str = str & ""& Now() & vbNewLine  
  373.    str = str & "---------------------------------------------"& vbNewLine  
  374.    str = str & debugstr & vbNewLine  
  375.    str = str & "---------------------------------------------" 
  376.    str = str & vbNewLine & vbNewLine & vbNewLine  
  377.    WriteStringToFile filename,str  
  378. End Sub 
  379.  
  380. '公共方法结束--------------------------  
  381.  
  382. End Class   
  383. %> 

sendxml.asp

  1. <%  
  2. Option Explicit   
  3. Response.buffer = True 
  4. Response.Expires=-1  
  5. %>  
  6. <!--#include file="xmlcls.asp"--> 
  7.  
  8. <%  
  9. Const Apisysno = "23498927347234234987" 
  10. Const ActionURL = "http://www.shouji138.com/aspnet2/acceptxml.asp" Rem 响应的文件 写url地址  
  11. Dim XmlClassObj  
  12. Set XmlClassObj = new XmlClass   '创建对象  
  13. XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") '用xml字符填充XMLDOC对象，用来发送xml  
  14. XmlClassObj.URL =    ActionURL '设置响应的url  
  15. Rem xml格式  
  16. Rem "<?xml version="1.0" encoding="gb2312"?>  
  17. Rem   <root>  
  18. Rem    <sysno></sysno>  
  19. Rem    <username></username>  
  20. Rem    <pwd></pwd>  
  21. Rem    <email></email>  
  22. Rem    <pagename></pagename>  
  23. Rem    <pageurl></pageurl>  
  24. Rem   </root>  
  25.  
  26. XmlClassObj.NodeValue "sysno",Apisysno,0,False     
  27. XmlClassObj.NodeValue "username","testusername",0,False 
  28. XmlClassObj.NodeValue "pwd","pwd",0,False   
  29. XmlClassObj.NodeValue "email","web@shouji138.com",0,False   
  30. XmlClassObj.NodeValue "pagename","站点",0,False 
  31. XmlClassObj.NodeValue "pageurl","http://www.shouji138.com",1,False 
  32. XmlClassObj.SaveSendXmlDataToFile()       '将发送的xml数据库包存入txt文件  
  33. XmlClassObj.SendHttpData()         '开始发送xml数据  
  34. 'XmlClassObj.PrintGetXmlData()        '打印接收到的xml数据  
  35. 'response.write XmlClassObj.Message       '打印错误信息  
  36. XmlClassObj.SaveGetXmlDataToFile()       '将接收到的xml数据库存入txt文件  
  37. response.write XmlClassObj.GetSingleNode("//message")   '显示收到的xml数据的msg节点的值  
  38. Set XmlClassObj = Nothing         '销毁对象实例  
  39. %> 

acceptxml.asp

  1. <%  
  2. Rem Api用户注册接口  
  3. %>  
  4. <%  
  5. Response.Expires= -1  
  6. Response.Addheader "pragma","no-cache" 
  7. Response.AddHeader "cache-control","no-store" 
  8. %>  
  9. <!--#Include File="xmlcls.asp"--> 
  10. <%  
  11. Rem xml格式  
  12. Rem "<?xml version="1.0" encoding="gb2312"?>  
  13. Rem   <root>  
  14. Rem    <sysno></sysno>  
  15. Rem    <username></username>  
  16. Rem    <pwd></pwd>  
  17. Rem    <email></email>  
  18. Rem    <pagename></pagename>  
  19. Rem    <pageurl></pageurl>  
  20. Rem   </root>  
  21. Const Apisysno = "23498927347234234987" 
  22. On Error Resume Next   
  23. Dim XmlClassObj  
  24. Set XmlClassObj = new XmlClass    '创建对象  
  25. XmlClassObj.AcceptHttpData()    '接收xml数据  
  26. XmlClassObj.SaveAcceptXmlDataToFile() '将接收到的xml数据存入txt文件  
  27. Err.clear   
  28. Dim message  
  29. Dim sysno,username,pwd,email,PageName,PageURL  
  30. sysno = XmlClassObj.AcceptSingleNode("//sysno")   
  31. username = XmlClassObj.AcceptSingleNode("//username")  
  32. pwd = XmlClassObj.AcceptSingleNode("//pwd")  
  33. email = XmlClassObj.AcceptSingleNode("//email")  
  34. PageName = XmlClassObj.AcceptSingleNode("//pagename")  
  35. PageURL = XmlClassObj.AcceptSingleNode("//pageurl")  
  36. XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) '存入debug日志文件  
  37. If Err Then   
  38. message = message & Err.Description   
  39. Else 
  40. Err.clear   
  41. If sysno <> Apisysno Then   
  42.    message = "请务非法使用！" 
  43. Else 
  44.    message = regUser(username,pwd,email,PageName,PageURL)   
  45. End If 
  46. End If 
  47. 'XmlClassObj.SaveDebugStringToFile("message=" & message) '将message值存入debug日志文件  
  48.  
  49. Set XmlClassObj = Nothing        '销毁对象实例  
  50.  
  51. Response.ContentType = "text/xml"      '输出xml数据流给发送端  
  52. Response.Charset = "gb2312" 
  53. Response.Clear  
  54. Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline  
  55. Response.Write "<root>" & vbnewline  
  56. Response.Write "<message>" & message & "</message>" & vbnewline  
  57. Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline  
  58. Response.Write "</root>" & vbnewline  
  59.  
  60.    
  61.  
  62.  
  63. Function regUser(username,pwd,email,PageName,PageURL)  
  64. '''''''''''''''''''  
  65. ''''''''''''''''''  
  66. '''''''''''''''''  
  67. '操作数据库注册用户  
  68. '''''''''''''''''  
  69. ''''''''''''''  
  70. regUser = "OK" 
  71.  
  72. End Function 
  73. %> 

附件：Xmlcls.rar (5.4 KB)

上一篇：用ASP取出HTML里面的图片地址的函数下一篇：asp利用aspjpeg给图片生成PNG透明水印

0条记录访客评论

暂未有任何评论,你来发表一篇吧！

发表评论

(必填)
(必填)
不想保留信息请删除cookie！
 
友情链接