Recherche dans une string (asterisque, étoile)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 896 fois - Téléchargée 46 fois

Contenu du snippet

Cette fonction Asterisk permet de comparer deux strings

exemple :
Nom = "*bonj*vb*e" et NomEntier="Bonjour Vb France !"
Asterisk(Nomentier,Nom) ===> True

Nom = "*bondqsd*e" et NomEntier="Bonjour Vb France !"
Asterisk(Nomentier,Nom) ===> False

Source / Exemple :


Function Asterisk(ByVal Nomentier As String, ByVal Nom As String) As Boolean
    Dim pt_encour As Integer
    Dim pt_encourEntier As Integer
    Dim C As String
    Dim X As Integer
    Asterisk = False
    pt_encour = 1
    pt_encourEntier = 1
    C = "*"
    RemoveMultipleChar Nom, C
    If InStr(Nomentier, C) Then Exit Function
    If Nom = C Then
        Asterisk = True
        Exit Function
    End If
    If InStr(Nom, C) <> 1 And InStr(Len(Nom), Nom, C) = Len(Nom) Then
        ch = Left(Nom, InStr(Nom, C) - 1)
        If Left(Nomentier, Len(ch)) <> ch Then Exit Function
    ElseIf InStr(Len(Nom), Nom, C) <> Len(Nom) And InStr(Nom, C) = 1 Then
        old_X = 0
        X = 1
        While old_X < X
            ch = Right(Nom, Len(Nom) - X + 1)
            old_X = X
            X = InStr(X, Nom, C) + 1
        Wend
        If Right(Nomentier, Len(ch)) <> ch Then Exit Function
    ElseIf InStr(Nom, C) <> 1 And InStr(Len(Nom), Nom, C) <> Len(Nom) Then
        If InStr(Nom, C) = 0 Then
            If Nom = Nomentier Then
                Asterisk = True
                Exit Function
            End If
        Else
            ch = Left(Nom, InStr(Nom, C) - 1)
            If Left(Nomentier, Len(ch)) <> ch Then Exit Function
                    old_X = 0
            X = 1
            While old_X < X
                ch = Right(Nom, Len(Nom) - X + 1)
                old_X = X
                X = InStr(X, Nom, C) + 1
            Wend
            If Right(Nomentier, Len(ch)) <> ch Then Exit Function
        End If
    End If
    Asterisk = False
    Nom = "*" & Nom & "*"
    RemoveMultipleChar Nom, C
    pt_encour = 2
    ch = ""
    While (pt_encour <= Len(Nom))
        extrait = Mid(Nom, pt_encour, 1)
        If extrait = C Then
            If InStr(pt_encourEntier, Nomentier, ch) = 0 Then
                Asterisk = False
                Exit Function
            Else
                pt_encourEntier = InStr(pt_encourEntier, Nomentier, ch) + Len(ch)
            End If
            ch = ""
        Else
            ch = ch + extrait
        End If
        pt_encour = pt_encour + 1
    Wend
    Asterisk = True
End Function

Private Sub RemoveMultipleChar(ByRef chaine As String, ByVal Char As String)
    Dim i As Integer
    Dim temoin As Boolean
    Dim extrait As String
    Dim ch As String
    ch = ""
    temoin = False
    ch = ""
    For i = 1 To Len(chaine)
        extrait = Mid(chaine, i, 1)
        If extrait = Char Then
            If temoin = True Then
            Else
                temoin = True
                ch = ch + extrait
            End If
        Else
            temoin = False
            ch = ch + extrait
        End If
    Next
    chaine = ch
End Sub

A voir également

Ajouter un commentaire Commentaires
cs_Delirium Messages postés 30 Date d'inscription vendredi 11 octobre 2002 Statut Membre Dernière intervention 3 mai 2004
29 juin 2004 à 18:37
moi je trouve plus simple->

if "*bonj*vb*e" Like "Bonjour Vb France !" then

(lol)
cs_max12 Messages postés 1491 Date d'inscription dimanche 19 novembre 2000 Statut Modérateur Dernière intervention 7 juillet 2014
17 sept. 2002 à 02:23
Bin sur que c'est utile, si jme souvient bien Like n'est pas en ASP (ASP = VB + HTML), alors cette function serais très utile surtout sur ASPfr.com

@+
MajorDOOM Messages postés 28 Date d'inscription mardi 2 juillet 2002 Statut Membre Dernière intervention 3 décembre 2005
13 sept. 2002 à 16:05
merci au fete pour cette astuce, je savais que cette operteur existait sous SQL mais j'avais jamais essayé en vb.. envore un truc qui sert a rien ;(
celiphane Messages postés 466 Date d'inscription samedi 16 février 2002 Statut Membre Dernière intervention 20 avril 2007
13 sept. 2002 à 16:03
Exact, en plus tu pouvais quand même faire moins long, genre :

Private Function MieuxQueAsterisk(ByVal NomEntier As String, ByVal Nom As String) As Boolean
Dim i, j As Integer
If String(Len(Nom), "*") = Nom Then
MieuxQueAsterisk = True
Exit Function
End If
i = 0
j = 1
Do
i = i + 1
If Mid(Nom, i, 1) = "*" Then
Do
i = i + 1
Loop Until Mid(Nom, i, 1) <> "*" Or i = Len(Nom)
If i > Len(Nom) Then i = Len(Nom)
Do Until Mid(NomEntier, j, 1) = Mid(Nom, i, 1) Or j >= Len(NomEntier)
j = j + 1
Loop
End If
If Mid(NomEntier, j, 1) <> Mid(Nom, i, 1) And Mid(Nom, i, 1) <> "*" Then
MieuxQueAsterisk = False
Exit Function
Else
j = j + 1
End If
Loop Until j >= Len(NomEntier)
MieuxQueAsterisk = True
End Function

(fais en 10-15 minutes, à optimiser je pense...)
C'est tjrs bon de développer des codes existants pour les débutants... ici l'opérateur LIKE
Tch@o
MajorDOOM Messages postés 28 Date d'inscription mardi 2 juillet 2002 Statut Membre Dernière intervention 3 décembre 2005
13 sept. 2002 à 15:58
non tu te trompe pas
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.