浏览器

开发平台：
Visual Basic

cRss.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cRss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'---------------------------------------------------------------------------------------
' Module    : cRss
' DateTime  : 2005-8-19 15:05
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Option Explicit
Private Type BookMark
    Title As String
    Url As String
    Description As String
    PubDate As String
End Type
    
Private m_Title$
Private m_Url$
Private m_BMs() As BookMark
Private m_BMsCnt&
Private WithEvents m_XMLDoc As MSXML2.DOMDocument
Attribute m_XMLDoc.VB_VarHelpID = -1
'To fire this event, use RaiseEvent with the following syntax:
'RaiseEvent Changed[(arg1, arg2, ... , argn)]
Public Event Changed()
Public Function GetBmUrl(index As Long) As String
If index > 0 And index <= m_BMsCnt Then
    GetBmUrl = m_BMs(index).Url
End If
End Function
Public Function GetBmTitle(index As Long) As String
If index > 0 And index <= m_BMsCnt Then
    GetBmTitle = m_BMs(index).Title
End If
End Function
Public Function GetBmDescription(index As Long) As String
If index > 0 And index <= m_BMsCnt Then
    GetBmDescription = m_BMs(index).Description
End If
End Function
Public Function GetBmPubdate(index As Long) As String
If index > 0 And index <= m_BMsCnt Then
    GetBmPubdate = m_BMs(index).PubDate
End If
End Function
Public Function GetBmCount() As Long
GetBmCount = m_BMsCnt
End Function
Public Property Let Url(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Url = 5
    m_Url = vData
End Property
Public Property Get Url() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Url
    Url = m_Url
End Property
Public Property Let Title(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Title = 5
    m_Title = vData
End Property
Public Property Get Title() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Title
    Title = m_Title
End Property
Public Sub Save(dest$)
m_XMLDoc.Save dest
End Sub
Public Sub AddItem(vTitle$, vUrl$)
Dim tNode As MSXML2.IXMLDOMNode
Dim tNode2 As MSXML2.IXMLDOMNode
Dim tNode3 As MSXML2.IXMLDOMNode
Dim tcnt&
    Err.Clear
    Set tNode = m_XMLDoc.childNodes.Item(0).childNodes(0)
    If Err.Number = 0 Then
        Set tNode2 = tNode.appendChild(m_XMLDoc.createNode(NODE_ELEMENT, "item", ""))
        Set tNode3 = tNode2.appendChild(m_XMLDoc.createNode(NODE_ELEMENT, "title", ""))
            tNode3.Text = vTitle
        Set tNode3 = tNode2.appendChild(m_XMLDoc.createNode(NODE_ELEMENT, "link", ""))
            tNode3.Text = vUrl
    Else
        Debug.Print "read rss error"
    End If
End Sub
Public Sub RemoveItem(index&)
On Error Resume Next
Dim tNode As MSXML2.IXMLDOMNode
Dim tNodeList As MSXML2.IXMLDOMNodeList
Dim tcnt&
    Err.Clear
    Set tNode = m_XMLDoc.childNodes.Item(0).childNodes(0)
    Set tNodeList = tNode.selectNodes("item")
    
    If Err.Number = 0 Then
        If index >= 0 And index < tNodeList.Length Then
            tNode.removeChild tNodeList.Item(index)
        End If
    Else
        Debug.Print "read rss error"
    End If
End Sub
Public Sub Refresh()
On Error Resume Next
Dim tNode As MSXML2.IXMLDOMNode
Dim tNodeList As MSXML2.IXMLDOMNodeList
Dim tcnt&
If Not m_XMLDoc.documentElement Is Nothing Then
    Err.Clear
    Set tNodeList = m_XMLDoc.selectSingleNode("rss").selectSingleNode("channel").selectNodes("item")
    
    If Err.Number = 0 Then
        m_BMsCnt = tNodeList.Length
        ReDim m_BMs(0 To m_BMsCnt)
        tcnt = 1
        For Each tNode In tNodeList
            m_BMs(tcnt).Title = tNode.selectSingleNode("title").Text
            m_BMs(tcnt).Url = tNode.selectSingleNode("link").Text
            m_BMs(tcnt).Description = ConverHtmlTag(tNode.selectSingleNode("description").Text)
            m_BMs(tcnt).PubDate = tNode.selectSingleNode("pubDate").Text
            
            tcnt = tcnt + 1
        Next tNode
    Else
        Debug.Print "read rss error"
    End If
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ConverHtmlTag
' DateTime  : 2005-8-19 15:07
' Author    : Lingll
' Purpose   : 转换部分html标记
'---------------------------------------------------------------------------------------
Private Function ConverHtmlTag(vHtml$) As String
Dim tRtn$
tRtn = Replace(vHtml, "&nbsp;", " ")
tRtn = Replace(tRtn, "<br>", vbNewLine)
tRtn = Replace(tRtn, "<br />", vbNewLine)
tRtn = Replace(tRtn, vbNewLine, vbNullString)
ConverHtmlTag = tRtn
End Function
Public Sub ReLoad()
m_XMLDoc.Load m_Url
End Sub
Public Sub CreateBm(ByVal vTitle$)
Dim tNode As MSXML2.IXMLDOMNode
m_BMsCnt = 0
ReDim m_BMs(0 To m_BMsCnt)
'm_XmlDoc.loadXML ("<rss><channel><title>" & vTitle & "</title></channel></rss>")
Set m_XMLDoc = New MSXML2.DOMDocument
With m_XMLDoc
    Set tNode = .appendChild(.createNode(NODE_ELEMENT, "rss", ""))
    Set tNode = tNode.appendChild(.createNode(NODE_ELEMENT, "channel", ""))
    Set tNode = tNode.appendChild(.createNode(NODE_ELEMENT, "titel", ""))
    tNode.Text = vTitle
End With
End Sub
Private Sub Class_Initialize()
Set m_XMLDoc = New MSXML2.DOMDocument
End Sub
Private Sub m_XmlDoc_onreadystatechange()
On Error Resume Next
If m_XMLDoc.readyState = 4 Then
    Call Refresh
    RaiseEvent Changed
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetXml
' DateTime  : 2005-5-30 18:58
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Public Function GetXml() As String
GetXml = m_XMLDoc.xml
End Function

						