[VBS] Décomposition d'une adresse URL

Version imprimable

:salut:
Je souhaite faire une décomposition d'une adresse URL :
Alors j'ai modifié ce script trouvé ici ==> http://roger.neel.free.fr/langages/c...ubmatches.html

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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 = InputBox( "Please input the http or the https address.", " What makes up a Url ?","http://www.lesite.com:8080/coursasp/sommaire.html#ancre")
      result = Search("(\w+):\/\/([^/:]+):?(\d*)?\/(.*[^.])\/(\w+.\w+)#?(\w+)?",adress)
      Title = "Decomposition of a URL adress"
      MsgBox Title & "(Uniform Resource Locator ) ==> URL : " & DblQuote(adress) & vbCrLf & vbCrLf _
                           & result,64,Title

Donc, mon problème est quand je tape par exemple une URL = "http://www.google.com" ==> le script me retourne une erreur dans la ligne N°18 "Argument ou procédure incorrecte"
Alors je cherche comment contourner cette erreur ? :koi:
:merci:

Salut

Eventuellement:

Code:

1
2
3
4
5
6
7
        Set Collection = objet.Execute(MyString)
        If TypeName(Collection) = "Nothing" Then
            'objet.Execute(MyString) n'a pas renvoyé d'objet
            Else
            'objet.Execute a bien créé un objet Collection
            Set correspondance = Collection(0)
        End If

Citation:

Alors je cherche comment contourner cette erreur ?

Je réalisé que ta demande est de formuler un bon Pattern, non pas de gérer une erreur, je ne suis pas des plus fort pour la rédaction du Pattern.
Par contre, pour éviter erreur dans la ligne N°18 "Argument ou procédure incorrecte" tu peux aussi vérifier le compteur de la collection.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
      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)
        If collection.Count <> 0 Then
            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))
            Else
            result = "pas d’occurrence trouvée pour le Pattern" & vbCrLf & objet.Pattern
        End If
 
        Search = result
      End Function

D'abord, dans la racine des choses déjà, le pattern et les indices de submatches sont liés d'une manière intime, et c'est pour ça je ne pense pas c'est une bonne idée de passer le pattern comme argument tandis que les submatches sont scriptés dedans la fonction. La fonction semble générale mais en fait elle ne l'est pas à cet égard.

En puis, je peux proposer un pattern avec une portée d'applicabilité plus étendue qui semble le moins de chose qu'on doit faire pour faire justice à la spec de url.

Voici ce que je propose pour améliorer dans ces directions.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
'*********** nouvelle fonction ********
Function Search2(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))
 
        Search2 = result
    else
        'no match, mettre message si nécessaire...
        Search2=""
    end if
End Function
 
 
'échantillons pour testing
adress="http://www.google.com"
adress="http://www.google.com#abc"
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"
 
result=Search2(trim(adress))
 
'msgbox etc etc

Superbe Fonction !

:salut: tsuji et :merci: pour cette nouvelle fonction qui marche nickel 5/5 http://r19.imgfast.net/users/1917/56...2626400047.gif
ceci est dit, j'aimerai que vous me commentiez cette superbe fonction et surtout le pattern, ça sera utile pour moi avant pour la comprendre et la "digérer" et aussi pour les autres membres.
Encore une autre fois 1000 :merci: et 1000 :plusser: si je peux le faire :king:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Option Explicit
Dim adress,result,Title
Title = "Decomposition of a URL adress"
'échantillons pour testing
'adress="http://www.google.com"
'adress="http://www.google.com#abc"
'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.lesite.com:8080/coursasp/sommaire.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
'no match, mettre message si nécessaire...
		Search=""
	end if
End Function
'*****************************************************************
'Fonction pour ajouter des guillemets dans une variable
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************

04/10/2013, 16h43
I'm_HERE

salut,

merci tsuji pour ton aide et ton code, juste une toute petite remarque: tu peux améliorer le bout du pattern en libérant de la mémoire (quoique insignifiante dans notre cas) et augmenter la vitesse de recherche du moteur Regex en ne capturant que les groupes devant être capturer, une chose du genre:

pas fullement tester, mais à priori ça va marcher:

Code:

Pattern = "^(\w+):\/\/([^/:]+)(?::(\d+))?(?:\/(?:(?:([^/]+)\/)?(?:([^#]+))?(?:(?:#(\w+)?)?)?)?)?$"

Bonne continuation
04/10/2013, 19h39
tsuji

D'abord merci Walid pour ta note qui porte des éléments de substance. Pour ceux qui n'ont pas compris, en utilisant la notion de non-mémorization avec parenthèses, on peut en effet garder les indices 0 à 5 comme utilisé dans le message originel. C'est très bien et cette notion n'est pas trop souvent utilisée en ce qui me concerne.

Et à Mehdi, je vais essayer de faire un peu de commentaires après quand je pourrais me mettre plus tranquille: c'est un lourd de travail...

Mais avant le faire, je dois avancer un petit amendement: c'est que la ligne

Citation:

"(#(\w+)?)?" & _

doit être lire comme

Code:

"#(\w+)?" & _

avec un pair de parenthèse de moins comme il y en a un englobant déjà que je l'ai séparé avec le souci aidant pour une lecture plus claire. Cela finit par avoir ((#(\w+)?)?)? ce qui n'est d'autre chose que (#(\w+)?)? tout seul. Il marche le même mais ce n'est pas joli joli.

Avec cet amendement, on doit naturellement changer l'index pour la ligne Anchor de

Citation:

& "Anchor = "& DblQuote(correspondance.SubMatches(12))

à

Code:

& "Anchor = "& DblQuote(correspondance.SubMatches(11))

Voilà ce qu'il faut faire pour enlever cette redondance dans le pattern.

Je ne pense pas qu'on me demande un commentaire de la syntaxe. Le script décomposé doit se parler et il se parle suffisamment clair, sinon, même j'ajoute des commentaires explicatifs, ça n'eclairerait toujours pas assez pour ce qui n'est pas initié - je parle de mon expérience. Pourtant je le fais par-ci par-là de même dans cette direction.

J'essaie de commenter principalement du point de vue fonctionel.

Le pattern se construit comme ceci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 #1 ^ #2 (\w+):\/\/([^/:]+) #3 (:(\d+))? #4 ( #5 \/ #6 ( #7 ( #8 ([^/]+) #9 \/ #10 )? #11 ( #12 ([^#]+) #13 )? #14 ( #15 (rev) #(\w+)? #16 )? #17 )? #18 )? #19 $
#1-#19
Le pattern est contruit avec le but de matcher le texte entier (^ ... $) de MyString.
Il va matcher tout de suite \w, donc, il ne tolère pas les espaces au début, et le pattern ne les tolère à la fin non plus. Par conséquence, il vaut mieux avoir un préprocesseur sur MyString par trim() ou de ce genre.

#2
Là, ça va essayer de matcher un schéma de url. Et tout de suite on remarque le sous-pattern \w+ est assez faible.

#2 [1] \w+
étant equivalent à [a-zA-Z0-9_] est vague et en fait la syntaxe de url entière se varie dépendant le schéma ou le protocol.
On peut essayer de faire une énumération dénombrable comme

(http|https|ftp|file|etcetc)

mais ça ne résout pas grand-chose: la syntaxe entière est beaucoup trop dépendant du protocol.

On peut forcer un http or https comme au lieu de (\w+) on y place (http|https). Mais on craint c'est trop restrictif pour le but etc etc...

Mais on devrait trouver une balance de convénance et de rigueur et d'applicabilité. C'est le principe qu'on va voir important ailleurs dans ce pattern.

#2 [2] \/\/
semble évident

#2 [3] [^/:]+
essaie de matcher évidemment le hostpost (terme technique d'après le rfc, le nom de domaine ou l'adress ip) d'une façon rudimentaire. Il accepte pratiquement tout sauf le deux-points et la barre oblique. Comme le hostpost va suivir soit par la partie de port (:digit), soit par le séperateur /.

Ici encore on parle déjà exclusivement http ou https pour simplifier des choses.

Pour le faire avec plus de rigueur, on doit le faire comme ça (sans tenir compte trop d'escapage ici)

([a-zA-Z]([a-zA-Z0-9]|[$_@.&+-]|%[a-fA-F0-9]{2}|[!*"',])+|\d+\.\d+\.\d+\.\d+)

comme c'est terrible à comprendre pour une fonction qui destine à faire une décomposition visuelle approximative.
Et ce n'est même pas très correct pour d'autres protocols...

On va très vite transformer d'un commentaire à un critique trop exigeant. Encore, un point de balance entre rigueur et applicabilité doit se tenir quoique très subjectif.

#3
(:(\d+))?
Pour ce sous-pattern, c'est suffisamment correct. Pratiquement le seul qui ne doit pas recueillir trop de critique.

#4-#18 et #6-#17
regroupent un sous-pattern qui pourrait ne pas apparaître.

#5 et #9
\/ est une barre oblique. Il n'est pas entre parenthèses de sous-pattern #5-#17 c'est parce qu'on ne le faire appeler quand on sorte le message sur le Folder et le Path.

#8 et #12
sont construites avec le même souci d'accepter tout sur tout jusqu'au prochain séparateur / et # successivement. C'est assez approximatif dans le même esprit du principe qu'on a déjà parlé ci-desus.

#15
#(\w+)?
semble évident après tous les commentaires desus.