clsdocuments.cls

vb写的网络蜘蛛程序

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

Public Text As String
Public Sentences As New clsMatchLists
Public Paragraphs As New clsMatchLists
Public Sub OccurrencesOf(S As String, Result As clsMatchLists)
    Dim Loc As Long
    Dim EndOfMatch As Long
    
    Set Result = New clsMatchLists
    Loc = InStr(Me.Text, S)
    Do While Loc <> 0
        Debug.Print S; " found at pos "; Loc
        EndOfMatch = Loc + Len(S)
        Result.AddNewMatch Loc, EndOfMatch
        Loc = InStr(EndOfMatch, Me.Text, S)
        DoEvents
        Loop
    End Sub

Public Function SentenceOf(Loc As Integer) As Integer
    Dim M As clsMatch
    SentenceOf = 0
    For Each M In Sentences.Matches
        If (Loc >= M.StartingPosition) And (Loc <= M.EndingPosition) Then
            SentenceOf = M.StartingPosition
            Debug.Print "SentenceOf(", Loc, ") = ", M.StartingPosition
            Exit For
            End If
        Next M
    End Function
Public Function ParagraphOf(Loc As Integer) As Integer
    Dim M As clsMatch
    ParagraphOf = 0
    For Each M In Paragraphs
        If (Loc >= M.StartingPosition) And (Loc <= M.EndingPosition) Then
            ParagraphOf = M.StartingPosition
            Exit For
            End If
        Next M

End Function

Public Sub Init(Document As String)
    Dim I As Long
    Dim J As Long

    Text = Document
    
    'Find paragraphs and remove tags
    I = 0
    J = InStr(I + 1, Text, "<")
    Do While J <> 0
        If Mid(Text, J, 3) = "<P>" Then
            Paragraphs.AddNewMatch I, J
            End If
        I = J
        Text = Mid(Text, 1, I - 1) & Mid(Text, InStr(I + 1, Text & ">", ">") + 1)
        J = InStr(I + 1, Text, "<")
        Loop
    Paragraphs.AddNewMatch I, Len(Text)
    
    'Find sentences
    I = 0
    J = InStr(I + 1, Text, ".")
    Do While J <> 0
        Sentences.AddNewMatch I, J
        I = J
        J = InStr(I + 1, Text, ".")
        Loop
    Sentences.AddNewMatch I, Len(Text)
    End Sub