clsdiplomat.cls

vb写的网络蜘蛛程序

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

Public Text
Private Restrictions()
Private CurrentServerURL

Public Sub Init(URL As String, AgentAccessFile As String)
    Dim TempText As String
    Dim TempString As String
    Dim CurrentLine As String
    Dim Loc As Long
    
    ReDim Restrictions(0)
    CurrentServerURL = GetServerURLFrom(URL)
    Text = LCase(AgentAccessFile)
    TempText = Text
    Do While (Len(TempText) > 0)
        CurrentLine = LCase(Trim(GetNextLineFrom(TempText)))
        Debug.Print "Current Line: "; CurrentLine
        If Left(CurrentLine, 9) = "disallow:" Then
            Loc = InStr(CurrentLine, "#")
            If Loc > 10 Then
                TempString = Trim(Mid(CurrentLine, 10, Loc - 10))
              Else
                TempString = Trim(Mid(CurrentLine, 10))
              End If
            Restrictions(UBound(Restrictions)) = TempString
            Debug.Print "Restrictions: "; Restrictions(UBound(Restrictions))
            ReDim Preserve Restrictions(UBound(Restrictions) + 1)
            Restrictions(UBound(Restrictions)) = ""
          End If
        Loop
    End Sub

Private Function GetNextLineFrom(TextString As String) As String
    Dim Loc As Long
    Dim TempLine As String
    
    Loc = InStr(TextString, vbLf)
    If Loc <> 0 Then
        TempLine = Mid(TextString, 1, Loc - 1)
        If Len(TempLine) > 0 Then
            Do While (Asc(Right(TempLine, 1)) < 32) And (Len(TempLine) > 1)
                TempLine = Left(TempLine, Len(TempLine) - 1)
                Loop
          End If
        GetNextLineFrom = TempLine
        TextString = Mid(TextString, Loc + 1)
      Else
        GetNextLineFrom = TextString
        TextString = ""
      End If
    End Function

Public Function NewServerURL(URL As String)
    If InStr(URL, CurrentServerURL) <> 0 Then
        NewServerURL = False
      Else
        NewServerURL = True
      End If
    
    End Function

Public Function Rejects(URLToExamine As String)
    Dim Loc As Long
    Dim Counter As Integer
    
    Loc = 0
    For Counter = 0 To UBound(Restrictions) - 1
        Loc = InStr(URLToExamine, Restrictions(Counter))
        If Loc <> 0 Then Exit For
        Next Counter
    Rejects = (Loc <> 0) Or (InStr(URLToExamine, "cgi") > 0)
    End Function