Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

[VBS] Decomposition of a URL address

Status
Not open for further replies.

crackoo

Programmer
Feb 17, 2011
132
TN
Hi [peace]
I want to make a decomposition of a URL
So I have this Vbscript below :
My problem is when I type eg URL = " ==> the script returns me an error in line N ° 18 "incorrect procedure or argument"
However, when I type this URL = " ==> then it works 5/5
So I'm looking how to get around this error ?

Code:
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 = "[URL unfurl="true"]http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"[/URL]
      adress = InputBox( "Please input the http or the https address.", " What makes up a Url?","[URL unfurl="true"]http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre")[/URL]
      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 !
 
In fact I'd use the Split function instead of regexp ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hi [peace]
I found the solution using RegExp
2626400047.gif


Code:
Option Explicit
Dim adress,result,Title
Title = "Decomposition of a URL adress"
'Some examples for testing
'adress = "[URL unfurl="true"]http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"[/URL]
'adress = "ftp://ftp.microsoft.com/softlib/index.txt‎"
'adress = "[URL unfurl="true"]http://www.google.com"[/URL]
'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 ?","[URL unfurl="true"]http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre")[/URL]
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
'*****************************************************************
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top