[VBS] Decomposition of a URL address

Anything VBScript-related, including Windows Script Host, WMI, ADSI, and more.
Forum rules
Do not post any licensing information in this forum.

Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
This topic is 10 years and 5 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked
User avatar
hackoo
Posts: 103
Last visit: Tue Apr 26, 2016 9:02 am

[VBS] Decomposition of a URL address

Post by hackoo »

Hi ;)
I want to make a decomposition of a URL
So I have this Vbscript below :
My problem is when I type eg URL = "http://www.google.com" ==> the script returns me an error in line N ° 18 "incorrect procedure or argument"
However, when I type this URL = "http://www.laltruiste.com:8080/coursasp ... tml#anchor" ==> then it works 5/5
So I'm looking how to get around this error ?
VBScript Code
Double-click the code block to select all.
Option Explicit
 Dim adress,result,Title
 '*****************************************************************
'Fonction pour ajouter des guillemets dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************
      Function Search(Pattern,MyString)
        Dim objet
        Dim correspondance
        Dim collection
        Set objet = New RegExp
        objet.Pattern = Pattern
        objet.IgnoreCase = True
        objet.Global = True
        Set collection = objet.Execute(MyString)
        Set correspondance = collection(0)
        result = "Protocol = " & DblQuote(correspondance.SubMatches(0)) & VbCRLF & vbCrLf _
                         & "Domain = " & DblQuote(correspondance.SubMatches(1)) & VbCRLF & vbCrLf _
                         & "Port = " & DblQuote(correspondance.SubMatches(2)) & vbCrLf & vbCrLf  _ 
                         & "Folder = " & DblQuote(correspondance.SubMatches(3)) & VbCRLF& vbCrLf  _
                         & "File = " & DblQuote(correspondance.SubMatches(4)) & VbCRLF& vbCrLf  _ 
                         & "Anchor = "& DblQuote(correspondance.SubMatches(5))                     
        Search = result
      End Function
'*****************************************************************
      'adress = "http://www.laltruiste.com:8080/coursasp ... html#ancre"
      adress = InputBox( "Please input the http or the https address.", " What makes up a Url?","http://www.laltruiste.com:8080/coursasp ... html#ancre")
      result = Search("(\w+):\/\/([^/:]+):?(\d*)?\/(.*[^.])\/(\w+.\w+)#?(\w+)?",adress)
      Title = "Decomposition of a URL address"
      MsgBox Title & "(Uniform Resource Locator ) ==> URL : " & DblQuote(adress) & vbCrLf & vbCrLf _
                           & result,64,Title
Thnak you !
Last edited by hackoo on Thu Oct 03, 2013 10:49 am, edited 1 time in total.
jvierra
Posts: 15439
Last visit: Tue Nov 21, 2023 6:37 pm
Answers: 30
Has voted: 4 times
Been upvoted: 33 times

Re: [VBS] Decomposition of a URL address

Post by jvierra »

That is because your regex is not working when parts are missing.
jvierra
Posts: 15439
Last visit: Tue Nov 21, 2023 6:37 pm
Answers: 30
Has voted: 4 times
Been upvoted: 33 times

Re: [VBS] Decomposition of a URL address

Post by jvierra »

You can use PowerShell to do this very easily.
PowerShell Code
Double-click the code block to select all.
PS C:\scripts> $uri='http://www.laltruiste.com:8080/coursasp ... tml#anchor'
PS C:\scripts> [system.uri]$uri


AbsolutePath   : /coursasp/sommaire.html
AbsoluteUri    : http://www.laltruiste.com:8080/coursasp ... tml#anchor
LocalPath      : /coursasp/sommaire.html
Authority      : www.laltruiste.com:8080
HostNameType   : Dns
IsDefaultPort  : False
IsFile         : False
IsLoopback     : False
PathAndQuery   : /coursasp/sommaire.html
Segments       : {/, coursasp/, sommaire.html}
IsUnc          : False
Host           : www.laltruiste.com
Port           : 8080
Query          :
Fragment       : #anchor
Scheme         : http
OriginalString : http://www.laltruiste.com:8080/coursasp ... tml#anchor
DnsSafeHost    : www.laltruiste.com
IsAbsoluteUri  : True
UserEscaped    : False
UserInfo       :
User avatar
hackoo
Posts: 103
Last visit: Tue Apr 26, 2016 9:02 am

[RESOLVED] [VBS] Decomposition of a URL address

Post by hackoo »

Hi ;)
I found the solution using RegExp Image
VBScript Code
Double-click the code block to select all.
Option Explicit
Dim adress,result,Title
Title = "Decomposition of a URL adress"
'Some examples for testing
'adress = "http://www.laltruiste.com:8080/coursasp ... html#ancre"
'adress = "ftp://ftp.microsoft.com/softlib/index.txt‎"
'adress = "http://www.google.com"
'adress = "p://x:8/y/z.ext#ancre"
'adress = "p://x/"
'adress = "p://x:8/"
'adress = "p://x"
'adress = "p://x:8/#ancre"
'adress = "p://x:8/z#ancre"
'adress = "p://x:8/y/z/q/r#ancre"

adress = InputBox( "Please input the http or the https address.", " What makes up a Url ?","http://www.laltruiste.com:8080/coursasp ... html#ancre")
result = Search(trim(adress))
MsgBox Title & " ( Uniform Resource Locator ) ==> URL : " & DblQuote(adress) & vbCrLf & vbCrLf & result,64,Title
'*******************************************************
Function Search(MyString)
	Dim objet
	Dim correspondance
	Dim collection
	dim pattern
	
	pattern="^" & _
        "(\w+):\/\/([^/:]+)" & _
        "(:(\d+))?" & _
        "(" & _
            "\/" & _
            "(" & _
                "(" & _
                    "([^/]+)" & _
                    "\/" & _
                ")?" & _
                "(" & _
                    "([^#]+)" & _
                ")?" & _
                "(" & _
                    "(#(\w+)?)?" & _
                ")?" & _
            ")?" & _
        ")?" & _
    "$"
	
	Set objet = New RegExp
	objet.Pattern = Pattern
	objet.IgnoreCase = True
	objet.Global = True
	if objet.test(MyString) then
		Set collection = objet.Execute(MyString)
		Set correspondance = collection(0)
		
		result = "Protocol = " & DblQuote(correspondance.SubMatches(0)) & VbCRLF & vbCrLf _
		& "Domain = " & DblQuote(correspondance.SubMatches(1)) & VbCRLF & vbCrLf _
		& "Port = " & DblQuote(correspondance.SubMatches(3)) & vbCrLf & vbCrLf  _ 
		& "Folder = " & DblQuote(correspondance.SubMatches(7)) & VbCRLF& vbCrLf  _
		& "File = " & DblQuote(correspondance.SubMatches(9)) & VbCRLF& vbCrLf  _ 
		& "Anchor = "& DblQuote(correspondance.SubMatches(12))
		
		Search = result
	else
		Search = MsgBox("no match ===> no result found !",48,Title)
	end if
End Function
'*****************************************************************
'Fonction pour ajouter des guillemets dans une variable
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************
This topic is 10 years and 5 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked