[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.
Locked
User avatar
hackoo
Posts: 103
Joined: Sat Jan 22, 2011 12:27 am

[VBS] Decomposition of a URL address

Post by hackoo » Thu Oct 03, 2013 1:18 am

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.

User avatar
jvierra
Posts: 13717
Joined: Tue May 22, 2007 9:57 am
Contact:

Re: [VBS] Decomposition of a URL address

Post by jvierra » Thu Oct 03, 2013 7:32 am

That is because your regex is not working when parts are missing.

User avatar
jvierra
Posts: 13717
Joined: Tue May 22, 2007 9:57 am
Contact:

Re: [VBS] Decomposition of a URL address

Post by jvierra » Thu Oct 03, 2013 7:38 am

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
Joined: Sat Jan 22, 2011 12:27 am

[RESOLVED] [VBS] Decomposition of a URL address

Post by hackoo » Fri Oct 04, 2013 6:38 am

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
'*****************************************************************

Locked