最火下载站首页
手机版
最火下载站
关注公众号
最火下载站

当前位置:首页 > 网络知识 > 网络编程 > ASP教程> asp处理xml数据的发送、接收类

asp处理xml数据的发送、接收类

文章作者:网友投稿 发布时间:2008-08-06 来源:网络

本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
<%

Rem 处理xml数据的发送、接收类
'--------------------------------------------------
'转载的时候请保留版权信息
'作者:walkman
'公司:步步为赢科技有限责任公司
'网址:http://www.shouji138.com
'版本:ver1.0
'--------------------------------------------------

Class XmlClass
Rem 变量定义
Private XmlDoc,XmlHttp
Private MessageCode,SysKey,XmlPath
Private m_GetXmlDoc,m_url
Private m_XmlDocAccept
Rem 初始化
Private Sub Class_Initialize()
On Error Resume Next
MessageCode = ""
XmlPath = ""
Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = False
End Sub
Rem 销毁对象
Private Sub Class_Terminate()
If IsObject(XmlDoc) Then Set XmlDoc = Nothing
If IsObject(m_XmlDocAccept) Then Set m_XmlDocAccept = Nothing
If IsObject(m_GetXmlDoc) Then Set m_GetXmlDoc = Nothing
End Sub

'公共属性定义开始--------------------------
Rem 错误信息
Public Property Get Message()
Message = MessageCode
End Property

Rem 发送xml的地址
Public Property Let URL(str)
m_url = str
End Property
'公共属性定义结束--------------------------

'私有过程、方法开始--------------------------
Rem 加载xml
Private Sub LoadXmlData()
If XmlPath <> "" Then
If Not XmlDoc.Load(XmlPath) Then
XmlDoc.LoadXml ""
End If
Else
XmlDoc.LoadXml ""
End If
End Sub
Rem 字符转化
Private Function AnsiToUnicode(ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
AnsiToUnicode = ""
p = ""
For i = 1 To Len(str)
c = Mid(str, i, 1)
j = AscW(c)
If j < 0 Then
j = j + 65536
End If
If j >= 0 And j <= 128 Then
If p = "c" Then
AnsiToUnicode = " " & AnsiToUnicode
p = "e"
End If
AnsiToUnicode = AnsiToUnicode & c
Else
If p = "e" Then
AnsiToUnicode = AnsiToUnicode & " "
p = "c"
End If
AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";") #p#分页标题#e#
End If
Next
End Function
Rem 字符转化
Private Function strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
If len1=0 Then Exit Function
For i=1 to len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
If varasc > 127 Then
If MidB(asContents,i+1,1)<>"" Then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
End If
i=i+1
Else
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
End If
Next
End Function

Rem 往文件中追加字符
Private Sub WriteStringToFile(filename,str)
On Error Resume Next
Dim fs,ts
Set fs= createobject("scripting.filesystemobject")
If Not IsObject(fs) Then Exit Sub
Set ts=fs.OpenTextFile(Server.MapPath(filename),8,True)
ts.writeline(str)
ts.close
Set ts=Nothing
Set fs=Nothing
End Sub
'私有过程、方法结束--------------------------

'公共方法开始--------------------------

'''''''''''发送xml部分开始
Rem 从外部xml文件填充XmlDoc对象
Public Sub LoadXmlFromFile(path)
XmlPath = Server.MapPath(path)
LoadXmlData()
End Sub
Rem 用字符串填充XmlDoc对象
Public Sub LoadXmlFromString(str)
XmlDoc.LoadXml str
End Sub
Rem 设置node的参数 如 NodeValue "appID",AppID,1,False
'--------------------------------------------------
'参数 :
'NodeName 节点名
'NodeText 值
'NodeType 保存类型 [text=0,cdata=1]
'blnEncode 是否编码 [true,false]
'--------------------------------------------------
Public Sub NodeValue(Byval NodeName,Byval NodeText,Byval NodeType ,Byval blnEncode)
Dim ChildNode,CreateCDATASection
NodeName = Lcase(NodeName)
If XmlDoc.documentElement.selectSingleNode(NodeName) is nothing Then
Set ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Else
Set ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
End If
If blnEncode = True Then
NodeText = AnsiToUnicode(NodeText)
End If
If NodeType = 1 Then
ChildNode.Text = ""
Set CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]>"))
ChildNode.appendChild(createCDATASection)
Else
ChildNode.Text = NodeText
End If
End Sub

'--------------------------------------------------
'获取发送包XML中节点的值
'参数 :
'Str 节点名
'--------------------------------------------------
Public Property Get XmlNode(Byval Str)
If XmlDoc.documentElement.selectSingleNode(Str) is Nothing Then
XmlNode = "Null"
Else
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text
End If
End Property
'--------------------------------------------------
'获取返回XML数据对象
'例:
'当GetXmlData不为NULL时,GetXmlData为XML对象
'--------------------------------------------------
Public Property Get GetXmlData()
Set GetXmlData = m_GetXmlDoc
End Property

'--------------------------------------------------
'发送xml包
'--------------------------------------------------
Public Sub SendHttpData()
Dim i,GetXmlDoc,LoadAppid
Set Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' 返回xml包
XmlHttp.Open "POST", m_url, false
XmlHttp.SetRequestHeader "content-type", "text/xml"
XmlHttp.Send XmlDoc
'Response.Write strAnsi2Unicode(xmlhttp.responseBody)
If GetXmlDoc.load(XmlHttp.responseXML) Then
Set m_GetXmlDoc = GetXmlDoc
Else
MessageCode = "请求数据错误!"
Exit Sub
End If
Set GetXmlDoc = Nothing #p#分页标题#e#
Set XmlHttp = Nothing
End Sub

'--------------------------------------------------
'打印发送请求XML数据
'--------------------------------------------------
Public Sub PrintSendXmlData()
Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
Response.Write ""&vbNewLine
Response.Write XmlDoc.documentElement.XML
End Sub
'--------------------------------------------------
'打印返回XML数据
'--------------------------------------------------
Public Sub PrintGetXmlData()

Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
If IsObject(m_GetXmlDoc) Then
Response.Write ""&vbNewLine
Response.Write m_GetXmlDoc.documentElement.XML
Else
Response.Write ""
End If
End Sub

Rem 保存发送请求xml数据到文件,文件名为sendxml_日期.txt
Public Sub SaveSendXmlDataToFile()
Dim filename,str
filename = "sendxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
str = str & "" & vbNewLine
str = str & XmlDoc.documentElement.XML & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub

Rem 保存返回XML数据到文件,文件名为getxml_日期.txt
Public Sub SaveGetXmlDataToFile()
Dim filename,str
filename = "getxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
If IsObject(m_GetXmlDoc) Then
str = str & "" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Else
str = str & "" & vbNewLine & "" & vbNewLine & ""
End If
str = str & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub

'--------------------------------------------------
'获取返回xml的节点信息
'XmlClassObj.GetSingleNode("//msg")
'--------------------------------------------------
Public Function GetSingleNode(nodestring)
If IsObject(m_GetXmlDoc) Then
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
Else
GetSingleNode = ""
End If
End Function
''''''''''''''''''发送xml部分结束

''''''''''''''''''接收xml部分开始
'--------------------------------------------------
'接收XML包,错误信息通过Message对象获取
'--------------------------------------------------
Public Function AcceptHttpData()
Dim XMLdom
Set XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = False
XMLdom.Load(Request)
If XMLdom.parseError.errorCode <> 0 Then #p#分页标题#e#
MessageCode = "不能正确接收数据" & "Description: " & XMLdom.parseError.reason & "
Line: " & XMLdom.parseError.Line
Set m_XmlDocAccept = Null
Else
Set m_XmlDocAccept = XMLdom
End If
End Function
'--------------------------------------------------
'返回接收XML包节点信息
'XmlClassObj.GetSingleNode("//msg")
'--------------------------------------------------
Public Function AcceptSingleNode(nodestring)
If IsObject(m_XmlDocAccept) Then
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
Else
AcceptSingleNode = ""
End If
End Function

'--------------------------------------------------
'打印接收端接收到的XML数据
'--------------------------------------------------
Public Sub PrintAcceptXmlData()
Response.Clear
Response.ContentType = "text/xml"
Response.CharSet = "gb2312"
Response.Expires = 0
If IsObject(m_XmlDocAccept) Then
Response.Write ""&vbNewLine
Response.Write m_XmlDocAccept.documentElement.XML
Else
Response.Write ""
End If
End Sub

Rem 保存接收的XML包数据到文件,文件名为acceptxml_日期.txt
Public Sub SaveAcceptXmlDataToFile()
Dim filename,str
filename = "acceptxml_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
If IsObject(m_XmlDocAccept) Then
str = str & "" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Else
str = str & "" & vbNewLine & "" & vbNewLine & ""
End If
str = str & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
''''''''''''''''''接收xml部分结束
Rem 保存调试数据到文件,文件名为debugnote_日期.txt
Public Sub SaveDebugStringToFile(debugstr)
Dim filename,str
filename = "debugnote_" & DateValue(now) & ".txt"
str = ""
str = str & ""& Now() & vbNewLine
str = str & "---------------------------------------------"& vbNewLine
str = str & debugstr & vbNewLine
str = str & "---------------------------------------------"
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile filename,str
End Sub
'公共方法结束--------------------------
End Class
%>

测试用例:
sendxml.asp

<%
Option Explicit
Response.buffer = True
Response.Expires=-1
%>

<%
Const Apisysno = "23498927347234234987"
Const ActionURL = "http://www.shouji138.com/aspnet2/acceptxml.asp" Rem 响应的文件 写url地址

Dim XmlClassObj
Set XmlClassObj = new XmlClass '创建对象
XmlClassObj.LoadXmlFromString("") '用xml字符填充XMLDOC对象,用来发送xml
XmlClassObj.URL = ActionURL '设置响应的url

Rem xml格式
Rem " #p#分页标题#e#
Rem
Rem
Rem
Rem
Rem
Rem
Rem
Rem


XmlClassObj.NodeValue "sysno",Apisysno,0,False
XmlClassObj.NodeValue "username","testusername",0,False
XmlClassObj.NodeValue "pwd","pwd",0,False
XmlClassObj.NodeValue "email","web@shouji138.com",0,False
XmlClassObj.NodeValue "pagename","站点",0,False
XmlClassObj.NodeValue "pageurl","http://www.shouji138.com",1,False

XmlClassObj.SaveSendXmlDataToFile() '将发送的xml数据库包存入txt文件

XmlClassObj.SendHttpData() '开始发送xml数据
'XmlClassObj.PrintGetXmlData() '打印接收到的xml数据
'response.write XmlClassObj.Message '打印错误信息
XmlClassObj.SaveGetXmlDataToFile() '将接收到的xml数据库存入txt文件
response.write XmlClassObj.GetSingleNode("//message") '显示收到的xml数据的msg节点的值
Set XmlClassObj = Nothing '销毁对象实例
%>

acceptxml.asp

<%
Rem Api用户注册接口
%>
<%
Response.Expires= -1
Response.Addheader "pragma","no-cache"
Response.AddHeader "cache-control","no-store"
%>

<%
Rem xml格式
Rem "
Rem
Rem
Rem
Rem
Rem
Rem
Rem
Rem

Const Apisysno = "23498927347234234987"

On Error Resume Next
Dim XmlClassObj
Set XmlClassObj = new XmlClass '创建对象
XmlClassObj.AcceptHttpData() '接收xml数据
XmlClassObj.SaveAcceptXmlDataToFile() '将接收到的xml数据存入txt文件
Err.clear
Dim message

Dim sysno,username,pwd,email,PageName,PageURL
sysno = XmlClassObj.AcceptSingleNode("//sysno")
username = XmlClassObj.AcceptSingleNode("//username")
pwd = XmlClassObj.AcceptSingleNode("//pwd")
email = XmlClassObj.AcceptSingleNode("//email")
PageName = XmlClassObj.AcceptSingleNode("//pagename")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) '存入debug日志文件

If Err Then
message = message & Err.Description
Else
Err.clear
If sysno <> Apisysno Then
message = "请务非法使用!"
Else
message = regUser(username,pwd,email,PageName,PageURL)
End If
End If

'XmlClassObj.SaveDebugStringToFile("message=" & message) '将message值存入debug日志文件
Set XmlClassObj = Nothing '销毁对象实例
Response.ContentType = "text/xml" '输出xml数据流给发送端
Response.Charset = "gb2312"
Response.Clear
Response.Write "" & vbnewline
Response.Write "" & vbnewline
Response.Write "" & message & "" & vbnewline
Response.Write "" & Now() & "" & vbnewline
Response.Write "
" & vbnewline



Function regUser(username,pwd,email,PageName,PageURL)
'''''''''''''''''''
''''''''''''''''''
'''''''''''''''''
'操作数据库注册用户
'''''''''''''''''
'''''''''''''' #p#分页标题#e#
regUser = "OK"
End Function

%>

共有0条评论网友评论

当前没有评论!

加载更多

游戏排行榜