悠悠博客 提供视频转换器,3gp格式转换器免费下载

来自leadbbs 作者 Xinsoft
<%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
''''  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 "<P>Some error found in your xml document.</P>"
       
       Dim xPE
       Set xPE = xmlDoc.parseError
       
       Response.Write "<p>xmlDoc.parseError.reason = "& xPE.reason &"</p>"
       Response.Write "<p>xmlDoc.parseError.filepos = "& xPE.filepos &"</p>"
       Response.Write "<p>xmlDoc.parseError.line = "& xPE.line &"</p>"
       Response.Write "<p>xmlDoc.parseError.linepos = "& xPE.linepos &"</p>"
       Response.Write "<p>xmlDoc.parseError.srcText = "& xPE.srcText &"</p>"
       Response.Write "<p>xmlDoc.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 "<p>objXML.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 SingleNode<hr />" & vbCrLf

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

Response.Write "<hr />Test NodeVal<hr />" & vbCrLf
Response.Write "objXML.NodeVal(""/blogtech/description"")=" & objXML.NodeVal("/blogtech/description") & vbCrLf




Response.Write "<hr />Test XpathNodesLength and NodeValInList<hr />" & vbCrLf

N=objXML.XpathNodesLength("/blogtech/item/link")
Response.Write "<p>objXML.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

%>