clsdocumentanalyst.cls

vb写的网络蜘蛛程序

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

Private Document As clsDocuments
Public PatternSource As String
Private PatternParser As clsParsers
Public Function DocumentMatches(ByVal DocumentString As String) As Boolean
    Dim MatchList As New clsMatchLists
    
    If Trim(PatternSource) <> "" Then
        Set Document = New clsDocuments
        Document.Init LCase(DocumentString)
        Set PatternParser = New clsParsers
        PatternParser.Init LCase(PatternSource)
        PatternMatch MatchList
        DocumentMatches = (MatchList.Matches.Count <> 0)
      Else
        DocumentMatches = False
      End If
    
    End Function



Public Sub PatternMatch(Result As clsMatchLists)
    AndMatch Result
End Sub

Public Sub WordMatch(Result As clsMatchLists)
    If PatternParser.CanRead("(") Then
        PatternMatch Result
        PatternParser.Expect ")"
      Else
        Document.OccurrencesOf PatternParser.NextWord, Result
        PatternParser.Advance
      End If
      
    End Sub

Public Sub NearMatch(Result As clsMatchLists)
    Const NearLimit = 200
    Dim MatchListA As clsMatchLists
    Dim MatchListB As clsMatchLists
    Dim MatchA As clsMatch
    Dim MatchB As clsMatch
    
    SentenceMatch Result
    Do While PatternParser.CanRead("near")
        Set MatchListA = New clsMatchLists
        For Each MatchA In Result.Matches
            MatchListA.AddMatch MatchA
            Next MatchA
        SentenceMatch MatchListB
        Set Result = New clsMatchLists
        For Each MatchA In MatchListA.Matches
            For Each MatchB In MatchListB.Matches
                If (Abs(MatchA.StartingPosition - MatchB.EndingPosition) < NearLimit) Or _
                   (Abs(MatchB.StartingPosition - MatchA.EndingPosition) < NearLimit) Then
                    Result.AddSpread MatchA, MatchB
                  End If
                Next MatchB
            Next MatchA
        Loop
    End Sub

Public Sub OrMatch(Result As clsMatchLists)
    Dim MatchListA As clsMatchLists
    Dim MatchListB As clsMatchLists
    Dim MatchA As clsMatch
    Dim MatchB As clsMatch
    
    NearMatch Result
    Do While PatternParser.CanRead("or")
        Set MatchListA = New clsMatchLists
        For Each MatchA In Result.Matches
            MatchListA.AddMatch MatchA
            Next MatchA
        NearMatch MatchListB
        Set Result = New clsMatchLists
        For Each MatchA In MatchListA.Matches
            Result.AddMatch MatchA
            Next MatchA
        For Each MatchB In MatchListB.Matches
            Result.AddMatch MatchB
            Next MatchB
        Loop
    End Sub

Public Sub AndMatch(Result As clsMatchLists)
    Dim MatchListA As clsMatchLists
    Dim MatchListB As clsMatchLists
    Dim MatchA As clsMatch
    Dim MatchB As clsMatch
    
    
    OrMatch Result
    Do While PatternParser.CanRead("and")
        Set MatchListA = New clsMatchLists
        For Each MatchA In Result.Matches 'A = 1 To Result.Count
            MatchListA.AddMatch MatchA
            Next MatchA
        OrMatch MatchListB
        Set Result = New clsMatchLists
        For Each MatchA In MatchListA.Matches
            For Each MatchB In MatchListB.Matches
                Result.AddSpread MatchA, MatchB
                Next MatchB
            Next MatchA
        Loop
                
    End Sub

Public Sub Init(ByVal Pattern As String)
    PatternSource = Pattern
    End Sub

Public Sub SentenceMatch(Result As clsMatchLists)
    Const NearLimit = 200
    Dim MatchListA As clsMatchLists
    Dim MatchListB As clsMatchLists
    Dim MatchA As clsMatch
    Dim MatchB As clsMatch
    
    NotMatch Result
    Do While PatternParser.CanRead("in_sentence_with")
        Set MatchListA = New clsMatchLists
        For Each MatchA In Result.Matches
            MatchListA.AddMatch MatchA
            Next MatchA
        NotMatch MatchListB
        Set Result = New clsMatchLists
        For Each MatchA In MatchListA.Matches
            For Each MatchB In MatchListB.Matches
                If Document.SentenceOf(MatchA.StartingPosition) = Document.SentenceOf(MatchB.StartingPosition) Then
                    Result.AddSpread MatchA, MatchB
                  End If
                Next MatchB
            Next MatchA
        Loop

End Sub

Public Sub NotMatch(Result As clsMatchLists)
    If PatternParser.CanRead("not") Then
        WordMatch Result
        If Result.Matches.Count = 0 Then
            Result.AddNewMatch Len(Document.Text), 1
          Else
            Set Result = New clsMatchLists
          End If
      Else
        WordMatch Result
      End If
    End Sub