Получение сведений из URL.
Данная функция возвращает различные компоненты web-страницы.
Включая "host", "port", "user", "pass", "path" и "query"
Private Type typURL 'http://sit:sitter@proxy.spiderit.net:881/prox/proxycfg.php3?openpage
Protocol As String 'какой протокол (http://, ftp:// или другой)
ServerName As String 'имя сервера (proxy.spiderit.net)
Filename As String 'имя страницы (proxycfg.php3)
Dir As String 'директория (/prox/)
Filepath As String 'путь файла (/prox/proxycfg.php3)
Username As String 'имя пользователя (sit)
Password As String 'пароль (sitter)
Query As String 'строка запроса (openpage)
ServerPort As Integer 'порт сервера (881)
End Type
Const strNOCONTENT As String = "NOCONTENT"
Const intDEFAULTPORT As Integer = 80
Private 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) 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
Private Sub Form_Load()
'Const strURL As String = "http://visualprogs.narod.ru/index.html"
Const strURL As String = "http://sit:sitter@proxy.spiderit.net:881/prox/proxycfg.php3?openpage"
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
|
