PureBasic Forums - English

Code: Select all

EnableExplicit

Macro DirBack(_path_);<- if path ends with "\"
  Left(_path_,Len(_path_) - Len(StringField(_path_,CountString(_path_,"\"),"\")) - 1)
EndMacro

Procedure.i Main()
  Debug DirBack("F:\SCRAB_Steam\OK Correction\Ok2\scrab_fr\")
EndProcedure

End Main()

Code: Select all

EnableExplicit

Procedure.s OnePathBack(Path$)
  Protected pos, lastPos 
   
  pos = FindString(Path$, #PS$) 
       
  While pos > 0                    ; Position des letzten "\" suchen
    lastPos = pos
    pos = FindString(Path$, #PS$, lastPos + 1)
  Wend
  
  If lastPos > 0
    ProcedureReturn Left(Path$, lastPos - 1)
  Else
    ProcedureReturn Path$
  EndIf
 
EndProcedure

 Procedure.s OnePathBack1(Path$)
  ; ===========================================================================
  ;  NAME : OnePathBack
  ;  DESC : Go one path back - removes last subfolder from a Path
  ;  VAR(Path$) : The actual Path$
  ;  RET.s : Path$ where last subfolder is removed
  ; =========================================================================== 
    
    Protected *char.Character   ; Pointer to Char-Structure
    Protected cntChar, N, N_old
    
    *char = @Path$              
    
    While *char\c               ; until end of String
      cntChar + 1               ; count chars
      If *char\c = #PS          ; #PS : PathSeperator (on Windows := 92 = '\'
        N_old = N               ; remember CharNo of second last path seperator
        N = cntChar             ; CharNo of last path seperator
      EndIf
      *char + SizeOf(Character) ; Index to next Char
    Wend
    
    If cntChar>0                ; if CountChar > 0
        If N_old > 0            ; if a second last PathSeparator exits  
          N = N_old             ; use CharNo of second last PathSeperator
        EndIf
     EndIf
    
    If N > 0                    
      ProcedureReturn Left(Path$, N)     
    Else
      ProcedureReturn Path$
    EndIf  
  EndProcedure

Define P1$ = "C:\Windows\System32"
Define P2$ = "C:\Windows\System32\"
Define P3$ = "C:\Windows\System32\test.dll"
Define P4$ = "C:\"

Debug "original"
Debug P1$
Debug P2$
Debug P3$
Debug P4$

Debug ""
Debug "first version with FindString"
Debug OnePathBack(P1$)
Debug OnePathBack(P2$)
Debug OnePathBack(P3$)
Debug OnePathBack(P4$)
Debug ""
Debug "second version *char"
Debug OnePathBack1(P1$)
Debug OnePathBack1(P2$)
Debug OnePathBack1(P3$)
Debug OnePathBack1(P4$)

Code: Select all

EnableExplicit

Macro DirBack(_path_);<- if path ends with "\"
  Left(_path_,Len(_path_) - Len(StringField(_path_,CountString(_path_,"\"),"\")) - 1)
EndMacro

Procedure.s OnePathBack(Path$)
  Protected pos, lastPos 
   
  pos = FindString(Path$, #PS$) 
       
  While pos > 0                    ; Position des letzten "\" suchen
    lastPos = pos
    pos = FindString(Path$, #PS$, lastPos + 1)
  Wend
  
  If lastPos > 0
    ProcedureReturn Left(Path$, lastPos - 1)
  Else
    ProcedureReturn Path$
  EndIf
 
EndProcedure

Procedure.s OnePathBack1(Path$)
  Protected *char.Character   ; Pointer to a virutal Char-Struct
  Protected I, N, N_old
  
  *char = @Path$
  While *char\c               ; until end of String
    I + 1
    If *char\c =  #PS         ; #PS : PathSeperator
      N_old = N
      N = I
    EndIf
    *char + SizeOf(Character)   ; Index to next Char
  Wend
  
  If I
    *char - SizeOf(Character) 
    If *char\c = #PS
      N = N_old
    EndIf
  EndIf
  
  If N
    ProcedureReturn Left(Path$, N - 1)     
  Else
    ProcedureReturn Path$
  EndIf  
EndProcedure

Procedure.s OnePathBack2(Path$)
  Protected pos, ReversePath$ = ReverseString(Path$)
  pos = FindString(ReversePath$, #PS$, 2)
  If pos > 0
    ProcedureReturn Left(Path$, Len(Path$)-pos)  ; Len(Path$)-pos+1 if you want to keep slash\backslash at the end as GetPathPart()
  Else
    ProcedureReturn Path$
  EndIf
EndProcedure

Define P1$ = "C:\Windows\System32"
Define P2$ = "C:\Windows\System32\"
Define P3$ = "C:\Windows\System32\test.dll"
Define P4$ = "C:\"
Define t0, t1, t2, t3, t4, i, MaxLoop = 100000000
CompilerIf #PB_Compiler_Debugger
  MaxLoop = 1
CompilerEndIf

Debug "----- Original -----"
Debug P1$
Debug P2$
Debug P3$
Debug P4$
Debug "----- GetPathPart -----"
Debug GetPathPart(P1$)
Debug GetPathPart(P2$)   ; Wrong for me
Debug GetPathPart(P3$)
Debug GetPathPart(P4$)
t0 = ElapsedMilliseconds()
Debug "----- OnePathBack -----"
For I = 1 To MaxLoop
  Debug OnePathBack(P1$)
  Debug OnePathBack(P2$)
  Debug OnePathBack(P3$)
  Debug OnePathBack(P4$)
Next
t1 = ElapsedMilliseconds()
Debug "----- OnePathBack1 -----"
For I = 1 To MaxLoop
  Debug OnePathBack1(P1$)
  Debug OnePathBack1(P2$)
  Debug OnePathBack1(P3$)
  Debug OnePathBack1(P4$)
Next
t2 = ElapsedMilliseconds()
Debug "----- OnePathBack2 -----"
For I = 1 To MaxLoop
  Debug OnePathBack2(P1$)
  Debug OnePathBack2(P2$)
  Debug OnePathBack2(P3$)
  Debug OnePathBack2(P4$)
Next
t3 = ElapsedMilliseconds()
Debug "----- DirBack -----"
For I = 1 To MaxLoop
  Debug DirBack(P1$)
  Debug DirBack(P2$)
  Debug DirBack(P3$)
  Debug DirBack(P4$)   ; Wrong for me
Next
t4 = ElapsedMilliseconds()
Debug "----- End -----"
CompilerIf Not #PB_Compiler_Debugger
  Define Message$ = "OnePathBack = " + Str(t1-t0) +#CRLF$+
                       "OnePathBack1 = " + Str(t2-t1) +#CRLF$+
                       "OnePathBack2 = " + Str(t3-t2) +#CRLF$+
                       "DirBack = " + Str(t3-t2)
  SetClipboardText(Message$)
  MessageRequester("Times", Message$  +#CRLF$+#CRLF$+ "Copied to ClipBoard")
CompilerEndIf

Code: Select all

path.s = "F:\SCRAB_Steam\OK Correction\Ok2\scrab_fr\"
parentpath.s = GetPathPart(RTrim(path, #PS$))
Debug parentpath

Code: Select all

GetCurrentDirectory()

Code: Select all

Debug GetCurrentDirectory() ; /Applications/PureBasic.app/Contents/

SetCurrentDirectory(GetCurrentDirectory() + ".." + #PS$ + "..")

Debug GetCurrentDirectory() ; /Applications/

Code: Select all

Procedure.s UpperDir(path$, level = 1, setcurrdir.b = #False)
   Protected i, oldcurrdir$ = GetCurrentDirectory()
   path$ = GetPathPart(path$) ; in case of file
   For i = 1 To level : path$ + ".." + #PS$ : Next
   SetCurrentDirectory(path$)
   path$ = GetCurrentDirectory()
   If Not setcurrdir : SetCurrentDirectory(oldcurrdir$) : EndIf
   ProcedureReturn path$
EndProcedure

Debug GetCurrentDirectory()
Debug UpperDir(GetCurrentDirectory()) ; Does NOT change Current Directory
Debug GetCurrentDirectory()
Debug UpperDir(GetCurrentDirectory(), 2, 1) ; Goes up 2 "levels" and Changes Current Directory (1 = true)
Debug GetCurrentDirectory()
; app folder (Mac):
Debug "app folder on Mac: " + UpperDir(ProgramFilename(),3)

Code: Select all

Procedure.s ParentFolder(dir$)
  If CountString(dir$,"\")>1
    dir$=RTrim(dir$,"\")
  EndIf
  Repeat
    s=FindString(dir$,"\",p)
    If s=0
      parent$=Left(dir$,p-1)
      Break
    EndIf
    p+1
  Until s=0
  ProcedureReturn parent$
EndProcedure

Debug ParentFolder("F:\SCRAB_Steam\OK Correction\Ok2\scrab_fr\") ; Output: "F:\SCRAB_Steam\OK Correction\Ok2\"