XML information class Version 1.0

%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
''''　 xml information Class Version 1.0
''''
''''　 Author: Xinsoft [ Xin Yaping ]
''''　 Email:　 XinsoftATk65.net
''''　 Xinsoft , 2005-04-28 Xinsoft DevStudio
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
%%

Class xmlInfo

　　 Public encoding　　　　 '' as String
　
　　 Public NodeCount
　　 Public NodeArray
　
　　 Private xmlURL　　　　　 '' as String
　　 Private xmlDoc　　　　　 '' as Msxml2.DOMDocument.4.0
　
　　 Private ReadyState　 '' as Integer
　　 Private Status　　　　　 '' as Integer
　　 Private LoadSuccess '' as Bool
　　 Private parseError　 '' as Integer
　
　　 Private curSingleNode　　 '' as Node
　　 Private curNodeList　　　　 '' as Node List
　　 Private curXpath　　　　　　　 '' as XPath

Private Sub Class_Initialize
　　 xmlURL=""
　　 encoding="GB2312"
　　 NodeCount=0
　
　　 ReadyState=0
　　 Status=0
　　 LoadSuccess=False
　　 parseError=0
　
　　 Set xmlDoc = CreateObject("Msxml2.DOMDocument.4.0")
End Sub
Private Sub Class_Terminate
　　 Set xmlDoc = Nothing
　
　　 If True = IsObject(NodeArray) Then
　　　　　　 Set NodeArray = Nothing
　　 End If
　　 If True = IsObject(curSingleNode) Then
　　　　　　 Set curSingleNode = Nothing
　　 End If
　　 If True = IsObject(curNodeList) Then
　　　　　　 Set curNodeList = Nothing
　　 End if
End Sub

Function BytesToBstr(strBody,CodeBase)
　　　　　　 dim objStream
　　　　　　 Set objStream = Server.CreateObject("Adodb.Stream")
　　　　　　 objStream.Type = 1
　　　　　　 objStream.Mode = 3
　　　　　　 objStream.Open
　　　　　　 objStream.Write strBody
　　　　　　 objStream.Position = 0
　　　　　　 objStream.Type = 2
　　　　　　 objStream.Charset = CodeBase
　　　　　　 BytesToBstr = objStream.ReadText
　　　　　　 objStream.Close
　　　　　　 Set objStream = Nothing
End Function

Public Function httpGet()
　　　
　　　　 Dim Cont
　　　　 Dim objXMLHttp
　　　
　　　　 Set objXMLHttp=Server.CreateObject("Msxml2.XMLHTTP")
　　　
　　　　 objXMLHttp.open "GET",xmlURL,False
　　　　 objXMLHttp.send()
　　　
　　　　 ReadyState = objXMLHttp.readyState
　　　　 Status = objXMLHttp.status
　　　
　　　　 If 4=ReadyState And 200=Status Then
　　　　　　　　　　 Cont=objXMLHttp.responseBody
　　　　 Else
　　　　　　　　　　 Cont=""
　　　　 End If
　　　
　　　　 Set objXMLHttp=Nothing
　　　
　　　　 Cont=BytesToBstr(Cont,encoding)
　　　
　　　　 httpGet=Cont
End Function

Public Sub PrintParseErrorInfo()
　　 If parseError = 1 Then
　　　　　　
　　　　　　 Response.Write "PSome error found in your xml document./P"
　　　　　　
　　　　　　 Dim xPE
　　　　　　 Set xPE = xmlDoc.parseError
　　　　　　
　　　　　　 Response.Write "pxmlDoc.parseError.reason = "& xPE.reason &"/p"
　　　　　　 Response.Write "pxmlDoc.parseError.filepos = "& xPE.filepos &"/p"
　　　　　　 Response.Write "pxmlDoc.parseError.line = "& xPE.line &"/p"
　　　　　　 Response.Write "pxmlDoc.parseError.linepos = "& xPE.linepos &"/p"
　　　　　　 Response.Write "pxmlDoc.parseError.srcText = "& xPE.srcText &"/p"
　　　　　　 Response.Write "pxmlDoc.parseError.URL = "& xPE.URL &"/p"
　　　　　　
　　　　　　 Set xPE = Nothing
　　　　　　
　　 Else
　　　　　　 Response.Write("")
　　 End if
End Sub

Property Let url( xmlSourceHttp )

　　 Dim Cont
　
　　 xmlURL=xmlSourceHttp
　
　　 xmlDoc.async = False
　　 xmlDoc.validateOnParse = False
　
　　 Cont = httpGet()
　　 LoadSuccess = xmlDoc.LoadXML(Cont)
　　 ReadyState = xmlDoc.ReadyState
　
　　 If xmlDoc.parseError.errorCode 0 Then
　　　　　　 parseError = 1
　　 Else
　　　　　　 parseError = 0
　　 End If
　
　　 ''//If True = LoadSuccess Then
　　 ''//End If

End Property

Property Get url()
　　 url=xmlURL
End Property

Property Let Xpath( path )
　　 curXpath=path
End Property
Property Get Xpath()
　　 Xpath=curXpath
End Property

Property Let SingleNode( Xpath )
　　 curXpath=Xpath
　　 Set curSingleNode=xmlDoc.documentElement.selectSingleNode( curXpath )
End Property
Property Get SingleNode()
　　 Set SingleNode=curSingleNode
End Property

Property Let NodeList( Xpath )
　　 Dim i
　
　　 curXpath=Xpath
　　 Set curNodeList=xmlDoc.documentElement.selectNodes( curXpath )
　
　　 NodeCount=curNodeList.length
　　 ReDim NodeArray(NodeCount)
　　 For i=0 To NodeCount-1
　　　　　　 Set NodeArray(i)=curNodeList.item(i)
　　 Next
　
End Property
Property Get NodeList()
　　 Set NodeList=curNodeList
End Property

Property Get loadStat()
　　 loadStat=LoadSuccess
End Property

Public Function getChildNodeValByName( objNode , ChiidNodeName )
　　 getChildNodeValByName=objNode.selectSingleNode(ChiidNodeName).text
End Function

Property Get ChildValInList( index , ChildName )
　　 ChildValInList=getChildNodeValByName( NodeArray(index) , ChildName )
End Property

Property Get ChildVal( ChildName )
　　 ChildVal=getChildNodeValByName( curSingleNode , ChildName )
End Property

Property Get NodeVal( Xpath )
　　 NodeVal=xmlDoc.documentElement.selectSingleNode( Xpath ).text
End Property

Property Get XpathNodesLength( Xpath )
　　 XpathNodesLength=xmlDoc.documentElement.selectNodes(Xpath).length
End Property

Property Get NodeValInList( Xpath , index )
　　 NodeValInList=xmlDoc.documentElement.selectNodes(Xpath).item(index).text
End Property

End Class

%

　　XML information Class Version 1.0 调用示范

% option explicit %
!-- #include file="../../lib/xml.asp" --
%
Dim Str,i,N

Dim objXML
Set objXML = New xmlInfo

With objXML
　　 .url="http://210.77.146.223/tech/indexxml.php";
　　 .encoding="gb2312"
End With

objXML.NodeList="/blogtech/item"
Response.Write "pobjXML.RecN="&objXML.NodeCount&"/p" & vbCrLf

For i=0 To objXML.NodeCount-1
　　 Response.Write "p"&objXML.ChildValInList(i,"title")&"/p" & vbCrLf
Next

Response.Write "hr /Test SingleNodehr /" & vbCrLf

objXML.SingleNode="/blogtech"
Response.Write "objXML.ChildVal(""description"")="& objXML.ChildVal("description") &"" & vbCrLf

Response.Write "hr /Test NodeValhr /" & vbCrLf
Response.Write "objXML.NodeVal(""/blogtech/description"")=" & objXML.NodeVal("/blogtech/description") & vbCrLf
Response.Write "hr /Test XpathNodesLength and NodeValInListhr /" & vbCrLf

N=objXML.XpathNodesLength("/blogtech/item/link")
Response.Write "pobjXML.XpathNodesLength(""/blogtech/item/link"")="&N&"/p"
For i=0 To N-1
　　 Response.Write "p"& objXML.NodeValInList("/blogtech/item/link",i) &"/p" & vbCrLf
Next

Set objXML = Nothing

%