clshtmlpageresourcenode.cls

vb写的网络蜘蛛程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsHTMLPageResourceNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Parent As clsHTMLPageResourceNode
Public URL As String
Public Path As String
Public MatchesSearch As Boolean
Public PageLinks As New Collection
Public PageElements As New Collection

Public Function AlreadyContains(TargetNodeKey As String, _
           MatchingNode As clsHTMLPageResourceNode) As Boolean
           
    Dim WebNode As clsHTMLPageResourceNode
    Dim NodeFound As Boolean
    
    DoEvents
    NodeFound = (Me.URL = TargetNodeKey)
    If NodeFound Then
        Set MatchingNode = Me
      Else
        For Each WebNode In Me.PageLinks
            If WebNode.AlreadyContains(TargetNodeKey, MatchingNode) Then
                NodeFound = True
                Exit For
              End If
            Next WebNode
        If Not NodeFound Then
            For Each WebNode In Me.PageElements
                If WebNode.AlreadyContains(TargetNodeKey, MatchingNode) Then
                    NodeFound = True
                    Exit For
                  End If
                Next WebNode
          End If
      End If
    AlreadyContains = NodeFound
    End Function

Public Sub RemoveLinks()
    ' This recursive procedure removes all
    ' nodes connected to the node on which
    ' the method was first invoked, eliminating
    ' the entire sub-tree.
    
    Dim WebNode As clsHTMLPageResourceNode
    
    For Each WebNode In PageLinks
        WebNode.RemoveLinks
        PageLinks.Remove WebNode.URL
        Next WebNode
    For Each WebNode In PageElements
        ' These nodes are always terminal,
        ' i.e., their collections are always
        ' empty, so we can save some time by not
        ' recursing.
        PageElements.Remove WebNode.URL
        Next WebNode
        
    End Sub

Private Sub Class_Terminate()
    ' As a precaution, remove all items
    ' from the two collections.
    RemoveLinks
    End Sub

Public Function Root() As clsHTMLPageResourceNode
                
    If Me.Parent Is Nothing Then
        Set Root = Me
      Else
        Set Root = Me.Parent.Root
      End If

    End Function