Этот класс asp можно использовать для обработки отправки и получения пакетов XML. Его можно использовать для связи между интерфейсами API между различными гетерогенными системами, а также для обработки вызова и приема веб-служб.
свойство:
строка
адреса получениядля отправки XML.
Только запись
Сообщение: сообщение о системной ошибке
Нить
только для чтения
: получите значение узла в отправленном XML-пакете.
Нить
Параметры только для чтения: Str: имя узла
GetXmlData: получить возвращенный объект данных XML.
XMLDom
только чтение
Метод:
LoadXmlFromFile: заполните параметр объекта XmlDoc Path:xml путь из внешнего XML-файла.
Void
LoadXmlFromString: Заполните строку параметра объекта XmlDoc Str:xml строкой.
Пустота
NodeValue устанавливает параметры узла
Параметр
NodeName Имя узла
NodeText Значение
NodeType Тип сохранения [text=0,cdata=1]
blnEncode Кодировать ли [true, false]
Пустота
SendHttpData: отправить XML-пакет.
PrintSendXmlData: распечатать XML-данные запроса на отправку.
PrintGetXmlData: распечатать возвращаемые XML-данные.
SaveSendXmlDataToFile: сохранить XML-данные запроса на отправку в файл с именем sendxml_date.txt.
SaveGetXmlDataToFile: сохраните возвращенные XML-данные в файл, имя файла — getxml_date.txt
GetSingleNode: получите параметр информации об узле. Nodestring возвращаемого XML: имя узла
AcceptHttpData: получите пакет XML, информация об ошибке получена через объект Message
AcceptSingleNode: Return полученная информация об узле пакета XML. Параметр Nodestring: имя узла.
PrintAcceptXmlData: распечатать данные XML, полученные принимающей стороной.
SaveAcceptXmlDataToFile: сохранить полученные данные пакета XML в файл, имя файла — Acceptxml_date.txt.
SaveDebugStringToFile: сохранить данные отладки в файл с именем debugnote_date.txt.
Параметр Debugstr: информация об отладке.
Код:
xmlcls.asp
<%
Rem обрабатывает отправку и получение классов XML-данных.
'------------------------------------------------ -
«Пожалуйста, сохраняйте информацию об авторских правах при перепечатке.
'Автор: Walkman
Компания: Bubuweiying Technology Co., Ltd.
Веб-сайт: http://www.shouji138.com.
'Версия: ver1.0
'------------------------------------------------ -
Определение переменной
класса XmlClass
Rem
Частный XmlDoc, XmlHttp
Код личного сообщения, SysKey, XmlPath
Частный m_GetXmlDoc,m_url
Частная инициализация m_XmlDocAccept
Rem
Частный подкласс_Initialize()
При ошибке Возобновить Далее
Код сообщения = ""
ХмлПат = ""
Установить XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = Ложь
End Sub
Rem уничтожает объект
Частный подкласс_Terminate()
Если IsObject(XmlDoc), то установите XmlDoc = Ничего
Если IsObject(m_XmlDocAccept), то установите m_XmlDocAccept = Ничего
Если IsObject(m_GetXmlDoc), то установите m_GetXmlDoc = Ничего
Конец субтитра
'Определение публичного атрибута начинается --------------------------
Сообщение об ошибке удаления
Открытая собственность Получить сообщение()
Сообщение = Код сообщения
Конечная собственность
Удалить адрес для отправки XML
Публичная собственность Let URL(str)
m_url = ул
Конечная собственность
'Конец определения публичного атрибута --------------------------
'Запуск частного процесса и метода --------------------------
Освободить загрузку XML
Частная подпрограмма LoadXmlData()
Если XmlPath <> "" Тогда
Если не XmlDoc.Load(XmlPath), Тогда
XmlDoc.LoadXml "<?xml version=""1.0""coding=""gb2312""?><root/>"
Конец, если
Еще
XmlDoc.LoadXml "<?xml version=""1.0""coding=""gb2312""?><root/>"
Конец, если
Завершить
преобразование символов Sub Rem
Частная функция AnsiToUnicode (ByVal str)
Дим i, j, c, i1, i2, u, fs, f, p
АнсиТоЮникод = ""
р = ""
Для i = 1 To Len(str)
c = Mid(str, i, 1)
j = AscW(с)
Если j < 0 Тогда
j = j + 65536
Конец, если
Если j >= 0 и j <= 128 Тогда
Если р = «с» Тогда
AnsiToUnicode = " " & AnsiToUnicode
р = "е"
Конец, если
AnsiToUnicode = AnsiToUnicode & c
Еще
Если р = "е" Тогда
AnsiToUnicode = AnsiToUnicode & " "
р = "с"
Конец, если
AnsiToUnicode = AnsiToUnicode & («&#» & j & «;»)
Конец, если
Следующий
Конечная функция
Преобразование символов Rem
Частная функция strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
Если len1=0, то выходим из функции
Для i = от 1 до len1
varchar=MidB(asContents,i,1)
вараск = AscB (varchar)
Если вараск > 127 Тогда
Если MidB(asContents,i+1,1)<>"" Тогда
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
Конец, если
я=я+1
Еще
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
Конец, если
Следующий
Конечная функция
Rem добавляет символы в файл
Частная подпрограмма WriteStringToFile (имя файла, строка)
При ошибке Возобновить Далее
Дим фс,тс
Set fs= createobject("script_ing.filesystemobject")
Если не IsObject(fs), то выйдите из Sub
Установите ts=fs.OpenTextFile(Server.MapPath(имя файла),8,True)
ts.writeline(стр)
ц.закрыть
Установите ts=Ничего
Установить fs=Ничего
Конец субтитра
'Конец частного процесса и метода --------------------------
'Открытый метод начинается --------------------------
''''''''''' Отправьте XML-часть для начала
Rem заполнить объект XmlDoc из внешнего XML-файла
Публичная подпрограмма LoadXmlFromFile (путь)
XmlPath = Server.MapPath(путь)
ЗагрузитьXmlДанные()
End Sub
Rem заполняет объект XmlDoc строкой.
Публичная подпрограмма LoadXmlFromString(str)
XmlDoc.LoadXml строка
End Sub
Rem Установите параметры узла, такие как 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)
Тусклый дочерний узел, CreateCDATASection
ИмяУзла = Lcase(ИмяУзла)
Если XmlDoc.documentElement.selectSingleNode(NodeName) ничего не значит Тогда
Set ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Еще
Установить ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
Конец, если
Если blnEncode = True Тогда
NodeText = AnsiToUnicode(NodeText)
Конец, если
Если NodeType = 1 Тогда
ДетскийУзел.Текст = ""
Установите CreateCDATASection = XmlDoc.createCDATASection(Replace(NodeText,"]]>","]]>"))
ChildNode.appendChild(createCDATASection)
Еще
ДетскийУзел.Текст = Текст узла
Конец, если
Конец субтитра
'------------------------------------------------ -
'Получаем значение узла в отправленном пакете XML
'параметр:
'Str имя узла
'------------------------------------------------ -
Открытое свойство GetXmlNode(ByvalStr)
Если XmlDoc.documentElement.selectSingleNode(Str) равен нулю, тогда
XmlNode = "Ноль"
Еще
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).text
Конец, если
Конечное свойство
'----------------------------------------------- -- ---
'Получаем возвращенный объект данных XML
'пример:
'Если GetXmlData не равно NULL, GetXmlData является объектом XML
'------------------------------------------------ -
Открытая собственность GetXmlData()
Установите GetXmlData = m_GetXmlDoc
Конечная собственность
'------------------------------------------------ -
'Отправить XML-пакет на http://www.devdao.com/
'------------------------------------------------ -
Публичная подпрограмма SendHttpData()
Dim я, GetXmlDoc, LoadAppid
Установите Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Set GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' Возвращает XML-пакет
XmlHttp.Open "POST", m_url, false
XmlHttp.SetRequestHeader "тип содержимого", "текст/xml"
XmlHttp.Отправить XmlDoc
'Response.Write strAnsi2Unicode(xmlhttp.responseBody)
Если GetXmlDoc.load(XmlHttp.responseXML) Тогда
Установите m_GetXmlDoc = GetXmlDoc.
Еще
MessageCode = "Ошибка при запросе данных!"
Выход из подзаголовка
Конец, если
Установить GetXmlDoc = Ничего
Установить XmlHttp = Ничего
Конец субтитра
'------------------------------------------------ -
'Распечатать XML-данные запроса на отправку
'------------------------------------------------ -
Публичная подпрограмма PrintSendXmlData()
Ответ.Очистить
Response.ContentType = "текст/xml"
Response.CharSet = "gb2312"
Ответ.Истекает = 0
Response.Write "<?xml version=""1.0""coding=""gb2312""?>"&vbNewLine
Response.Write XmlDoc.documentElement.XML
Завершить подписку
'----------------------------------------------- -- ---
'Распечатать возвращенные XML-данные
'------------------------------------------------ -
Публичная подпрограмма PrintGetXmlData()
Ответ.Очистить
Response.ContentType = "текст/xml"
Response.CharSet = "gb2312"
Ответ.Истекает = 0
Если IsObject(m_GetXmlDoc) Тогда
Response.Write "<?xml version=""1.0""coding=""gb2312""?>"&vbNewLine
Response.Write m_GetXmlDoc.documentElement.XML
Еще
Response.Write "<?xml version=""1.0""coding=""gb2312""?><root></root>"
Конец, если
Конец субтитра
Рем сохраняет XML-данные запроса на отправку в файл с именем sendxml_date.txt.
Публичная подпрограмма SaveSendXmlDataToFile()
Тусклое имя файла,str
имя файла = «sendxml_» и DateValue (сейчас) и «.txt»
ул = ""
str = str & ""& Now() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & "<?xml version=""1.0""coding=""gb2312""?>" & vbNewLine
str = str & XmlDoc.documentElement.XML & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile имя файла,str
Конец субтитра
Рем сохраняет возвращенные XML-данные в файл с именем getxml_date.txt.
Публичная подпрограмма SaveGetXmlDataToFile()
Тусклое имя файла,str
имя файла = «getxml_» и DateValue (сейчас) и «.txt»
ул = ""
str = str & ""& Now() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
Если IsObject(m_GetXmlDoc) Тогда
str = str & "<?xml version=""1.0""coding=""gb2312""?>" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Еще
str = str & "<?xml version=""1.0""coding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Конец, если
ул = ул и vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile имя файла,str
Конец субтитра
'------------------------------------------------ -
'Получаем информацию об узле возвращенного XML
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Открытая функция GetSingleNode(nodestring)
Если IsObject(m_GetXmlDoc) Тогда
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).text
Еще
GetSingleNode = ""
Конец, если
Конечная функция
''''''''''''''''''Конец отправки XML-части
''''''''''''''''''Начинается приемная часть xml
'------------------------------------------------ -
'Получить XML-пакет, информация об ошибке получена через объект Message
'------------------------------------------------ -
Открытая функция AcceptHttpData()
Тусклый XMLдом
Установите XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = Ложь
XMLdom.Load(Запрос)
Если XMLdom.parseError.errorCode <> 0 Тогда
MessageCode = "Невозможно правильно получить данные" & "Descript_ion: " & XMLdom.parseError.reason & "<br>Line: " & XMLdom.parseError.Line
Установите m_XmlDocAccept = Null
Еще
Установите m_XmlDocAccept = XMLdom
Конец, если
Конечная функция
'----------------------------------------------- -- ---
'Возврат для получения информации об узле пакета XML
'XmlClassObj.GetSingleNode("//msg")
'------------------------------------------------ -
Открытая функция AcceptSingleNode(nodestring)
Если IsObject(m_XmlDocAccept) Тогда
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).text
Еще
AcceptSingleNode = ""
Конец, если
Конечная функция
'------------------------------------------------ -
'Распечатать XML-данные, полученные принимающей стороной
'------------------------------------------------ -
Публичная подпрограмма PrintAcceptXmlData()
Ответ.Очистить
Response.ContentType = "текст/xml"
Response.CharSet = "gb2312"
Ответ.Истекает = 0
Если IsObject(m_XmlDocAccept) Тогда
Response.Write "<?xml version=""1.0""coding=""gb2312""?>"&vbNewLine
Response.Write m_XmlDocAccept.documentElement.XML
Еще
Response.Write "<?xml version=""1.0""coding=""gb2312""?><root></root>"
Конец, если
Конец субтитра
Рем сохраняет полученные данные XML-пакета в файл с именем Acceptxml_date.txt.
Публичная подпрограмма SaveAcceptXmlDataToFile()
Тусклое имя файла,str
имя файла = «acceptxml_» и DateValue (сейчас) и «.txt»
ул = ""
str = str & ""& Now() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
Если IsObject(m_XmlDocAccept) Тогда
str = str & "<?xml version=""1.0""coding=""gb2312""?>" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Еще
str = str & "<?xml version=""1.0""coding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Конец, если
ул = ул и vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile имя файла,str
End Sub
''''''''''''''''''Получите XML-часть и завершите
Rem. Сохраните данные отладки в файл с именем debugnote_date.txt.
Публичная подпрограмма SaveDebugStringToFile(debugstr)
Тусклое имя файла,str
имя_файла = "debugnote_" и DateValue(сейчас) & ".txt"
ул = ""
str = str & ""& Now() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & debugstr & vbNewLine
str = str & "--------------------------------------------- --- "
str = str & vbNewLine & vbNewLine & vbNewLine
WriteStringToFile имя файла,str
End Sub
'Конец общедоступного метода --------------------------
Конец класса
%>
Тестовый пример:
sendxml.asp
<%
Опция Explicit
Response.buffer = True
Ответ.Истекает=-1
%>
<!--#include file="xmlcls.asp"-->
<%
Const Apisysno = "23498927347234234987"
Const ActionURL = " http://www.shouji138.com/aspnet2/acceptxml.asp " Rem отвечает на URL-адрес записи файла.
Димксмлклассобдж
Set XmlClassObj = new XmlClass 'Создать объект
XmlClassObj.LoadXmlFromString("<?xml version=""1.0""coding=""gb2312""?><root/>") 'Заполните объект XMLDOC символами XML и используйте его для отправки XML
XmlClassObj.URL = ActionURL 'Установить URL-адрес ответа
Rem-формат xml
Rem "<?xml version="1.0"coding="gb2312"?>
Рем <корень>
Рем <sysno></sysno>
Рем <имя пользователя></имя пользователя>
Рем <pwd></pwd>
Рем <email></email>
Рем <имя страницы></имя страницы>
Рем <pageurl></pageurl>
Рем </root>
XmlClassObj.NodeValue "sysno",Apisysno,0,False
XmlClassObj.NodeValue "имя пользователя", "testusername", 0, False
XmlClassObj.NodeValue "pwd", "pwd", 0, False
XmlClassObj.NodeValue "электронная почта", " [email protected]", 0, False
XmlClassObj.NodeValue «имя страницы», «сайт», 0, False
XmlClassObj.NodeValue "pageurl"," http://www.shouji138.com",1,False
)
'Сохраняем отправленный пакет базы данных XML в текстовый
файл. PrintGetXmlData() 'Распечатываем полученные данные XML
'response.write XmlClassObj.Message 'Распечатать сообщение об ошибке
XmlClassObj.SaveGetXmlDataToFile() 'Сохраняем полученную базу данных xml в текстовый файл
response.write XmlClassObj.GetSingleNode("//message") 'Отобразить значение узла msg полученных XML-данных
Set XmlClassObj = Nothing 'Уничтожить экземпляр объекта
%>
Acceptxml.asp
<%
Интерфейс регистрации пользователя Rem Api
%>
<%
Ответ.Истекает = -1
Response.Addheader "pragma","no-cache"
Response.AddHeader «управление кешем», «без хранилища»
%>
<!--#Include File="xmlcls.asp"-->
<%
Rem-формат xml
Rem "<?xml version="1.0"coding="gb2312"?>
Рем <корень>
Рем <sysno></sysno>
Рем <имя пользователя></имя пользователя>
Рем <pwd></pwd>
Рем <email></email>
Рем <имя страницы></имя страницы>
Рем <pageurl></pageurl>
Рем </root>
Const Apisysno = "23498927347234234987"
При ошибке Возобновить Далее
Димксмлклассобдж
Set XmlClassObj = new XmlClass 'Создать объект
XmlClassObj.AcceptHttpData() 'Получаем данные XML
XmlClassObj.SaveAcceptXmlDataToFile() 'Сохраняем полученные XML-данные в текстовый файл
Ошиб.очистить
Тусклое сообщение
Dim sysno, имя пользователя, пароль, адрес электронной почты, имя страницы, URL-адрес страницы
sysno = XmlClassObj.AcceptSingleNode("//sysno")
имя пользователя = XmlClassObj.AcceptSingleNode("//имя пользователя")
pwd = XmlClassObj.AcceptSingleNode("//pwd")
электронная почта = XmlClassObj.AcceptSingleNode("//email")
PageName = XmlClassObj.AcceptSingleNode("//имя_страницы")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) 'Сохранить в файл журнала отладки
Если Ошибка Тогда
сообщение = сообщение и Err.Descript_ion
Еще
Ошиб.очистить
Если сисно <> Аписисно Тогда
message = "Пожалуйста, не используйте его незаконно!"
Еще
сообщение = regUser(имя пользователя,пароль,электронная почта,имя_страницы,URL_страницы)
Конец, если
Конец, если
'XmlClassObj.SaveDebugStringToFile("message=" & message) 'Сохраните значение сообщения в файле журнала отладки.
Set XmlClassObj = Nothing 'Уничтожьте экземпляр объекта
. Response.ContentType = "text/xml" 'Выведите поток данных XML отправителю
Response.Charset = "gb2312"
Ответ.Очистить
Response.Write "<?xml version=""1.0""coding=""gb2312""?>" и vbnewline
Response. Напишите «<root>» и vbnewline.
Response.Write "<message>" & message & "</message>" & vbnewline
Response.Write "<nowtime>" & Now() & "</nowtime>" & vbnewline
Response.Write "</root>" и
функция vbnewline regUser(username,pwd,email,PageName,PageURL)
'''''''''''''''''
''''''''''''''''
''''''''''''''''
'Работа с зарегистрированными пользователями базы данных
''''''''''''''''
''''''''''''''
regUser = «ОК»
Завершение функции
%>
Адрес загрузки:/u/info_img/2009-06/25/Xmlcls.rarДемо-адрес
: http://www.shouji138.com/aspnet2/sendxml.asp