InternetCrackUrl, VBA include

This part of code lets you work with InternetCrackUrl from Win32 API. You can copy the source code to module in your project.
You can use the function as in the next sample:

Private Sub CrackURLtest()
  Dim URLParts As URL_COMPONENTSA
  URLParts = CrackURL("http://ferda:babicka@www.microsoft.com/path/query.asp?parameters")
  Debug.Print URLParts.lpszScheme
  Debug.Print URLParts.lpszUsername
  Debug.Print URLParts.lpszPassword
  Debug.Print URLParts.lpszHostName
  Debug.Print URLParts.lpszUrlPath
  Debug.Print URLParts.lpszExtraInfo
End Sub

Output of this test is:

http
ferda
babicka
www.microsoft.com
/path/query.asp
?parameters



Option Explicit
'*********************************** InternetCrackUrl
'InternetCrackUrl include file For VBA
'Created by Antonin Foller, http://www.motobit.com
Enum eMaxWinInetValues
  INTERNET_MAX_HOST_NAME_LENGTH = 256
  INTERNET_MAX_USER_NAME_LENGTH = 128
  INTERNET_MAX_PASSWORD_LENGTH = 128
  INTERNET_MAX_PORT_NUMBER_LENGTH = 5          ' INTERNET_PORT is unsigned short
  INTERNET_MAX_PORT_NUMBER_VALUE = 65535       ' maximum unsigned short value
  INTERNET_MAX_PATH_LENGTH = 2048
  INTERNET_MAX_SCHEME_LENGTH = 32              ' longest protocol name length
  INTERNET_MAX_URL_LENGTH = INTERNET_MAX_SCHEME_LENGTH + 3 + INTERNET_MAX_PATH_LENGTH
End Enum

Public Type URL_COMPONENTSA
  dwStructSize As Long
  lpszScheme As String
  dwSchemeLength As Long
  nScheme As INTERNET_SCHEME
  lpszHostName As String
  dwHostNameLength As Long
  nPort As Integer
  
  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

Enum eCanonizeURL
  ICU_ESCAPE = &H80000000       ' (un)escape URL characters
  ICU_DECODE = &H10000000       ' Convert %XX escape sequences To characters
End Enum

Enum INTERNET_SCHEME
    INTERNET_SCHEME_PARTIAL = -2
    INTERNET_SCHEME_UNKNOWN = -1
    INTERNET_SCHEME_DEFAULT = 0
    INTERNET_SCHEME_FTP
    INTERNET_SCHEME_GOPHER
    INTERNET_SCHEME_HTTP
    INTERNET_SCHEME_HTTPS
    INTERNET_SCHEME_FILE
    INTERNET_SCHEME_NEWS
    INTERNET_SCHEME_MAILTO
    INTERNET_SCHEME_SOCKS
    INTERNET_SCHEME_FIRST = INTERNET_SCHEME_FTP
    INTERNET_SCHEME_LAST = INTERNET_SCHEME_SOCKS
End Enum

Declare Function InternetCrackUrl Lib "WININET" Alias "InternetCrackUrlA" ( _
    ByVal lpszUrl As String, _
    ByVal dwUrlLength As Long, _
    ByVal dwFlags As eCanonizeURL, _
    lpUrlComponents As URL_COMPONENTSA) As Long

Public Function CrackURL(ByVal URL As String) As URL_COMPONENTSA
  Dim c As URL_COMPONENTSA, Result As Long
  
  c.dwStructSize = 60
  c.lpszScheme = Space(INTERNET_MAX_SCHEME_LENGTH)
  c.dwSchemeLength = INTERNET_MAX_SCHEME_LENGTH
  c.lpszHostName = Space(INTERNET_MAX_HOST_NAME_LENGTH)
  c.dwHostNameLength = INTERNET_MAX_HOST_NAME_LENGTH
  
  c.lpszUsername = Space(INTERNET_MAX_USER_NAME_LENGTH)
  c.dwUserNameLength = INTERNET_MAX_USER_NAME_LENGTH
  c.lpszPassword = Space(INTERNET_MAX_USER_NAME_LENGTH)
  c.dwPasswordLength = INTERNET_MAX_USER_NAME_LENGTH
  
  c.lpszUrlPath = Space(INTERNET_MAX_PATH_LENGTH)
  c.dwUrlPathLength = INTERNET_MAX_PATH_LENGTH
  c.lpszExtraInfo = Space(128)
  c.dwExtraInfoLength = 128
  Result = InternetCrackUrl(URL, 0, 0, c)
  If Result Then
    c.lpszScheme = Left$(c.lpszScheme, c.dwSchemeLength)
    c.lpszHostName = Left$(c.lpszHostName, c.dwHostNameLength)
    
    c.lpszUsername = Left$(c.lpszUsername, c.dwUserNameLength)
    c.lpszPassword = Left$(c.lpszPassword, c.dwPasswordLength)
    
    c.lpszUrlPath = Left$(c.lpszUrlPath, c.dwUrlPathLength)
    c.lpszExtraInfo = Left$(c.lpszExtraInfo, c.dwExtraInfoLength)
  Else
    c.lpszScheme = ""
    c.lpszHostName = ""
    
    c.lpszUsername = ""
    c.lpszPassword = ""
    
    c.lpszUrlPath = ""
    c.lpszExtraInfo = ""
  End If
  CrackURL = c
End Function

'*********************************** InternetCrackUrl - end

InternetCrackUrl, VBA includeMOTOBIT.COM

See also

Copyright and use this code