Relative References to Files

These two functions create and read relative file locations just like you would use in HTML.

Public Function FindFile(ByVal ReferenceString As String, ByVal CurentLocation As String) As String
   'handle bad paramiters
       If CurentLocation = "" Then
           FindFile = ReferenceString
           Exit Function
       End If
   
   If Right(Left(ReferenceString, 3), 2) = ":\" Then 'This reference is hardly a reference
       FindFile = ReferenceString
       Exit Function
   End If
   
   'Romove file from CurentLocation, if any
       Do Until Right(CurentLocation, 1) = "\"
           CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
       Loop
   
   'Move back the numbers of folders shown in ReferenceString
       If Left(ReferenceString, 1) = "." Then
           ReferenceString = Right(ReferenceString, Len(ReferenceString) - 1)
           CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
           Do Until Left(ReferenceString, 1) <> "."
               Do Until Right(CurentLocation, 1) = "\"
                   CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
               Loop
               CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
               ReferenceString = Right(ReferenceString, Len(ReferenceString) - 1)
           Loop
       End If
   
   'add what left of the ReferenceString
       FindFile = CurentLocation & ReferenceString
       
End Function

Public Function CompressFile(ByVal CurentLocation As String, ByVal FileLocation As String) As String
Dim X As Integer
Dim Y As Integer
Dim Levles As Integer
   'Hanble bad paramiter
       If CurentLocation = "" Then
           CompressFile = FileLocation
           Exit Function
       End If
   
   'Remove file name in CurentLocation, if any
       Do Until Right(CurentLocation, 1) = "\"
           CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
       Loop
       
   'Find ware the folders change
       X = 1
       Do Until Left(CurentLocation, X) <> Left(FileLocation, X)
           X = X + 1
       Loop
   
       If X <= 3 Then
           CompressFile = FileLocation
           Exit Function
       End If
   
   
   'Remove the simaler parts
       CurentLocation = Right(CurentLocation, Len(CurentLocation) - X + 1)
       FileLocation = Right(FileLocation, Len(FileLocation) - X + 1)
   
   'Count how many folders back we need to travel
       Do Until CurentLocation = ""
           If Right(CurentLocation, 1) = "\" Then
               Levles = Levles + 1
           End If
           CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
       Loop
   

   'Add the correct header
       If Levles > 0 Then
           FileLocation = ".\" & FileLocation
           For Y = 1 To Levles
               FileLocation = "." & FileLocation
           Next
       End If
   
   
   CompressFile = FileLocation
   
End Function

You might also like...

Comments

Nick Avery I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Computer Science is no more about computers than astronomy is about telescopes.” - E. W. Dijkstra