Results 1 to 4 of 4

Thread: Here's code to get any part of a URL.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Here's code to get any part of a URL.

    Just copy the code from the below code box and paste it into a module, and you can use it to get any part of a URL.
    The part numbers are as follows.
    0 = protocol
    1 = username
    2 = password
    3 = host
    4 = port
    5 = path
    6 = query
    Any other part number results in an empty string being returned from the function.

    If the requested part number is 4 (the port), but the URL doesn't contain a port number, then the returned value will be based on the protocol, as follows.
    ftp = 21
    gopher = 70
    http = 80
    https = 443
    Any other protocol results in the returned port number being 0.

    Code:
    Public Function GetURLPart(ByVal URL As String, ByVal PartNumber As Long) As String
        Dim n As Long
        Dim n2 As Long
        Dim Protocol As String
        Dim PrePath As String
        Dim PreHost As String
        Dim UsernameAndPassword() As String
        Dim HostAndPort As String
        Dim HostAndPortSplit() As String
        Dim PathAndQuery As String
        
        n = InStr(1, URL, "://")
        If PartNumber = 0 Then
            GetURLPart = LCase$(Left$(URL, n - 1))
            Exit Function
        ElseIf PartNumber = 4 Then
            Protocol = LCase$(Left$(URL, n - 1))
        End If
        URL = Right$(URL, Len(URL) - n - 2)
        
        n = InStr(1, URL, "/")
        If n = 0 Then n = Len(URL) + 1
        PrePath = Left$(URL, n - 1)
        
        n2 = InStr(1, PrePath, "@")
        If n2 = 0 Then
            If PartNumber < 5 Then HostAndPort = PrePath
        Else
            PreHost = Left$(PrePath, n2 - 1)
            UsernameAndPassword() = Split(PreHost, ":")
            If PartNumber = 1 Then
                GetURLPart = UsernameAndPassword(0)
                Exit Function
            ElseIf PartNumber = 2 Then
                If UBound(UsernameAndPassword) > 0 Then GetURLPart = UsernameAndPassword(1)
                Exit Function
            End If
            If PartNumber < 5 Then HostAndPort = Right$(PrePath, Len(PrePath) - n2)
                
        End If
        If PartNumber < 5 Then
            HostAndPortSplit() = Split(HostAndPort, ":")
            If PartNumber = 3 Then
                GetURLPart = HostAndPortSplit(0)
            ElseIf PartNumber = 4 Then
                If UBound(HostAndPortSplit) > 0 Then
                    GetURLPart = HostAndPortSplit(1)
                Else
                    Select Case Protocol
                        Case "ftp"
                            GetURLPart = "21"
                        Case "gopher"
                            GetURLPart = "70"
                        Case "http"
                            GetURLPart = "80"
                        Case "https"
                            GetURLPart = "443"
                        Case Else
                            GetURLPart = "0"
                    End Select
                End If
            End If
            Exit Function
        End If
        
        PathAndQuery = Right$(URL, Len(URL) - n + 1)
        n = InStr(1, PathAndQuery, "?")
        If PartNumber = 5 Then
            If n = 0 Then
                GetURLPart = PathAndQuery
            Else
                GetURLPart = Left$(PathAndQuery, n - 1)
            End If
        ElseIf PartNumber = 6 Then
            If n > 0 Then GetURLPart = Right$(PathAndQuery, Len(PathAndQuery) - n)
        End If
    End Function

  2. #2

    Thread Starter
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Re: Here's code to get any part of a URL.

    Here's some code you can paste in your form to test it, and compare its output to the output of the Windows API function InternetCrackUrlA.
    Code:
    Private Declare Sub InternetCrackUrl Lib "wininet.dll" Alias "InternetCrackUrlA" (ByVal lpszUrl As String, ByVal dwUrlLength As Long, ByVal dwFlags As Long, ByRef lpUrlComponents As URL_COMPONENTSA)
    
    Private Type URL_COMPONENTSA
        dwStructSize As Long
        lpszScheme As String
        dwSchemeLength As Long
        nScheme As Long
        lpszHostName As String
        dwHostNameLength As Long
        nPort As Long
        lpszUserName As String
        dwUserNameLength As Long
        lpszPassword As String
        dwPasswordLength As Long
        lpszUrlPath As String
        dwUrlPathLength As Long
        lpszExtraInfo As String
        dwExtraInfoLength As Long
    End Type
    
    
    Private Sub Form_Load()
        Dim URL As String
        Dim URLParts As URL_COMPONENTSA
        
        
        URL = "http://username:password@www.somewebsite.com:8080/folder1/folder2/file.dat?var1=data1&var2=data2"
        
        With URLParts
            .dwStructSize = LenB(URLParts)
            .dwSchemeLength = 1000
            .dwUserNameLength = 1000
            .dwPasswordLength = 1000
            .dwHostNameLength = 1000
            .dwUrlPathLength = 1000
            .dwExtraInfoLength = 1000
            .lpszScheme = String$(1000, vbNullChar)
            .lpszUserName = String$(1000, vbNullChar)
            .lpszPassword = String$(1000, vbNullChar)
            .lpszHostName = String$(1000, vbNullChar)
            .lpszUrlPath = String$(1000, vbNullChar)
            .lpszExtraInfo = String$(1000, vbNullChar)
        End With
        
        InternetCrackUrl URL, Len(URL), 0, URLParts
        With URLParts
            .lpszScheme = Left$(.lpszScheme, .dwSchemeLength)
            .lpszUserName = Left$(.lpszUserName, .dwUserNameLength)
            .lpszPassword = Left$(.lpszPassword, .dwPasswordLength)
            .lpszHostName = Left$(.lpszHostName, .dwHostNameLength)
            .lpszUrlPath = Left$(.lpszUrlPath, .dwUrlPathLength)
            .lpszExtraInfo = Left$(.lpszExtraInfo, .dwExtraInfoLength)
        End With
    
        Print URL
        
        Print ""
        
        With URLParts
            Print "PROTOCOL: "; .lpszScheme
            Print "USERNAME: "; .lpszUserName
            Print "PASSWORD: "; .lpszPassword
            Print "HOST: "; .lpszHostName
            Print "PORT: "; CStr(.nPort)
            Print "PATH: "; .lpszUrlPath
            Print "QUERY: "; .lpszExtraInfo
        End With
        
        Print ""
        
        Print "PROTOCOL: "; GetURLPart(URL, 0)
        Print "USERNAME: "; GetURLPart(URL, 1)
        Print "PASSWORD: "; GetURLPart(URL, 2)
        Print "HOST: "; GetURLPart(URL, 3)
        Print "PORT: "; GetURLPart(URL, 4)
        Print "PATH: "; GetURLPart(URL, 5)
        Print "QUERY: "; GetURLPart(URL, 6)
        
    End Sub

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Re: Here's code to get any part of a URL.

    Here's an alternate version of the module code for the GetURLPart function, and this version makes much more use out of the VB6 Split function.
    Code:
    Public Function GetURLPart(ByVal URL As String, ByVal PartNumber As Long) As String
        Dim n As Long
        Dim SplitURL() As String
        Dim temp As String
        
        
        SplitURL() = Split(URL, "?")
        
        If PartNumber = 6 Then
            For n = 1 To UBound(SplitURL)
                GetURLPart = GetURLPart & SplitURL(n) & "?"
            Next n
            If GetURLPart = "" Then Exit Function
            GetURLPart = Left$(GetURLPart, Len(GetURLPart) - 1)
            Exit Function
        End If
        temp = SplitURL(0)
        
        SplitURL() = Split(temp, "/")
        If PartNumber = 0 Then
            GetURLPart = SplitURL(0)
            GetURLPart = Left$(GetURLPart, Len(GetURLPart) - 1)
        ElseIf PartNumber < 5 Then
            temp = SplitURL(2)
            If PartNumber < 3 Then
                If InStr(1, temp, "@") = 0 Then Exit Function
                SplitURL() = Split(temp, "@")
                temp = SplitURL(0)
                If PartNumber = 1 Then
                    SplitURL() = Split(temp, ":")
                    GetURLPart = SplitURL(0)
                Else
                    If InStr(1, temp, ":") = 0 Then Exit Function
                    SplitURL() = Split(temp, ":")
                    GetURLPart = SplitURL(1)
                End If
            Else
                If InStr(1, temp, "@") Then
                    SplitURL() = Split(temp, "@")
                    temp = SplitURL(1)
                End If
                SplitURL() = Split(temp, ":")
                If PartNumber = 3 Then
                    GetURLPart = SplitURL(0)
                Else
                    If UBound(SplitURL) = 0 Then
                        Select Case LCase$(GetURLPart(URL, 0))
                            Case "ftp"
                                GetURLPart = "21"
                            Case "gopher"
                                GetURLPart = "70"
                            Case "http"
                                GetURLPart = "80"
                            Case "https"
                                GetURLPart = "443"
                            Case Else
                                GetURLPart = "0"
                        End Select
                    Else
                        GetURLPart = SplitURL(1)
                        For n = 1 To Len(GetURLPart)
                            If IsNumeric(Mid$(GetURLPart, n, 1)) = False Then
                                GetURLPart = "0"
                                Exit Function
                            End If
                        Next n
                    End If
                    
                End If
            End If
        Else
            For n = 3 To UBound(SplitURL)
                GetURLPart = GetURLPart & "/" & SplitURL(n)
            Next n
            If GetURLPart = "" Then GetURLPart = "/"
        End If
    End Function

  4. #4
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Here's code to get any part of a URL.

    Btw, you can have "/" in user/pass and you can have ":" and "@" in password. You can have protocol-less URLs like in "//www.vbforums.com/showthread.php" or relative URLs like in "/showthread.php?894282"

    Split function has a Limit parameter you can use like SplitURL = Split(URL, "?", Limit:=2) to split in exactly two parts (or one if there is no "?" in the string).

    cheers,
    </wqw>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width