|
Wenn Sie zwei Pfadbestandteile zu einem Pfad zusammenfügen möchten, darf sich im Endeffekt zwischen den beiden Teilen nur genau ein Trennzeichen ("\") befinden - es muss sich aber auch genau ein solches dort befinden. Das Trennzeichen kann vom Ende des linken Teils oder vom Anfang des rechten Teils stammen, es kann aber auch bei beiden Teilen oder gar nicht vorhanden sein.
Die folgende Funktion BuildPath fügt zwei Pfadbestandteile zusammen und sorgt für das Vorhandensein von und nur genau einem "\" an der Zusammenfügestelle der beiden Teile. Den zusammengefügten Pfad erhalten Sie als Rückgabewert der Funktion.
Public Function BuildPath(PathRoot As String, PathPart As String) _
As String
Select Case Right$(PathRoot, 1)
Case "\"
Select Case Left$(PathPart, 1)
Case "\"
BuildPath = PathRoot & Mid$(PathPart, 2)
Case Else
BuildPath = PathRoot & PathPart
End Select
Case Else
Select Case Left$(PathPart, 1)
Case "\"
BuildPath = PathRoot & PathPart
Case Else
BuildPath = PathRoot & "\" & PathPart
End Select
End Select
End Function
Da das Auflösen einer relativen Pfadangabe, die mit der Zeichenfolge "..\" einmalig oder mehrmals aufeinander folgend beginnt, im Prinzip auch nichts anderes ist, als das Zusammenfügen von zwei Pfadbestandteilen, bietet es sich an, die oben stehende Funktion dahingehend zu erweitern. In der folgenden Funktion BuildPathEx wird der linke Teil (PathRoot) so oft um eine Ebene reduziert, wie die Zeichenfolge "..\" dem rechten Teil (PathPart) vorangestellt ist, wenn der optionale Parameter ResolveRelativePaths auf True gesetzt ist (Voreinstellung). Ist eine der "..\"-Folge entsprechende Verkürzung des Pfades nicht möglich, weil die Wurzel überschritten würde (es werden sowohl Laufwerksbezeichner wie "c:\" als auch UNC-Rechnernamen wie "\\PC" berücksichtigt), wird der Laufzeitfehler 5 ausgelöst.
Public Function BuildPathEx(ByVal PathRoot As String, _
ByVal PathPart As String, _
Optional ByVal ResolveRelativePaths As Boolean = True) As String
Dim nPos As Integer
If ResolveRelativePaths Then
If Right$(PathRoot, 1) = "\" Then
PathRoot = Left$(PathRoot, Len(PathRoot) - 1)
End If
Do
If Left$(PathPart, 3) = "..\" Then
nPos = InStrRev(PathRoot, "\")
Select Case nPos
Case 2, 0
Err.Raise 5
Case Else
PathRoot = Left$(PathRoot, nPos - 1)
PathPart = Mid$(PathPart, 4)
End Select
Else
Exit Do
End If
Loop
End If
BuildPathEx = BuildPath(PathRoot, PathPart)
End Function
Da im Rahmen von Web-Strukturen und zusammenwachsenden Rechnerwelten der Umgang mit dem in Unix-/Linux-Welten gebräuchlichen Pfadtrenner "/" notwendig ist, folgen hier nun noch die beiden entsprechenden Varianten der obigen Funktionen:
Public Function BuildPathU(PathRoot As String, PathPart As String) _
As String
Select Case Right$(PathRoot, 1)
Case "/"
Select Case Left$(PathPart, 1)
Case "/"
BuildPathU = PathRoot & Mid$(PathPart, 2)
Case Else
BuildPathU = PathRoot & PathPart
End Select
Case Else
Select Case Left$(PathPart, 1)
Case "/"
BuildPathU = PathRoot & PathPart
Case Else
BuildPathU = PathRoot & "/" & PathPart
End Select
End Select
End Function
Public Function BuildPathExU(ByVal PathRoot As String, _
ByVal PathPart As String, _
Optional ByVal ResolveRelativePaths As Boolean = True) As String
Dim nPos As Integer
If ResolveRelativePaths Then
If Right$(PathRoot, 1) = "/" Then
PathRoot = Left$(PathRoot, Len(PathRoot) - 1)
End If
Do
If Left$(PathPart, 3) = "../" Then
nPos = InStrRev(PathRoot, "/")
Select Case nPos
Case 0
Err.Raise 5
Case Else
If Mid$(PathRoot, nPos - 1, 1) = "/" Then
Err.Raise 5
Else
PathRoot = Left$(PathRoot, nPos - 1)
PathPart = Mid$(PathPart, 4)
End If
End Select
Else
Exit Do
End If
Loop
End If
BuildPathExU = BuildPathU(PathRoot, PathPart)
End Function
|