Creation de chemins relatifs

Télécharger le projet
Commenter

Description

J'etais surpris de ne pas trouver d'avantage de sources sur le net concernant la creation de fichiers relatifs, donc j'ai cre cette fonction.

Cette fonction va cree un chemin relatif lui donnant un chemin de dossier de reference
'Example 1
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 0
'PathLink = C:\Documents and Settings\Jeremy\Desktop\simulation numDiv = 4
'Return = .\simulation

'Example 2
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 3
'PathLink = C:\simulation numDiv = 2
'Return = ..\..\..\simulation

'Example 3
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 3
'PathLink = C:\Test\Jeremy\Desktop\simulation numDiv = 2
'Return = ..\..\..\Test\Jeremy\Desktop\simulation

'Example 4
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 2
'PathLink = C:\Documents and Settings\Test\Folder\simulation numDiv = 3
'Return = ..\..\Test\Folder\simulation

'Example 5
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 1
'PathLink = C:\Documents and Settings\Jeremy\Test numDiv = 4
'Return = ..\Test

'Example 6
'PathReference = C:\Documents and Settings\Jeremy\Desktop numUp = 3
'PathLink = C:\Documents and Settings numDiv = 2
'Return = ..\..

Voici la fonction, prete a copier coller!

Source / Exemple : 


Public Function GetRelativePath(ByVal PathReference As String, ByVal PathLink As String) As String
        'Example 1
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 0
        'PathLink       = C:\Documents and Settings\Jeremy\Desktop\simulation   numDiv = 4
        'Return         = .\simulation                                          

        'Example 2
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 3
        'PathLink       = C:\simulation                                         numDiv = 2
        'Return         = ..\..\..\simulation                                   

        'Example 3
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 3
        'PathLink       = C:\Test\Jeremy\Desktop\simulation                     numDiv = 2
        'Return         = ..\..\..\Test\Jeremy\Desktop\simulation               

        'Example 4
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 2
        'PathLink       = C:\Documents and Settings\Test\Folder\simulation      numDiv = 3
        'Return         = ..\..\Test\Folder\simulation                          

        'Example 5
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 1
        'PathLink       = C:\Documents and Settings\Jeremy\Test                 numDiv = 4
        'Return         = ..\Test                                               

        'Example 6
        'PathReference  = C:\Documents and Settings\Jeremy\Desktop              numUp = 3
        'PathLink       = C:\Documents and Settings                             numDiv = 2
        'Return         = ..\..                  

        'avant de faire quoi que ce soit, on verifie si les chemins sont les memes
        'si c vrai, on exit
        If PathReference = PathLink Then
            Return ""
            Exit Function
        End If

        Dim ArrPathRef(), ArrPathLink() As String 'tableau des noms de dossiers
        Dim Path As String  'le chemin relatif a renvoyer
        Dim k, maxLength As Integer 'un counter
        Dim numUp As Integer  'le nombre de dossier a monter dans le chemin de ref jusqu'a la divergence
        Dim numDiv As Integer = 1  'le nombre de dossier depuis la racine jusqu'a la divergence (la racine est 1)

        'On cree l'array de dossier
        ArrPathRef = Split(PathReference, "\")
        ArrPathLink = Split(PathLink, "\")

        'si les 2 chemins sont dans une partion differente
        'on renvoi le chemin entier de celui a lier
        If ArrPathRef(0) <> ArrPathLink(0) Then
            Return PathLink
            Exit Function
        End If

        'on cherche le chemin le plus long
        If ArrPathLink.Length > ArrPathRef.Length Then
            maxLength = ArrPathLink.Length
        Else
            maxLength = ArrPathRef.Length
        End If

        'obtention du point de divergence
        For k = 0 To maxLength
            'on incremente jusqu'a la fin des chemins ou 
            'l'observation d'une divergence entre les chemins
            If k > ArrPathLink.Length - 1 _
            OrElse k > ArrPathRef.Length - 1 _
            OrElse ArrPathLink(k) <> ArrPathRef(k) _
            Then
                Exit For
            End If

            numDiv = numDiv + 1
        Next

        'maintenant avec le point de divergence, obtention du nombre
        'de dossier a monter ou a descendre 
        numUp = ArrPathRef.Length - numDiv + 1

        'on reconstruit la chaine
        Path = ""

        'On ajoute la partie a monter
        If numUp = 0 Then
            Path = "."
        Else
            For k = 0 To numUp - 1
                If k = 0 Then
                    Path = ".."
                Else
                    Path = Path & "\.."
                End If
            Next
        End If

        'on ajoute la parti a descendre
        For k = (numDiv - 1) To ArrPathLink.Length - 1
            Path = Path & "\" & ArrPathLink(k)
        Next

        Return Path
    End Function

Conclusion :


Ca marche tant que les dossiers sont dans la meme partition, sinon ca plante... si qqun trouve, merci de poster!
Télécharger le projet

Codes Sources

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 (pinje)