by viper (4 Submissions)
Category: Internet/HTML
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 9th March 1999
Date Added: Mon 8th February 2021
Rating: (1 Votes)
This function returns any of the various components of the URL that are present. This includes the "host", "port", "user", "pass", "path" and
API Declarations
Public Type typURL 'http://sit:[email protected]:881/prox/proxycfg.php3?openpage
Protocol As String 'contains the protocol if specified (e.g. http://, ftp:// etc.)
ServerName As String 'contains the servername (e.g. proxy.spiderit.net)
Filename As String 'contains the filename (e.g. proxycfg.php3)
Dir As String 'contains the directory (e.g. /prox/)
Filepath As String 'contains the whole filepath (e.g. /prox/proxycfg.php3)
Username As String 'contains the username (e.g. sit)
Password As String 'contains the password (e.g. sitter)
Query As String 'contains the querystring (e.g. openpage)
ServerPort As Integer 'contains the serverport (e.g. 881)
End Type
Public Const strNOCONTENT As String = "NOCONTENT"
Public Const intDEFAULTPORT As Integer = 80
Function ParseURL(URL As String) As typURL
Dim strTemp As String
Dim strServerAuth As String
Dim strServerNPort As String
Dim strAuth As String
strTemp = URL
'********
'- Parse protocol
If (InStr(1, strTemp, "://") > 0) Then
'URL contains protocol
ParseURL.Protocol = Left(strTemp, InStr(1, strTemp, "://") - 1)
strTemp = Right(strTemp, Len(strTemp) - (Len(ParseURL.Protocol) + 3)) 'delete protocol + ://
Else
'URL do not contains the protocol
ParseURL.Protocol = strNOCONTENT
End If
'********
'- Parse authenticate information
If (InStr(1, strTemp, "/") > 0) Then
'extract servername and user and password if there are directory infos
strServerAuth = Left(strTemp, InStr(1, strTemp, "/") - 1)
strTemp = Right(strTemp, Len(strTemp) - (Len(strServerAuth) + 1))
Else
'extract servername and user and password if there are no directory infos
strServerAuth = strTemp
strTemp = "/"
End If
If (InStr(1, strServerAuth, "@") > 0) Then
'there are user and password informations
strAuth = Left(strServerAuth, InStr(1, strServerAuth, "@") - 1)
strServerNPort = Right(strServerAuth, Len(strServerAuth) - (Len(strAuth) + 1))
Else
'there are no user and password informations
strAuth = ""
strServerNPort = strServerAuth
End If
If (InStr(1, strAuth, ":") > 0) And (Len(strAuth) > 0) Then
'split username and password on ":" splitter
ParseURL.Username = Left(strAuth, InStr(1, strAuth, ":") - 1)
ParseURL.Password = Right(strAuth, Len(strAuth) - InStr(1, strAuth, ":"))
ElseIf (InStr(1, strAuth, ":") <= 0) And (Len(strAuth) > 0) Then
'only username was submitted
ParseURL.Username = strAuth
ParseURL.Password = strNOCONTENT
Else
'no authenticate information was submitted
ParseURL.Username = strNOCONTENT
ParseURL.Password = strNOCONTENT
End If
If (InStr(1, strServerNPort, ":") > 0) Then
'Servername contains port
ParseURL.ServerPort = Int(Right(strServerNPort, Len(strServerNPort) - InStr(1, strServerNPort, ":")))
ParseURL.ServerName = Left(strServerNPort, InStr(1, strServerNPort, ":") - 1)
Else
ParseURL.ServerPort = intDEFAULTPORT
ParseURL.ServerName = strServerNPort
End If
If (InStr(1, strTemp, "?") > 0) Then
ParseURL.Query = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "?"))
strTemp = Left(strTemp, InStr(1, strTemp, "?") - 1)
Else
ParseURL.Query = strNOCONTENT
End If
For i = Len(strTemp) To 1 Step -1
If (Mid(strTemp, i, 1) = "/") Then
ParseURL.Filename = Right(strTemp, Len(strTemp) - i)
ParseURL.Dir = Left(strTemp, i)
If Not (Left(ParseURL.Dir, 1) = "/") Then
ParseURL.Dir = "/" & ParseURL.Dir
End If
Exit For
End If
Next
ParseURL.Filepath = "/" & strTemp
If Not (Left(ParseURL.Filepath, 1) = "/") Then
ParseURL.Filepath = "/" & ParseURL.Filepath
End If
End Function
Const strURL As String = "http://web:[email protected]:89/euro/rechner/euro.php3?startpage"
msgtext = ParseURL(strURL).Protocol & vbCrLf
msgtext = msgtext & ParseURL(strURL).Username & vbCrLf
msgtext = msgtext & ParseURL(strURL).Password & vbCrLf
msgtext = msgtext & ParseURL(strURL).ServerName & vbCrLf
msgtext = msgtext & ParseURL(strURL).ServerPort & vbCrLf
msgtext = msgtext & ParseURL(strURL).Filepath & vbCrLf
msgtext = msgtext & ParseURL(strURL).Dir & vbCrLf
msgtext = msgtext & ParseURL(strURL).Filename & vbCrLf
msgtext = msgtext & ParseURL(strURL).Query & vbCrLf
MsgBox msgtext, vbInformation
End Sub
No comments have been posted about This function returns any of the various components of the URL that are present. This includes the . Why not be the first to post a comment about This function returns any of the various components of the URL that are present. This includes the .