Attribute VB_Name = "modURLInfo"
Option Explicit

' The type that is returned by GetURLInfo
Public Type URLInfo
    Anchor As String
    ProtocolName As String
    Host As String
    Port As String
    Username As String
    Password As String
    QueryString As String
    RequestedFile As String
End Type

' This function strips various information from a URL string and returns
' a type URLInfo, with all the interesting information you could ever need
' for generating HTTP/FTP queries :)
Public Function GetURLInfo(strURL As String) As URLInfo
    Dim Position As Integer
    Dim AuthInfo As String
    
    ' Is there an anchor?
    Position = InStr(1, strURL, "#")
    If Position > 0 Then
        GetURLInfo.Anchor = Right(strURL, Len(strURL) - Position + 1)
        strURL = Left(strURL, Position - 1)
    End If
    
    ' Is there a query string?
    Position = InStr(1, strURL, "?")
    If Position > 0 Then
        GetURLInfo.QueryString = Right(strURL, Len(strURL) - Position)
        strURL = Left(strURL, Position - 1)
    End If
    
    ' What protocol was specified, if any
    Position = InStr(1, strURL, "://")
    If Position > 0 Then
        GetURLInfo.ProtocolName = Left(strURL, Position - 1)
        strURL = Right(strURL, Len(strURL) - Position - 2)
    End If

    ' Get the requested file, if it exists
    Position = InStr(1, strURL, "/")
    If Position > 0 Then
        GetURLInfo.RequestedFile = Right(strURL, Len(strURL) - Position + 1)
        strURL = Left(strURL, Position - 1)
    End If
    
    ' Search for username/password information
    Position = InStr(1, strURL, "@")
    If Position > 0 Then
        AuthInfo = Left(strURL, Position - 1)
        strURL = Right(strURL, Len(strURL) - Position)
        
        Position = InStr(1, AuthInfo, ":")
        If Position > 0 Then
            GetURLInfo.Username = Left(AuthInfo, Position - 1)
            GetURLInfo.Password = Right(AuthInfo, Len(AuthInfo) - Position)
        End If
    End If

    ' Shouldn't be any more @'s in the URL now (and hostnames cannot
    ' contain a @), so remove any to stop odd things happening
    strURL = Replace(strURL, "@", "")

    ' Search for a port in the URL
    Position = InStr(1, strURL, ":")
    If Position > 0 Then
        GetURLInfo.Port = Right(strURL, Len(strURL) - Position)
        strURL = Left(strURL, Position - 1)
    End If
    
    ' And lastly, the hostname
    GetURLInfo.Host = strURL
End Function