Code archives/Algorithms/RelativePath
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| This code will turn a path to a relative path system eg. GetPath("c:\windows\system\drivers\","c:\windows\readme.txt") will return "..\..\readme.txt" | |||||
Dim Root$(64)
Dim ssFile$(64)
Function GetRelativePath$(strRoot$, strFile$)
Local i%, NewTreeStart%, sRel$
Local RootCount%, FileCount%
If Left(strRoot, 3) <> Left(strFile, 3) Then
GetRelativePath = strFile
Return ""
End If
buffa$ = ""
For i=1 To Len(strRoot$)
If Mid(strRoot$,i,1)="\" Then
RootCount% = RootCount% + 1
Else
buffa$ = Mid(strRoot$,i,1)
Root$(RootCount%) = Root$(RootCount%) + buffa$
End If
Next
buffa$ = ""
For i=1 To Len(strFile$)
If Mid(strFile$,i,1)="\" Then
FileCount% = FileCount% + 1
Else
buffa$ = Mid(strFile$,i,1)
ssfile$(FileCount%) = ssfile$(FileCount%) + buffa$
End If
Next
i=0
While Root(i) = ssFile(i)
i = i + 1
Wend
If i = RootCount% Then
While i <= FileCount%
sRel = sRel + ssFile(i) + "\"
i = i + 1
Wend
GetRelativePath = Left(sRel, Len(sRel) - 1)
Return ""
End If
NewTreeStart = i
While i < RootCount
sRel = sRel + "..\"
i = i + 1
Wend
While NewTreeStart <= FileCount
sRel = sRel + ssFile(NewTreeStart) + "\"
NewTreeStart = NewTreeStart + 1
Wend
Return Left(sRel, Len(sRel) - 1)
End Function |
Comments
None.
Code Archives Forum