terça-feira, 11 de dezembro de 2007

GetRelativePath()

Mapeia o caminho relativo para um arquivo a partir da pasta atual.

Function GetRelativePath(ByVal FileName)

On Error Resume Next

If Mid(FileName, 2, 1) <> ":" Then
FileName = Server.MapPath(FileName)
End If
If Err Then Err.Clear

On Error GoTo 0

Dim a, b, a1, b1
Dim i, Str, j

a = Server.MapPath(AspSelf())
b = FileName
a = Split(a, "\")
b = Split(b, "\")
a1 = UBound(a)
b1 = UBound(b)

i = 0
Str = ""

Do While i <= a1 And i <= b1
If LCase(a(i)) <> LCase(b(i)) Then
For j = 0 To a1 - i - 1
Str = Str & "../"
Next
For j = i To b1
Str = Str & b(j)
If j <> b1 Then Str = Str & "/"
Next
GetRelativePath = Str
Exit Function
End If
i = i + 1
Loop

While i <= b1
Str = Str & b(i)
If i < str =" Str">
i = i + 1
Wend

If Str = "" Then Str = a(a1)
GetRelativePath = Str

End Function

Nenhum comentário: