Raccourcir un chemin (path) ou url internet

Commenter

Contenu du snippet

Je pensais que je trouverai cette source sur le site, mais je n'ai rien trouvé! Il faut dire que trouver le bon terme pour cette fonction n'est pas des plus simple. Du coup, j'ai lancé VB et j'ai codé cette fonction que je voulais. Et puisqu'elle ne semble pas être sur le site, j'en profite également pour vous la proposer.
Le code est plutôt simple; il n'y a qu'une fonction à placer soit dans un module (pour pouvoir être réutilisé dans vos autres projets), soit directement dans le code d'une form. Le plus de ma source est qu'elle est très souple et est compatible aussi bien avec des chemins classiques (ex: C:\Program files\logiciel\truc) ainsi qu'avec des URL (ex: http://www.site.fr/dossier/truc ou ftp://127.0.0.1/dossier/cool/prog).

La fonction permet de réduire une URL, comme on peut voir dans certains logiciel ou dans certains programmes d'installation. Et comme un exemple vaut mieux qu'un long discourt...
On lui donne ça: C:\Program Files\Microsoft Visual Studio\VB98\projets\test\v1.2
Et la fonction retourne ça (par exemple): C:\Program Files\[...]\v1.2

Le chemin (ou URL) peut se finir par un nom de fichier, dans ce cas, la fonction retournera quelque chose comme C:\Program Files\[...]\fichier.txt

La fonction prend au maximum 5 paramètres dont voici le détail:
- Path : Le chemin à traiter
- NbrDossiers : spécifie le nombre de dossier qui doit rester (sans compter la lettre du lecteur)
- Delimiteur : paramètre optionnelle spécifiant le caractère qui délimite les dossiers (par défaut "\")
- RemplacerPar : paramètre optionnelle spécifiant le terme qui doit être placé en lieu et place des dossiers en trop (par défaut "[...]")
- DelimiteurDeFin : paramètre optionnelle spécifiant s'il faut ajouter le caractère contenu dans Delimiteur à la fin du chemin avant de le retourner (par défaut False)

Source / Exemple : 


'
'
' Permet de réduire une URL
' par Tioneb pour VBFrance.com
'
'
'------code à placer dans un module ou directement dans une form
Public Function RaccourcirPath(Path As String, NbrDossiers As Integer, Optional Delimiteur As String = "\", Optional RemplacerPar As String = "[...]", Optional DelimiteurDeFin As Boolean = False) As String
    Dim Tmp() As String, i As Integer, PathRaccourci As String, PathSaved As String
    
    If NbrDossiers <= 0 Or Len(Path) <= 3 Then
        'si on rentre une valeur qui n'a pas de sens, et bien on renvoi simplement le chemin complet
        RaccourcirPath = Path
        Exit Function
    End If
    If Right(Path, 1) = Delimiteur Then
        'si le dernier caractère est le délimiteur, on le supprime
        Path = Left(Path, Len(Path) - 1)
    End If
    PathSaved = Path 'on sauvegarde le chemin au cas où on ne passerait pas la prochaine condition
    Path = Replace(Path, Delimiteur & Delimiteur, Delimiteur, , , vbTextCompare) 'on supprime les doubles délimiteur
    Tmp() = Split(Path, Delimiteur, , vbTextCompare) 'on crée un tableau avec le chemin entré
    If UBound(Tmp()) + 1 <= NbrDossiers Or UBound(Tmp()) = 1 Then
        'si le chemin à traiter contient moins de dossiers que la limite, on renvoi le chemin (sauvegardé) entier
        RaccourcirPath = PathSaved
        Exit Function
    End If
    
    PathRaccourci = Tmp(0) & Delimiteur 'on place la lettre du lecteur dans la variable de sortie
    For i = 1 To NbrDossiers - 1 'boucle pour ajouter le nombre de dossier avant la chaine de réduction
        PathRaccourci = PathRaccourci & Tmp(i) & Delimiteur
    Next i
    
    PathRaccourci = PathRaccourci & RemplacerPar & Delimiteur & Tmp(UBound(Tmp())) 'on ajout les points de suspension et le dernier dossier
    If DelimiteurDeFin = True Then 'si on demande d'ajouter le délimiteur à la fin du chemin, eh bien on le fait
        PathRaccourci = PathRaccourci & Delimiteur
    End If
    
    'traitement spécial pour les URLs internet (on rajoute le slash qui manque)
    If Left(LCase(Path), 5) = "http:" Then
        PathRaccourci = Left(PathRaccourci, 5) & Delimiteur & Right(PathRaccourci, Len(PathRaccourci) - 5)
    ElseIf Left(LCase(Path), 4) = "ftp:" Then
        PathRaccourci = Left(PathRaccourci, 4) & Delimiteur & Right(PathRaccourci, Len(PathRaccourci) - 4)
    End If
    
    RaccourcirPath = PathRaccourci
End Function

Conclusion :


J'ai testé pas mal d'URL avant de poster et je ne pense pas qu'il y ai de bug. Toutefois, si vous en trouvez, postez un petit commentaire...

Il n'y a pas de capture et pas de zip; c'est inutile pour cette source. Un copier/coller suffit.

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Tioneb)