Kelas asp ini dapat digunakan untuk menangani pengiriman dan penerimaan paket xml. Ini dapat digunakan untuk komunikasi antara antarmuka API antara berbagai sistem heterogen, dan untuk memproses pemanggilan dan penerimaan Layanan Web.
milik:
String
alamat penerimauntuk mengirim xml
Tulis
Pesan saja: pesan kesalahan sistem
Rangkaian
hanya-baca
: Dapatkan nilai simpul dalam paket XML yang dikirim
Rangkaian
Parameter baca-saja: Str: nama simpul
GetXmlData: Dapatkan objek data XML yang dikembalikan
XMLDom
hanya baca
Metode:
LoadXmlFromFile: Isi parameter objek XmlDoc Path: jalur xml dari file xml eksternal
Void
LoadXmlFromString: Isi parameter objek XmlDoc Str:xml string dengan string
Ruang kosong
NodeValue menetapkan parameter node
Parameter
NodeName Nama node
NodeText Nilai
NodeType Simpan jenis [teks=0,cdata=1]
blnEncode Apakah akan menyandikan [benar, salah]
Ruang kosong
SendHttpData: Kirim paket xml
PrintSendXmlData: Cetak kirim permintaan data XML
PrintGetXmlData: Cetak kembali data XML
SaveSendXmlDataToFile: Simpan data kirim permintaan xml ke file, nama filenya adalah sendxml_date.txt
SaveGetXmlDataToFile: Simpan data XML yang dikembalikan ke file, nama file adalah getxml_date.txt
GetSingleNode: Dapatkan parameter informasi node Nodestring dari xml yang dikembalikan: nama node
AcceptHttpData: Menerima paket XML, informasi kesalahan diperoleh melalui objek Pesan
AcceptSingleNode: Return informasi node paket XML yang diterima Parameter Nodestring: nama node
PrintAcceptXmlData: mencetak data XML yang diterima oleh pihak penerima
SaveAcceptXmlDataToFile: menyimpan data paket XML yang diterima ke file, nama file adalahacceptxml_date.txt
SaveDebugStringToFile: Menyimpan data debug ke file bernama debugnote_date.txt
Parameter Debugstr: informasi debug
Kode:
xmlcls.asp
<%
Rem menangani pengiriman dan penerimaan kelas data xml
'------------------------------------------------ -
'Harap simpan informasi hak cipta saat mencetak ulang
'Penulis: walkman
'Perusahaan: Bubuweiying Technology Co., Ltd.
'Situs web: http://www.shouji138.com
'Versi: ver1.0
'------------------------------------------------ -
Definisi variabel
Kelas XMLKelas
Rem
XmlDoc Pribadi, XmlHttp
Kode Pesan Pribadi, SysKey, XmlPath
m_GetXmlDoc pribadi,m_url
m_XmlDocAccept
Rem
pribadi
Sub Kelas Pribadi_Inisialisasi()
Pada Kesalahan Lanjutkan Berikutnya
Kode Pesan = ""
XmlJalur = ""
Setel XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
XmlDoc.ASYNC = Salah
End Sub
Rem menghancurkan objek tersebut
Sub Kelas_Terminate() Pribadi
Jika IsObject(XmlDoc) Kemudian Setel XmlDoc = Tidak Ada
Jika IsObject(m_XmlDocAccept) Kemudian Setel m_XmlDocAccept = Tidak Ada
Jika IsObject(m_GetXmlDoc) Kemudian Setel m_GetXmlDoc = Tidak Ada
Akhiri Sub
'Definisi atribut publik dimulai --------------------------
Pesan kesalahan rem
Properti Publik Dapatkan Pesan()
Pesan = Kode Pesan
Properti Akhir
Rem alamat tujuan pengiriman xml
URL Izinkan Properti Publik (str)
m_url = str
Properti Akhir
'Akhir dari definisi atribut publik --------------------------
'Proses dan metode pribadi dimulai --------------------------
Rem memuat xml
Sub LoadXmlData Pribadi()
Jika XmlPath <> "" Lalu
Jika Bukan XmlDoc.Load(XmlPath) Lalu
XmlDoc.LoadXml "<?xml version=""1.0"" pengkodean=""gb2312""?><root/>"
Akhiri Jika
Kalau tidak
XmlDoc.LoadXml "<?xml version=""1.0"" pengkodean=""gb2312""?><root/>"
Akhiri Jika
Akhiri
konversi karakter Sub Rem
Fungsi Pribadi AnsiToUnicode(ByVal str)
Redupkan i, j, c, i1, i2, u, fs, f, p
AnsiToUnicode = ""
hal = ""
Untuk i = 1 Ke Len(str)
c = Tengah(str, i, 1)
j = AscW(c)
Jika j < 0 Maka
j = j + 65536
Akhiri Jika
Jika j >= 0 Dan j <= 128 Maka
Jika p = "c" Maka
AnsiToUnicode = " " & AnsiToUnicode
p = "e"
Akhiri Jika
AnsiToUnicode = AnsiToUnicode & c
Kalau tidak
Jika p = "e" Maka
AnsiToUnicode = AnsiToUnicode & " "
p = "c"
Akhiri Jika
AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")
Akhiri Jika
Berikutnya
Konversi karakter Rem
Fungsi Akhir
Fungsi Pribadi strAnsi2Unicode(asContents)
Redupkan len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(sebagaiIsi)
Jika len1=0 Kemudian Keluar dari Fungsi
Untuk i=1 hingga len1
varchar=MidB(sebagaiIsi,i,1)
varasc=AscB(varchar)
Jika varasc > 127 Maka
Jika MidB(asContents,i+1,1)<>"" Lalu
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
Akhiri Jika
saya=saya+1
Kalau tidak
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
Akhiri Jika
Berikutnya
Fungsi Akhir
Rem menambahkan karakter ke file
Sub Pribadi WriteStringToFile(nama file,str)
Pada Kesalahan Lanjutkan Berikutnya
Redupkan fs,ts
Setel fs= buat objek("script_ing.filesystemobject")
Jika Bukan IsObject(fs) Kemudian Keluar dari Sub
Setel ts=fs.OpenTextFile(Server.MapPath(nama file),8,True)
ts.writeline(str)
ts.tutup
Tetapkan ts=Tidak ada
Tetapkan fs=Tidak ada
Akhiri Sub
'Proses dan metode pribadi berakhir --------------------------
'Metode publik dimulai --------------------------
''''''''''' Kirim bagian xml untuk memulai
Rem mengisi objek XmlDoc dari file xml eksternal
Sub Publik LoadXmlFromFile(jalur)
XmlPath = Server.MapPath(jalur)
MemuatXmlData()
End Sub
Rem mengisi objek XmlDoc dengan string
Sub Publik LoadXmlFromString(str)
XmlDoc.LoadXml str
End Sub
Rem Tetapkan parameter node seperti NodeValue "appID",AppID,1,False
'------------------------------------------------ -
'parameter:
'Nama simpul NodeName
'Nilai NodeTeks
'Jenis penyimpanan NodeType [teks=0,cdata=1]
'blnEncode apakah akan menyandikan [benar, salah]
'------------------------------------------------ -
Sub NodeValue Publik (Byval NodeName, Byval NodeText, Byval NodeType, Byval blnEncode)
Redupkan ChildNode, Buat Bagian CDATA
NamaNode = Lcase(NamaNode)
Jika XmlDoc.documentElement.selectSingleNode(NodeName) bukan apa-apa, maka
Setel ChildNode = XmlDoc.documentElement.appendChild(XmlDoc.createNode(1,NodeName,""))
Kalau tidak
Setel ChildNode = XmlDoc.documentElement.selectSingleNode(NodeName)
Akhiri Jika
Jika blnEncode = Benar Maka
NodeTeks = AnsiToUnicode(NodeTeks)
Akhiri Jika
Jika NodeType = 1 Maka
ChildNode.Teks = ""
Setel CreateCDATASection = XmlDoc.createCDATASection(Ganti(NodeText,"]]>","]]>"))
ChildNode.appendChild(buatCDATASection)
Kalau tidak
ChildNode.Teks = NodeTeks
Akhiri Jika
Akhiri Sub
'------------------------------------------------ -
'Dapatkan nilai node dalam paket XML yang dikirim
'parameter:
'Nama simpul str
'------------------------------------------------ -
Properti Publik GetXmlNode(ByvalStr)
Jika XmlDoc.documentElement.selectSingleNode(Str) Bukan Apa-apa, Maka
XmlNode = "Nol"
Kalau tidak
XmlNode = XmlDoc.documentElement.selectSingleNode(Str).teks
Akhiri Jika
Properti Akhir
'----------------------------------------------- -- ---
'Dapatkan objek data XML yang dikembalikan
'contoh:
'Jika GetXmlData bukan NULL, GetXmlData adalah objek XML
'------------------------------------------------ -
Properti Publik Dapatkan GetXmlData()
Setel GetXmlData = m_GetXmlDoc
Properti Akhir
'------------------------------------------------ -
'Kirim paket xml ke http://www.devdao.com/
'------------------------------------------------ -
Sub Publik SendHttpData()
Redupkan saya,GetXmlDoc,LoadAppid
Setel Xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
Setel GetXmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0") ' Kembalikan paket xml
XmlHttp.Buka "POST", m_url, false
XmlHttp.SetRequestHeader "tipe konten", "teks/xml"
XmlHttp.Kirim XmlDoc
'Respon.Tulis strAnsi2Unicode(xmlhttp.responseBody)
Jika GetXmlDoc.load(XmlHttp.responseXML) Lalu
Setel m_GetXmlDoc = GetXmlDoc
Kalau tidak
MessageCode = "Kesalahan dalam meminta data!"
Keluar dari Sub
Akhiri Jika
Setel GetXmlDoc = Tidak Ada
Setel XmlHttp = Tidak Ada
Akhiri Sub
'------------------------------------------------ -
'Cetak data XML permintaan pengiriman
'------------------------------------------------ -
Sub Publik PrintSendXmlData()
Respon. Jelas
Response.ContentType = "teks/xml"
Respon.CharSet = "gb2312"
Respon. Kedaluwarsa = 0
Respons.Tulis "<?xml version=""1.0"" coding=""gb2312""?>"&vbNewLine
Respon.Tulis XmlDoc.documentElement.XML
Sub Akhir
'----------------------------------------------- -- ---
'Cetak data XML yang dikembalikan
'------------------------------------------------ -
Sub Publik PrintGetXmlData()
Respon. Jelas
Response.ContentType = "teks/xml"
Respon.CharSet = "gb2312"
Respon. Kedaluwarsa = 0
Jika IsObject(m_GetXmlDoc) Lalu
Respons.Tulis "<?xml version=""1.0"" coding=""gb2312""?>"&vbNewLine
Respon.Tulis m_GetXmlDoc.documentElement.XML
Kalau tidak
Respons.Tulis "<?xml version=""1.0"" coding=""gb2312""?><root></root>"
Akhiri Jika
Akhiri Sub
Rem menyimpan data xml permintaan pengiriman ke file bernama sendxml_date.txt
Sub Publik SaveSendXmlDataToFile()
Redupkan nama file, str
nama file = "sendxml_" & DateValue(sekarang) & ".txt"
str = ""
str = str & ""& Sekarang() & 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
Nama file WriteStringToFile, str
Akhiri Sub
Rem menyimpan data XML yang dikembalikan ke file bernama getxml_date.txt
Sub Publik SaveGetXmlDataToFile()
Redupkan nama file, str
nama file = "getxml_" & DateValue(sekarang) & ".txt"
str = ""
str = str & ""& Sekarang() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
Jika IsObject(m_GetXmlDoc) Lalu
str = str & "<?xml version=""1.0"" coding=""gb2312""?>" & vbNewLine
str = str & m_GetXmlDoc.documentElement.XML
Kalau tidak
str = str & "<?xml version=""1.0"" coding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Akhiri Jika
str = str & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
Nama file WriteStringToFile, str
Akhiri Sub
'------------------------------------------------ -
'Dapatkan informasi simpul dari xml yang dikembalikan
'XmlClassObj.GetSingleNode("//pesan")
'------------------------------------------------ -
Fungsi Publik GetSingleNode(nodestring)
Jika IsObject(m_GetXmlDoc) Lalu
GetSingleNode = m_GetXmlDoc.documentElement.selectSingleNode(nodestring).teks
Kalau tidak
DapatkanSingleNode = ""
Akhiri Jika
Fungsi Akhir
''''''''''''''''''Akhir pengiriman bagian xml
''''''''''''''''''Bagian xml penerimaan dimulai
'------------------------------------------------ -
'Terima paket XML, informasi kesalahan diperoleh melalui objek Pesan
'------------------------------------------------ -
Fungsi Publik AcceptHttpData()
Redupkan XMLdom
Setel XMLdom = Server.CreateObject("Microsoft.XMLDOM")
XMLdom.Async = Salah
XMLdom.Muat(Permintaan)
Jika XMLdom.parseError.errorCode <> 0 Lalu
MessageCode = "Tidak dapat menerima data dengan benar" & "Descript_ion: " & XMLdom.parseError.reason & "<br>Baris: " & XMLdom.parseError.Line
Setel m_XmlDocAccept = Null
Kalau tidak
Setel m_XmlDocAccept = XMLdom
Akhiri Jika
Fungsi Akhir
'----------------------------------------------- -- ---
'Kembali untuk menerima informasi simpul paket XML
'XmlClassObj.GetSingleNode("//pesan")
'------------------------------------------------ -
Fungsi Publik AcceptSingleNode (nodestring)
Jika IsObject(m_XmlDocAccept) Lalu
AcceptSingleNode = m_XmlDocAccept.documentElement.selectSingleNode(nodestring).teks
Kalau tidak
TerimaSingleNode = ""
Akhiri Jika
Fungsi Akhir
'------------------------------------------------ -
'Cetak data XML yang diterima oleh pihak penerima
'------------------------------------------------ -
Sub Publik PrintAcceptXmlData()
Respon. Jelas
Response.ContentType = "teks/xml"
Respon.CharSet = "gb2312"
Respon. Kedaluwarsa = 0
Jika IsObject(m_XmlDocAccept) Lalu
Respons.Tulis "<?xml version=""1.0"" coding=""gb2312""?>"&vbNewLine
Respon.Tulis m_XmlDocAccept.documentElement.XML
Kalau tidak
Respons.Tulis "<?xml version=""1.0"" coding=""gb2312""?><root></root>"
Akhiri Jika
Akhiri Sub
Rem menyimpan data paket XML yang diterima ke file bernamaacceptxml_date.txt
Sub Publik SaveAcceptXmlDataToFile()
Redupkan nama file, str
nama file = "acceptxml_" & DateValue(sekarang) & ".txt"
str = ""
str = str & ""& Sekarang() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
Jika IsObject(m_XmlDocAccept) Lalu
str = str & "<?xml version=""1.0"" coding=""gb2312""?>" & vbNewLine
str = str & m_XmlDocAccept.documentElement.XML
Kalau tidak
str = str & "<?xml version=""1.0"" coding=""gb2312""?>" & vbNewLine & "<root>" & vbNewLine & "</root>"
Akhiri Jika
str = str & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & vbNewLine & vbNewLine & vbNewLine
Nama file WriteStringToFile, str
Akhiri Sub
'''''''''''''''''''Terima bagian xml dan akhiri
Rem Simpan data debug ke file bernama debugnote_date.txt
Sub Publik SaveDebugStringToFile(debugstr)
Redupkan nama file, str
nama file = "debugnote_" & DateValue(sekarang) & ".txt"
str = ""
str = str & ""& Sekarang() & vbNewLine
str = str & "--------------------------------------------- --- "& vbNewLine
str = str & debugstr & vbNewLine
str = str & "--------------------------------------------- --- "
str = str & vbNewLine & vbNewLine & vbNewLine
Nama file WriteStringToFile, str
Akhir Sub
'Akhir dari metode publik--------------------------
Akhir Kelas
%>
Kasus uji:
sendxml.asp
<%
Opsi
Respon Eksplisit.buffer = Benar
Respon.Kedaluwarsa=-1
%>
<!--#include file="xmlcls.asp"-->
<%
Const Apisysno = "23498927347234234987"
Const ActionURL = " http://www.shouji138.com/aspnet2/acceptxml.asp " Rem merespons alamat URL penulisan file
DimXmlClassObj
Setel XmlClassObj = new XmlClass 'Buat objek
XmlClassObj.LoadXmlFromString("<?xml version=""1.0"" coding=""gb2312""?><root/>") 'Isi objek XMLDOC dengan karakter xml dan gunakan untuk mengirim xml
XmlClassObj.URL = ActionURL 'Setel url tanggapan
Format rem xml
Rem "<?xml versi="1.0" pengkodean="gb2312"?>
Rem <root>
Rem <sysno></sysno>
Rem <nama pengguna></nama pengguna>
Rem <pwd></pwd>
Rem <email></email>
Rem <namahalaman></namahalaman>
Rem <pageurl></pageurl>
Rem </root>
XmlClassObj.NodeValue "sysno",Apisysno,0,False
XmlClassObj.NodeValue "nama pengguna", "nama pengguna uji", 0, Salah
XmlClassObj.NodeValue "pwd", "pwd",0,False
XmlClassObj.NodeValue "email"," [email protected]",0,False
XmlClassObj.NodeValue "nama halaman", "situs",0,False
XmlClassObj.NodeValue "pageurl"," http://www.shouji138.com",1,False
)
'Simpan paket database xml yang dikirim ke dalam
file txt .PrintGetXmlData() 'Cetak data xml yang diterima
'response.write XmlClassObj.Message 'Pesan kesalahan cetak
XmlClassObj.SaveGetXmlDataToFile() 'Simpan database xml yang diterima ke dalam file txt
respon.write XmlClassObj.GetSingleNode("//message") 'Menampilkan nilai node pesan dari data xml yang diterima
Set XmlClassObj = Nothing 'Hancurkan instance objek
%>
terimaxml.asp
<%
Antarmuka pendaftaran pengguna Rem Api
%>
<%
Respon.Kedaluwarsa= -1
Respon.Addheader "pragma", "tanpa cache"
Response.AddHeader "kontrol cache", "tidak ada penyimpanan"
%>
<!--#Sertakan File="xmlcls.asp"-->
<%
Format rem xml
Rem "<?xml versi="1.0" pengkodean="gb2312"?>
Rem <root>
Rem <sysno></sysno>
Rem <nama pengguna></nama pengguna>
Rem <pwd></pwd>
Rem <email></email>
Rem <namahalaman></namahalaman>
Rem <pageurl></pageurl>
Rem </root>
Const Apisysno = "23498927347234234987"
Pada Kesalahan Lanjutkan Berikutnya
DimXmlClassObj
Setel XmlClassObj = new XmlClass 'Buat objek
XmlClassObj.AcceptHttpData() 'Terima data xml
XmlClassObj.SaveAcceptXmlDataToFile() 'Simpan data xml yang diterima ke dalam file txt
Err.jelas
Pesan redup
Redupkan sysno,nama pengguna,pwd,email,NamaHalaman,URLHalaman
sysno = XmlClassObj.AcceptSingleNode("//sysno")
nama pengguna = XmlClassObj.AcceptSingleNode("//nama pengguna")
pwd = XmlClassObj.AcceptSingleNode("//pwd")
email = XmlClassObj.AcceptSingleNode("//email")
NamaLaman = XmlClassObj.AcceptSingleNode("//namahalaman")
PageURL = XmlClassObj.AcceptSingleNode("//pageurl")
XmlClassObj.SaveDebugStringToFile("sysno=" & sysno) 'Simpan ke file log debug
Jika Salah Lalu
pesan = pesan & Err.Descript_ion
Kalau tidak
Err.jelas
Jika sysno <> Apisysno Lalu
message = "Tolong jangan menggunakannya secara ilegal!"
Kalau tidak
pesan = regUser(nama pengguna,pwd,email,NamaHalaman,URLHalaman)
Akhiri Jika
Akhiri Jika
'XmlClassObj.SaveDebugStringToFile("message=" & message) 'Simpan nilai pesan ke dalam file log debug
Set XmlClassObj = Nothing 'Hancurkan instance objek
Response.ContentType = "text/xml" 'Output aliran data xml ke pengirim
Respon.Charset = "gb2312"
Respon. Jelas
Respon.Tulis "<?xml version=""1.0"" coding=""gb2312""?>" & vbnewline
Respon.Tulis "<root>" & vbnewline
Respon.Tulis "<message>" & pesan & "</message>" & vbnewline
Respon.Tulis "<nowtime>" & Now() & "</nowtime>" & vbnewline
Respon.Tulis "</root>" & vbnewline
Fungsi regUser(nama pengguna,pwd,email,NamaPage,URLPage)
'''''''''''''''''
''''''''''''''''
''''''''''''''''
'Operasikan basis data pengguna terdaftar
''''''''''''''''
''''''''''''''
regUser =
Fungsi Akhir
"OK".
%>
Alamat unduhan:/u/info_img/2009-06/25/Xmlcls.rarAlamat
demo:http://www.shouji138.com/aspnet2/sendxml.asp