[VB6] URL/Path String Manipulation Functions

[penagate]

Some functions for manipulating strings containing URLs and local file addresses.

Get parent address
Returns the parent address from a URL. e.g.
?GetParentAddress("http://www.domain.com/parentdirectory/subdirectory/")
http://www.domain.com/parentdirectory

Public Function GetParentAddress(ByVal Address As String) As String
Dim lngCharCount As Long
Dim lngBCount As Long
Dim strOutput As String

strOutput$ = Replace(Address, "\", "/")
lngCharCount = Len(strOutput)

If (Right$(strOutput, 1) = "/") Then strOutput = Left$(strOutput, lngCharCount - 1)

lngCharCount = Len(strOutput)

strOutput = Left$(strOutput, lngCharCount - lngBCount)
strOutput = Left$(strOutput, InStrRev(strOutput, "/", , vbTextCompare) - 1)

GetParentAddress = strOutput
End Function


Get domain name
Returns the domain name from a URL. e.g.
?GetDomainName("http://www.domain.com/directory/page.html")
www.domain.com

Public Function GetDomainName(ByVal Address As String) As String
Dim strOutput As String
Dim strTemp As String
Dim lngLoopCount As Long
Dim lngBCount As Long
Dim lngCharCount As Long

strOutput$ = Replace(Address, "\", "/")
lngCharCount = Len(strOutput)

If (InStrB(1, strOutput, "/")) Then
Do Until ((strTemp = "/") Or (lngLoopCount = lngCharCount))
lngLoopCount = lngLoopCount + 1
strTemp = Mid$(strOutput, lngBCount + 1, 1)
lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
lngBCount = 0
strTemp = "/"

If (InStrB(1, strOutput, "/")) Then
Do Until strTemp <> "/"
strTemp = Mid$(strOutput, lngBCount + 1, 1)
If strTemp = "/" Then lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
strOutput = Left$(strOutput, InStr(1, strOutput, "/", vbTextCompare) - 1)

GetDomainName = strOutput
End Function


Canonicalize a URL
Returns the canonicalized (friendly) version of the URL. e.g.
?URLCanonicalize("http://www.domain.com/directory/page.html/")
www.domain.com/directory/page.html

Public Function URLCanonicalize(ByVal pstrAddress As String) As String
Dim strOutput As String
Dim strTemp As String
Dim lngLoopCount As Long
Dim lngBCount As Long
Dim lngCharCount As Long

strOutput$ = Replace(pstrAddress, "\", "/")
lngCharCount = Len(strOutput)

If (InStrB(1, strOutput, "/")) Then
Do Until ((strTemp = "/") Or (lngLoopCount = lngCharCount))
lngLoopCount = lngLoopCount + 1
strTemp = Mid$(strOutput, lngBCount + 1, 1)
lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
lngBCount = 0
strTemp = "/"

If (InStrB(1, strOutput, "/")) Then
Do Until (strTemp <> "/")
strTemp = Mid$(strOutput, lngBCount + 1, 1)
If strTemp = "/" Then lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
lngBCount = 0
strTemp = "/"
lngCharCount = Len(strOutput)
If (InStrB(1, strOutput, "/")) Then
Do Until (strTemp <> "/")
strTemp = Mid$(strOutput, lngCharCount - lngBCount, 1)
If strTemp = "/" Then lngBCount = lngBCount + 1
Loop
End If

strOutput = Left$(strOutput, Len(strOutput) - lngBCount)
strOutput = Replace(strOutput, "%20", " ")

URLCanonicalize = strOutput
End Function


Remove illegal characters
Returns the same address minus any characters not allowed in a Windows filename. e.g.
?RemoveIllegals("Some *file* name/thing!")
Some file namething!

Public Function RemoveIllegals(ByVal pstrCheckString As String) As String
Dim i As Long
Dim strOutput As String
Dim astrIllegals(8) As String

strOutput = pstrCheckString

astrIllegals(0) = "*"
astrIllegals(1) = "?"
astrIllegals(2) = "/"
astrIllegals(3) = "\"
astrIllegals(4) = ":"
astrIllegals(5) = "|"
astrIllegals(6) = "<"
astrIllegals(7) = ">"
astrIllegals(8) = Chr$(34)

For i = 0 To 8
strOutput = Replace(strOutput, astrIllegals(i), vbNullString)
Next i

RemoveIllegals = strOutput
End Function


Remove root name or get lowest level name
Returns either the address minus path root, or the lowest-level identifier. e.g.
?RemoveRootName("http://www.domain.com/parentdirectory/subdirectory/", False)
parentdirectory/subdirectory

?RemoveRootName("http://www.domain.com/parentdirectory/subdirectory/", True)
subdirectory
Public Function RemoveRootName(ByVal pstrPath As String, _
ByVal pblnGetLowestLevelName As Boolean) _
As String

Dim strOutput As String
Dim lngLoopCount As Long
Dim lngBCount As Long
Dim lngCharCount As Long
Dim strTemp As String

strOutput = Replace(pstrPath, "\", "/")
lngCharCount = Len(strOutput)

If (InStrB(1, strOutput, "/")) Then
Do Until ((strTemp = "/") Or (lngLoopCount = lngCharCount))
lngLoopCount = lngLoopCount + 1
strTemp = Mid$(strOutput, lngBCount + 1, 1)
lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
lngBCount = 0
strTemp = "/"
If (InStrB(1, strOutput, "/")) Then
Do Until (strTemp <> "/")
strTemp = Mid$(strOutput, lngBCount + 1, 1)
If strTemp = "/" Then lngBCount = lngBCount + 1
Loop
End If

strOutput = Right$(strOutput, Len(strOutput) - lngBCount)
lngBCount = 0
strTemp = "/"
lngCharCount = Len(strOutput)

If (InStrB(1, strOutput, "/")) Then
Do Until (strTemp <> "/")
strTemp = Mid$(strOutput, lngCharCount - lngBCount, 1)
If strTemp = "/" Then lngBCount = lngBCount + 1
Loop
End If

strOutput = Left$(strOutput, Len(strOutput) - lngBCount)
strOutput = Right$(strOutput, Len(strOutput) - InStr(1, strOutput, "/", vbTextCompare))

If (pblnGetLowestLevelName) Then _
strOutput = Right$(strOutput, Len(strOutput) - InStrRev(strOutput, "/"))

strOutput = Replace(strOutput, "%20", " ")

RemoveRootName = strOutput
End Function


Resolve environment variables
Returns the path with any environment variables %environ% resolved. e.g.
?ResolveEnvirons("%systemroot%\Fonts")
C:\WINDOWS\Fonts

Public Function ResolveEnvirons(ByVal pstrText As String) As String
Dim i As Long
Dim bOpenMarker As Boolean
Dim lngLeftMarkerPos As Long
Dim strTemp As String
Dim strResolveString As String
Dim strTextLeft As String
Dim strTextRight As String

For i = 0 To Len(pstrText)
strTemp = Right$(Left$(pstrText, i), 1)

If (strTemp = "%") Then
If Not (bOpenMarker) Then
bOpenMarker = True
lngLeftMarkerPos = i

Else
bOpenMarker = False
strResolveString = Left$(Right$(pstrText, Len(pstrText) - lngLeftMarkerPos), i - lngLeftMarkerPos - 1)

strTextLeft = Left$(pstrText, lngLeftMarkerPos - 1)
strTextRight = Right$(pstrText, Len(pstrText) - i)

strResolveString = Environ(strResolveString)

pstrText = strTextLeft & strResolveString & strTextRight
i = -1
End If
End If
Next i

ResolveEnvirons = pstrText
End Function

[DigiRev]

Came across this when searching for something. Another thing you might want to add would be to encode a URL (replacing spaces with %20 or whatever it is), etc.

[leinad31]

Came across this when searching for something. Another thing you might want to add would be to encode a URL (replacing spaces with %20 or whatever it is), etc.Isn't that automatic? What control are you using that requires replacement with %20?

[DigiRev]

Isn't that automatic? What control are you using that requires replacement with %20?

Automatic if you are using something like a web browser control or shelling a web page.

But if you are making something yourself that sends a request to a web server (maybe using something like Winsock?) then it can be important.

Also, another idea might be to wrap this up into a class and let the user set a URL property, and be able to get individual parts from the URL like domain, suffix, port (if applicable), URI, etc. via property gets. I started on this awhile ago but haven't finished it yet...