 UrlGetPart
takes a URL string and returns a portion of the string based on the parameter passed as the dwPart member of the call. The illustration shows
the result of a series of calls to UrlGetPart. The Source URL contains pretty well the most you'll find in a single URL - a username and
password, the host and port, the path too the data, and additional information as parameters - AKA the query portion.
By calling UrlGetPart once for each part of interest, the separate
parts making up the whole are returned. When the URL_PARTFLAG_KEEPSCHEME flag is specified, each part is returned prefaced by the scheme name
for the URL.
|
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const ERROR_SUCCESS As Long = 0
Private Const URL_PART_SCHEME As Long = 1
Private Const URL_PART_HOSTNAME As Long = 2
Private Const URL_PART_USERNAME As Long = 3
Private Const URL_PART_PASSWORD As Long = 4
Private Const URL_PART_PORT As Long = 5
Private Const URL_PART_QUERY As Long = 6
Private Const URL_PARTFLAG_KEEPSCHEME As Long = &H1
Private Declare Function UrlGetPart Lib "shlwapi" _
Alias "UrlGetPartA" _
(ByVal pszIn As String, _
ByVal pszOut As String, _
pcchOut As Long, _
ByVal dwPart As Long, _
ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Dim cnt As Long
Text1.Text = "http://randy:password" & _
"@www.mvps.org:8080" & _
"/vbnet/index.html?" & _
"code/network/netconnect.htm"
For cnt = 1 To 6
Text2(cnt).Text = ""
Text3(cnt).Text = ""
Next
Command1.Caption = "Get Parts"
End Sub
Private Sub Command1_Click()
Dim sPart As String
Dim sUrl As String
Dim cnt As Long
'using the original string in Text1 for
'all calls, show the results of calling
'UrlGetPart passing 0& and Keepscheme as
'flags.
For cnt = 1 To 6
sUrl = Text1.Text
sPart = GetUrlParts(sUrl, cnt, 0&)
Text2(cnt).Text = sPart
Next
For cnt = 1 To 6
sUrl = Text1.Text
sPart = GetUrlParts(sUrl, cnt, URL_PARTFLAG_KEEPSCHEME)
Text3(cnt).Text = sPart
Next
End Sub
Private Function GetUrlParts(ByVal sUrl As String, _
dwPart As Long, _
dwFlags As Long) As String
Dim sPart As String
Dim dwSize As Long
If Len(sUrl) > 0 Then
sPart = Space$(MAX_PATH)
dwSize = Len(sPart)
If UrlGetPart(sUrl, _
sPart, _
dwSize, _
dwPart, _
dwFlags) = ERROR_SUCCESS Then
GetUrlParts = Left$(sPart, dwSize)
End If 'If UrlGetPart
End If 'If Len(sUrl) > 0
End Function |
