handystuff.bas

vb写的网络蜘蛛程序

Attribute VB_Name = "HandyStuff"
Option Explicit


Public Function GetServerURLFrom(URL As String)
    Dim StringPos As Long
    
    StringPos = InStr(1, URL, "//")
    If StringPos > 0 Then
        StringPos = InStr(StringPos + 2, URL, "/")
        If StringPos > 0 Then
            GetServerURLFrom = Left(URL, StringPos - 1)
          Else
            GetServerURLFrom = URL
          End If
      End If
    End Function

Public Function GetParentURLFrom(URL As String)
    Dim StringPos As Long
    
    If URLEndsWithFilename(URL) Then
        StringPos = Len(URL)
        Do Until (StringPos = 1) Or (Mid(URL, StringPos, 1) = "/")
            StringPos = StringPos - 1
          Loop
        GetParentURLFrom = Left(URL, StringPos)
      Else
        GetParentURLFrom = URL
      End If

    End Function
Public Function URLEndsWithFilename(URL As String) As Boolean
    Dim Loc As Long
    
    If Right(URL, 1) = "/" Then
        URLEndsWithFilename = False
      Else
        Loc = InStr(URL, "//")
        If Loc > 0 Then
            If InStr(Loc + 2, URL, "/") > 0 Then
                URLEndsWithFilename = True
              Else
                URLEndsWithFilename = False
              End If
          Else
            URLEndsWithFilename = True
          End If
      End If
    End Function

Public Function MinLong(A As Long, B As Long) As Long
    If A < B Then
        MinLong = A
    Else
        MinLong = B
    End If
End Function

Public Function MaxLong(A As Long, B As Long) As Long
    If A > B Then
        MaxLong = A
    Else
        MaxLong = B
    End If

End Function

Public Function ExtractFilenameFromPath(ByVal Path As String) As String
    Dim StringPos As Long
    
    If (Right(Path, 1) <> "/") Then
        StringPos = Len(Path)
        Do While (StringPos > 1) And (Not Mid(Path, StringPos, 1) = "/")
            StringPos = StringPos - 1
            Loop
        ExtractFilenameFromPath = Right(Path, (Len(Path) - StringPos))
      Else
        ExtractFilenameFromPath = ""
      End If
    End Function

Public Function ExtractFilenameExtensionFromPath(ByVal Path As String) As String
    Dim StringPos As Long
    
    If Right(Path, 1) = "/" Then
        ExtractFilenameExtensionFromPath = ""
      ElseIf (Left(Right(Path, 4), 1) = ".") Then
        ExtractFilenameExtensionFromPath = Right(Path, 3)
      ElseIf (Left(Right(Path, 5), 1) = ".") Then
        ExtractFilenameExtensionFromPath = Right(Path, 4)
      Else
        ExtractFilenameExtensionFromPath = ""
      End If

    End Function

Public Function URLNormalized(URL As String) As Boolean
    Dim TempURL As String
    Dim ValidFirstChar As Boolean
    
    TempURL = URL
    Select Case Asc(Left(TempURL, 1))
      Case 48 To 57
        ValidFirstChar = True
      Case 65 To 90
        ValidFirstChar = True
      Case 97 To 122
        ValidFirstChar = True
      Case Else
        ValidFirstChar = False
      End Select
      
    If ValidFirstChar Then
        If (InStr(TempURL, "//") = 0) Then
            TempURL = "http://" & TempURL
          End If
        If (Not URLEndsWithFilename(TempURL)) And _
           (Not (Right(TempURL, 1) = "/")) And _
           (InStr(8, TempURL, "/") = 0) Then
            TempURL = TempURL & "/"
          End If
        URL = TempURL
        URLNormalized = True
      Else
        URLNormalized = False
      End If

    End Function