Relative Pfade auflösen (all OS)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Relative Pfade auflösen (all OS)

Beitrag 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")
Zuletzt geändert von Thorsten1867 am 03.04.2020 15:03, insgesamt 1-mal geändert.
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: Relative Pfade auflösen

Beitrag 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. :-)
Bild
Antworten