-
Nov 23rd, 2021, 07:41 AM
#1
Thread Starter
Frenzied Member
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
-
Nov 23rd, 2021, 07:48 AM
#2
Thread Starter
Frenzied Member
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
-
Nov 23rd, 2021, 07:23 PM
#3
Thread Starter
Frenzied Member
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
-
Nov 24th, 2021, 07:36 AM
#4
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|