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
Dim strURL As String
Private Sub Form_Load()
strURL = "http://myusername:mypassword@www.mysite.com:5555/default.asp?Code=123"
Debug.Print strURL & vbCrLf
Debug.Print "SCHEME : " & GetUrlParts(strURL, URL_PART_SCHEME, 0&)
Debug.Print "HOSTNAME : " & GetUrlParts(strURL, URL_PART_HOSTNAME, 0&)
Debug.Print "USERNAME : " & GetUrlParts(strURL, URL_PART_USERNAME, 0&)
Debug.Print "PASSWORD : " & GetUrlParts(strURL, URL_PART_PASSWORD, 0&)
Debug.Print "PORT : " & GetUrlParts(strURL, URL_PART_PORT, 0&)
Debug.Print "QUERY : " & GetUrlParts(strURL, URL_PART_QUERY, 0&)
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
End If
End Function |