| 導購 | 订阅 | 在线投稿
分享
 
 
當前位置: 王朝網路 >> asp >> asp處理xml數據的發送、接收類
 

asp處理xml數據的發送、接收類

2008-08-05 07:05:04  編輯來源:互聯網  简体版  手機版  評論  字體: ||
 
 
  本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 "<?xml version=""1.0"" encoding=""gb2312""?><root/>"

   End If

   Else

   XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>"

   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 & ";")

   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("script_ing.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,"]]>","]]&gt;"))

   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包 http://www.devdao.com/

  '--------------------------------------------------

  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

   Set XmlHttp = Nothing

  End Sub

  '--------------------------------------------------

  '打印發送請求XML數據

  '--------------------------------------------------

  Public Sub PrintSendXmlData()

   Response.Clear

   Response.ContentType = "text/xml"

   Response.CharSet = "gb2312"

   Response.Expires = 0

   Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&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 "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine

   Response.Write m_GetXmlDoc.documentElement.XML

   Else

   Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"

   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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & 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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine

   str = str & m_GetXmlDoc.documentElement.XML

   Else

   str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"

   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

   MessageCode = "不能正確接收數據" & "Descript_ion: " & XMLdom.parseError.reason & "<br>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 "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine

   Response.Write m_XmlDocAccept.documentElement.XML

   Else

   Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>"

   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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine

   str = str & m_XmlDocAccept.documentElement.XML

   Else

   str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"

   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

  %>

  <!--#include file="xmlcls.asp"-->

  <%

  Const Apisysno = "23498927347234234987"

  Const ActionURL = "http://www.shouji138.com/aspnet2/acceptxml.asp" Rem 響應的文件 寫url地址

  Dim XmlClassObj

  Set XmlClassObj = new XmlClass '創建對象

  XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") '用xml字符填充XMLDOC對象,用來發送xml

  XmlClassObj.URL = ActionURL '設置響應的url

  Rem xml格式

  Rem "<?xml version="1.0" encoding="gb2312"?>

  Rem <root>

  Rem <sysno></sysno>

  Rem <username></username>

  Rem <pwd></pwd>

  Rem <email></email>

  Rem <pagename></pagename>

  Rem <pageurl></pageurl>

  Rem </root>

  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"

  %>

  <!--#Include File="xmlcls.asp"-->

  <%

  Rem xml格式

  Rem "<?xml version="1.0" encoding="gb2312"?>

  Rem <root>

  Rem <sysno></sysno>

  Rem <username></username>

  Rem <pwd></pwd>

  Rem <email></email>

  Rem <pagename></pagename>

  Rem <pageurl></pageurl>

  Rem </root>

  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.Descript_ion

  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 "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline

  Response.Write "<root>" & vbnewline

  Response.Write "<message>" & message & "</message>" & vbnewline

  Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline

  Response.Write "</root>" & vbnewline

  Function regUser(username,pwd,email,PageName,PageURL)

  '''''''''''''''''''

  ''''''''''''''''''

  '''''''''''''''''

  '操作數據庫注冊用戶

  '''''''''''''''''

  ''''''''''''''

  regUser = "OK"

  End Function

  %>

  下載地址:http://www.shouji138.com/files/Xmlcls.rar

  演示地址:http://www.shouji138.com/aspnet2/sendxml.asp
 
 
 
上一篇《關于windows 2003 iis 6.0 asp無法連接access數據庫的解決方法》
下一篇《IIS5 IIS6 IIS7的ASP.net 請求處理過程比較(2)》
 
 
 
 
 
 
日版寵物情人插曲《Winding Road》歌詞

日版寵物情人2017的插曲,很帶節奏感,日語的,女生唱的。 最後聽見是在第8集的時候女主手割傷了,然後男主用嘴幫她吸了一下,插曲就出來了。 歌手:Def...

兄弟共妻,我成了他們夜裏的美食

老鍾家的兩個兒子很特別,就是跟其他的人不太一樣,魔一般的執著。兄弟倆都到了要結婚的年齡了,不管自家老爹怎麽磨破嘴皮子,兄弟倆說不娶就不娶,老父母爲兄弟兩操碎了心...

如何磨出破洞牛仔褲?牛仔褲怎麽剪破洞?

把牛仔褲磨出有線的破洞 1、具體工具就是磨腳石,下面墊一個硬物,然後用磨腳石一直磨一直磨,到把那塊磨薄了,用手撕開就好了。出來的洞啊很自然的。需要貓須的話調幾...

我就是掃描下圖得到了敬業福和愛國福

先來看下敬業福和愛國福 今年春節,支付寶再次推出了“五福紅包”活動,表示要“把欠大家的敬業福都還給大家”。 今天該活動正式啓動,和去年一樣,需要收集“五福”...

冰箱異味産生的原因和臭味去除的方法

有時候我們打開冰箱就會聞到一股異味,冰箱裏的這種異味是因爲一些物質發出的氣味的混合體,聞起來讓人惡心。 産生這些異味的主要原因有以下幾點。 1、很多人有這種習...

《極品家丁》1-31集大結局分集劇情介紹

簡介 《極品家丁》講述了現代白領林晚榮無意回到古代金陵,並追隨蕭二小姐化名“林三”進入蕭府,不料卻陰差陽錯上演了一出低級家丁拼搏上位的“林三升職記”。...

李溪芮《極品家丁》片尾曲《你就是我最愛的寶寶》歌詞

你就是我最愛的寶寶 - 李溪芮 (電視劇《極品家丁》片尾曲) 作詞:常馨內 作曲:常馨內 你的眉 又鬼馬的挑 你的嘴 又壞壞的笑 上一秒吵鬧 下...

烏梅的功效與作用以及烏梅的食用禁忌有哪些?

烏梅,又稱春梅,中醫認爲,烏梅味酸,性溫,無毒,具有安心、除熱、下氣、祛痰、止渴調中、殺蟲的功效,治肢體痛、肺痨病。烏梅泡水喝能治傷寒煩熱、止吐瀉,與幹姜一起制...

什麽是脂肪粒?如何消除臉部脂肪粒?

什麽是脂肪粒 在我們的臉上總會長一個個像脂肪的小顆粒,弄也弄不掉,而且顔色還是白白的。它既不是粉刺也不是其他的任何痘痘,它就是脂肪粒。 脂肪粒雖然也是由油脂...

網絡安全治理:國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰受害者

來源:中國青年報 新的攻擊方法不斷湧現,黑客幾乎永遠占據網絡攻擊的上風,我們不可能通過技術手段杜絕網絡攻擊。國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰...

河南夫妻在溫嶺網絡直播“造人”內容涉黃被刑事拘留

夫妻網絡直播“造人”爆紅   1月9日,溫嶺城北派出所接到南京警方的協查通告,他們近期打掉了一個涉黃直播APP平台。而根據掌握的線索,其中有一對涉案的夫妻主播...

如何防止牆紙老化?牆紙變舊變黃怎麽辦?

如何防止牆紙老化? (1)選擇透氣性好的牆紙 市場上牆紙的材質分無紡布的、木纖維的、PVC的、玻璃纖維基材的、布面的等,相對而言,PVC材質的牆紙最不透氣...

鮮肌之謎非日本生産VS鮮肌之謎假日貨是謠言

觀點一:破日本銷售量的“鮮肌之謎” 非日本生産 近一段時間,淘寶上架了一款名爲“鮮肌之謎的” 鲑魚卵巢美容液,號稱是最近日本的一款推出的全新護膚品,産品本身所...

中國最美古詩詞精選摘抄

系腰裙(北宋詞人 張先) 惜霜蟾照夜雲天,朦胧影、畫勾闌。人情縱似長情月,算一年年。又能得、幾番圓。 欲寄西江題葉字,流不到、五亭前。東池始有荷新綠,尚小如...

關于女人的經典語句

關于女人的經典語句1、【做一個獨立的女人】 思想獨立:有主見、有自己的人生觀、價值觀。有上進心,永遠不放棄自己的理想,做一份自己喜愛的事業,擁有快樂和成就...

未來我們可以和性愛機器人結婚嗎?

你想體驗機器人性愛嗎?你想和性愛機器人結婚嗎?如果你想,機器人有拒絕你的權利嗎? 近日,第二屆“國際人類-機器人性愛研討會”大會在倫敦金史密斯大學落下帷幕。而...

全球最變態的十個地方

10.土耳其地下洞穴城市 變態指數:★★☆☆☆ 這是土耳其卡帕多西亞的一個著名景點,傳說是當年基督教徒們爲了躲避戰爭而在此修建。裏面曾住著20000人,...

科學家稱,人類死亡後意識將在另外一個宇宙中繼續存活

據英國《每日快報》報道,一位科學家兼理論家Robert Lanza博士宣稱,世界上並不存在人類死亡,死亡的只是身體。他認爲我們的意識借助我們體內的能量生存,而且...

《屏裏狐》片頭曲《我愛狐狸精》歌詞是什麽?

《我愛狐狸精》 - 劉馨棋   (電視劇《屏裏狐》主題曲)   作詞:金十三&李旦   作曲:劉嘉   狐狸精 狐狸仙   千年修...

 
 
 
本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 "<?xml version=""1.0"" encoding=""gb2312""?><root/>" End If Else XmlDoc.LoadXml "<?xml version=""1.0"" encoding=""gb2312""?><root/>" 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 & ";") 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("script_ing.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,"]]>","]]&gt;")) 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包 [url=http://www.devdao.com/]http://www.devdao.com/[/url] '-------------------------------------------------- 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 Set XmlHttp = Nothing End Sub '-------------------------------------------------- '打印發送請求XML數據 '-------------------------------------------------- Public Sub PrintSendXmlData() Response.Clear Response.ContentType = "text/xml" Response.CharSet = "gb2312" Response.Expires = 0 Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&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 "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine Response.Write m_GetXmlDoc.documentElement.XML Else Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>" 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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & 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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine str = str & m_GetXmlDoc.documentElement.XML Else str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>" 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 MessageCode = "不能正確接收數據" & "Descript_ion: " & XMLdom.parseError.reason & "<br>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 "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine Response.Write m_XmlDocAccept.documentElement.XML Else Response.Write "<?xml version=""1.0"" encoding=""gb2312""?><root></root>" 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 & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine str = str & m_XmlDocAccept.documentElement.XML Else str = str & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>" 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 %> <!--#include file="xmlcls.asp"--> <% Const Apisysno = "23498927347234234987" Const ActionURL = "[url=http://www.shouji138.com/aspnet2/acceptxml.asp]http://www.shouji138.com/aspnet2/acceptxml.asp[/url]" Rem 響應的文件 寫url地址 Dim XmlClassObj Set XmlClassObj = new XmlClass '創建對象 XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" encoding=""gb2312""?><root/>") '用xml字符填充XMLDOC對象,用來發送xml XmlClassObj.URL = ActionURL '設置響應的url Rem xml格式 Rem "<?xml version="1.0" encoding="gb2312"?> Rem <root> Rem <sysno></sysno> Rem <username></username> Rem <pwd></pwd> Rem <email></email> Rem <pagename></pagename> Rem <pageurl></pageurl> Rem </root> XmlClassObj.NodeValue "sysno",Apisysno,0,False XmlClassObj.NodeValue "username","testusername",0,False XmlClassObj.NodeValue "pwd","pwd",0,False XmlClassObj.NodeValue "email","[url=mailto:web@shouji138.com]web@shouji138.com",0,False[/url] XmlClassObj.NodeValue "pagename","站點",0,False XmlClassObj.NodeValue "pageurl","[url=http://www.shouji138.com]http://www.shouji138.com",1,False[/url] 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" %> <!--#Include File="xmlcls.asp"--> <% Rem xml格式 Rem "<?xml version="1.0" encoding="gb2312"?> Rem <root> Rem <sysno></sysno> Rem <username></username> Rem <pwd></pwd> Rem <email></email> Rem <pagename></pagename> Rem <pageurl></pageurl> Rem </root> 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.Descript_ion 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 "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline Response.Write "<root>" & vbnewline Response.Write "<message>" & message & "</message>" & vbnewline Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline Response.Write "</root>" & vbnewline Function regUser(username,pwd,email,PageName,PageURL) ''''''''''''''''''' '''''''''''''''''' ''''''''''''''''' '操作數據庫注冊用戶 ''''''''''''''''' '''''''''''''' regUser = "OK" End Function %> 下載地址:http://www.shouji138.com/files/Xmlcls.rar 演示地址:http://www.shouji138.com/aspnet2/sendxml.asp
󰈣󰈤
 
 
 
  免責聲明:本文僅代表作者個人觀點,與王朝網路無關。王朝網路登載此文出於傳遞更多信息之目的,並不意味著贊同其觀點或證實其描述,其原創性以及文中陳述文字和內容未經本站證實,對本文以及其中全部或者部分內容、文字的真實性、完整性、及時性本站不作任何保證或承諾,請讀者僅作參考,並請自行核實相關內容。
 
 
小龍女彤彤之情溢皇都
龔潔
智能手機形象美女
崔潔彤
回家的路上----
中國一站(哈爾濱)
清明植物園的花。
桃花堤印象之豎版
 
>>返回首頁<<
 
 熱帖排行
 
 
 
 
© 2005- 王朝網路 版權所有