Aktuelle Zeit: 07.06.2020 06:26

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Relative Pfade auflösen (all OS)
BeitragVerfasst: 03.04.2020 12:33 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Für mein Markdown Module schlage ich mich gerade mit relativen Pfaden herum:

Code:
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")

_________________
Download der Module
Download der Programme

Bild


Zuletzt geändert von Thorsten1867 am 03.04.2020 15:03, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Relative Pfade auflösen
BeitragVerfasst: 03.04.2020 12:54 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
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. :-)

_________________
Ubuntu Gnome 20.04 LTS x64, PureBasic 5.72 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60, 5.71b2)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye