|
Relative Pfadangaben zu Dateien kennen Sie aus Web-Seiten, aber
auch aus den Projekt- und Projektgruppen-Dateien (.vbp, .vbg) von
Visual Basic. Eine relative Pfadangabe bedeutet, dass der angegebene
Pfad relativ zu einem anderen (Basis-)Pfad zu ermitteln ist, der
selbst natürlich ebenfalls angegeben oder bekannt sein muss.
Beispiele für relative Pfadangaben zur Datei c:\windows\system.dat:
Relativ: system.dat
Basis: c:\windows
Oder:
Relativ: ..\system.dat
Basis: c:\windows\system
Oder:
Relativ: ..\..\..\windows\system.dat
Basis: c:\aa\bb\cc
Die Funktionen ResolveRelativePath und MakeRelativePath lösen
eine relative Pfadangabe auf bzw. erzeugen eine solche. Beiden
Funktionen können Sie im zweiten optionalen Parameter den
Bezugspfad übergeben. Lassen Sie ihn weg, wird automatisch das
aktuelle Arbeitsverzeichnis der Anwendung ( CurDir)
als Basis verwendet. Ebenfalls bei beiden Funktionen können Sie im
dritten und ebenfalls optionalen Parameter ein anderes als das
voreingestellte Pfad-Trennzeichen (Backslash - "\")
angeben, etwa den gewöhnlichen Schrägstrich, wie er bei
Internet-Pfadangaben (Unix-Dateisysteme) üblich ist.
Der Funktion ResolveRelativePath übergeben Sie im ersten, in
jedem Fall obligatorischen Parameter die aufzulösende relative
Pfadangabe. Als Rückgabewert erhalten Sie den formal aufgelösten
Pfad. Ob eine Datei oder ein Verzeichnis zu diesem Pfad tatsächlich
existieren, wird nicht geprüft, da es ja auch möglich sein kann,
dass Sie die Datei bzw. den Pfad erst erzeugen möchten. Enthält
die relative Pfadangabe zu viele relative Schritte, die über das
Wurzelverzeichnis des betreffenden Laufwerks (bei Netzwerk-Pfaden
entspricht dies dem Server-Namen) hinausgehen würden, gibt die
Funktion den abfangbaren Laufzeitfehler rpErrTooManySteps aus der
RelativePathErrors-Enumeration zurück.
Im ersten ebenfalls obligatorischen Parameter der Funktion
MakeRelativePath übergeben Sie den vollständigen Pfad zu einer
Datei bzw. einem Verzeichnis, der in eine relative Pfadangabe
umgesetzt werden soll. Unterscheiden sich die Laufwerksangaben in
beiden Pfaden (bzw. bei Netzwerk-Pfaden die Server-Namen), kann
natürlich keine relative Pfadangabe erzeugt werden - es wird der
abfangbare Laufzeitfehler rpErrDifferentRoot ausgelöst.
Public Enum RelativePathErrors
rpErrTooManySteps = 50001
rpErrDifferentRoot = 50011
End Enum
Public Function ResolveRelativePath(RelativePath As String, _
Optional BasePath As String, _
Optional PathSeparator As String = "\") As String
Dim nBasePath As String
Dim nBaseParts As Variant
Dim nPathParts As Variant
Dim i As Integer
Dim p As Integer
Dim nPath As String
Dim nResolvedPath As String
Dim nServerRoot As String
If Len(BasePath) Then
nBasePath = BasePath
Else
nBasePath = CurDir
End If
If Right$(nBasePath, 1) = PathSeparator Then
nBasePath = Left$(nBasePath, Len(nBasePath) - 1)
End If
If Left$(nBasePath, 2) = "\\" Then
nBasePath = Mid$(nBasePath, 3)
nServerRoot = "\\"
End If
nPathParts = Split(RelativePath, PathSeparator)
If nPathParts(0) = ".." Then
nBaseParts = Split(nBasePath, PathSeparator)
For i = 0 To UBound(nPathParts)
If nPathParts(i) = ".." Then
p = p + 1
Else
If p Then
nPath = nPath & PathSeparator & nPathParts(i)
End If
End If
Next 'i
If p > UBound(nBaseParts) Then
Err.Raise rpErrTooManySteps, _
"modRelativePaths.ResolvePath", "rpErrTooManySteps"
Else
For i = 0 To UBound(nBaseParts) - p
nResolvedPath = nResolvedPath & nBaseParts(i) _
& PathSeparator
Next 'i
ResolveRelativePath = nServerRoot & nResolvedPath _
& Mid$(nPath, 2)
End If
Else
ResolveRelativePath = nServerRoot & nBasePath & PathSeparator _
& RelativePath
End If
End Function
Public Function MakeRelativePath(Path As String, _
Optional BasePath As String, _
Optional PathSeparator As String = "\") As String
Dim nPath As String
Dim nPathParts As Variant
Dim nBasePath As String
Dim nBaseParts As Variant
Dim i As Integer
Dim nRelative As Boolean
Dim nRelativePath As String
Dim p As Integer
If Left$(Path, 2) = "\\" Then
nPath = Mid$(Path, 3)
Else
nPath = Path
End If
nPathParts = Split(nPath, PathSeparator)
If Len(BasePath) Then
nBasePath = BasePath
Else
nBasePath = CurDir
End If
If Right$(nBasePath, 1) = PathSeparator Then
nBasePath = Left$(nBasePath, Len(nBasePath) - 1)
End If
If Left$(nBasePath, 2) = "\\" Then
nBasePath = Mid$(nBasePath, 3)
End If
nBaseParts = Split(nBasePath, PathSeparator)
If LCase$(nBaseParts(0)) <> LCase(nPathParts(0)) Then
Err.Raise rpErrDifferentRoot, _
"modRelativePaths.MakeRelativePath", "rpErrDifferentRoot"
End If
For i = 1 To UBound(nBaseParts)
If nRelative Then
nRelativePath = "..\" & nRelativePath
Else
If LCase$(nBaseParts(i)) <> LCase(nPathParts(i)) Then
nRelative = True
nRelativePath = ".."
For p = i To UBound(nPathParts)
nRelativePath = nRelativePath & PathSeparator _
& nPathParts(p)
Next 'p
End If
End If
Next 'i
If Len(nRelativePath) Then
MakeRelativePath = nRelativePath
Else
MakeRelativePath = nPathParts(UBound(nPathParts))
End If
End Function
|