Seite 1 von 1

Relative Pfade auflösen (all OS)

Verfasst: 03.04.2020 12:33
von Thorsten1867
Für mein Markdown Module schlage ich mich gerade mit relativen Pfaden herum:

Code: Alles auswählen

Procedure.s GetAbsolutePath(Path.s, File.s)
  Define.i i, PS
  Define.s PathPart$, Path$
  
  PathPart$ = GetPathPart(File)
  
  If PathPart$
    
    If CountString(PathPart$, ":" + #PS$) = 1 Or Left(PathPart$, 2) = #PS$ + #PS$ ;{ Absolute path name
      
      ProcedureReturn File
      ;}
    Else                                                                          ;{ Relative path name
      
      If Left(PathPart$, 3) = ".." + #PS$    ;{ A relative path to a file in a directory that is a peer of the current directory

        Path$ = ""
        Path  = ReplaceString(Path, #PS$ + #PS$, "|" + #PS$)
        
        PS = CountString(Path, #PS$)
        If PS > 1
          For i=1 To PS - 1
            Path$ + StringField(Path, i, #PS$) + #PS$
          Next
          ProcedureReturn ReplaceString(Path$, "|", #PS$) + Mid(File, 4)
        Else
          ProcedureReturn ReplaceString(Path,  "|", #PS$) + Mid(File, 4)
        EndIf  
        ;}
      ElseIf Left(PathPart$, 2) = "." + #PS$ ;{ A relative path to a file in the current directory    
        ProcedureReturn Path + Mid(File, 3)
        ;}
      ElseIf Left(PathPart$, 1) = #PS$       ;{ An absolute path from the root of the current drive

        Path  = ReplaceString(Path, #PS$ + #PS$, "|" + #PS$)
        Path$ = StringField(Path, 1, #PS$) + #PS$
        
        ProcedureReturn ReplaceString(Path$, "|", #PS$) + Mid(File, 2)
        ;}
      ElseIf Mid(PathPart$, 2, 1) = ":"      ;{ A relative path from the current directory of the drive
        
        Path$ = Left(PathPart$, 2) + Mid(Path, 3)
        
        ProcedureReturn  Path$ + Mid(File, 3)
        ;}  
      Else                                   ;{ A relative path to a file in a subdirectory of the current directory
        ProcedureReturn Path + File
        ;}
      EndIf
      ;}
    EndIf
    
  Else
    ProcedureReturn Path + File
  EndIf  
  
EndProcedure  

CurrentPath$ = "D:\Entwicklung\Source\Test\"
Debug "Current Path: " + CurrentPath$
Debug "=============================="

Debug "Absolute path name:"
Debug GetAbsolutePath(CurrentPath$, "C:\Test\Images\Test.png")
Debug ""
Debug "A relative path to a file in the current directory:"
Debug GetAbsolutePath(CurrentPath$, ".\Images\Test.png")
Debug ""
Debug "A relative path to a file in a directory that is a peer of the current directory:"
Debug GetAbsolutePath(CurrentPath$, "..\Images\Test.png")
Debug ""
Debug "An absolute path from the root of the current drive:"
Debug GetAbsolutePath(CurrentPath$, "\Images\Test.png")
Debug ""
Debug "A relative path from the current directory of the drive:"
Debug GetAbsolutePath(CurrentPath$, "C:Images\Test.png")
Debug ""
Debug "A relative path to a file in a subdirectory of the current directory:"
Debug GetAbsolutePath(CurrentPath$, "Images\Test.png")
Debug GetAbsolutePath(CurrentPath$, "Test.png")

Re: Relative Pfade auflösen

Verfasst: 03.04.2020 12:54
von NicTheQuick
Unter Windows gibt es auch schon was fertiges: viewtopic.php?p=356270#p356270
Für Linux bestimmt auch, aber da hab ich noch nicht geschaut. :-)