GetAbsolutePath

Share your advanced PureBasic knowledge/code with the community.
AZJIO
Addict
Addict
Posts: 2191
Joined: Sun May 14, 2017 1:48 am

GetAbsolutePath

Post by AZJIO »

Code: Select all

EnableExplicit

; https://www.purebasic.fr/english/viewtopic.php?f=12&t=65159&p=486382&hilit=SplitL#p486382
Procedure SplitL(String.s, List StringList.s(), Separator.s = " ")
	
	Protected S.String, *S.Integer = @S
	Protected.i p, slen
	slen = Len(Separator)
	ClearList(StringList())
	
	*S\i = @String
	Repeat
		AddElement(StringList())
		p = FindString(S\s, Separator)
		StringList() = PeekS(*S\i, p - 1)
		*S\i + (p + slen - 1) << #PB_Compiler_Unicode
	Until p = 0
	*S\i = 0
	
EndProcedure


Procedure.s GetAbsolutePath(Path$)
	Protected pos, pos2, tmp, res$, *Result
	Protected NewList StringList.s()
	
	SplitL(Path$, StringList(), #PS$)
	ResetList(StringList())
	While NextElement(StringList())
		If StringList() = "."
			DeleteElement(StringList()) 
		ElseIf StringList() = ".."
			*Result = DeleteElement(StringList()) 
			If *Result
				DeleteElement(StringList())
			Else
				ProcedureReturn Path$
			EndIf
		EndIf
	Wend
	
	Path$ = ""
	ForEach StringList()
		Path$ + StringList() + #PS$
	Next
	Path$ = Trim(Path$, #PS$)
	
	ProcedureReturn Path$
EndProcedure  


Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\Test.png")
; GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\Test.png")
; GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\..\..\Test.png")
Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\.\.\.\Test.png")
I tried this way, but I can't figure out how to proceed if the number of "..\" is greater than the path length. This led to an endless loop.

Code: Select all

EnableExplicit

Procedure.s GetAbsolutePath(Path$)
	Protected pos, pos2, tmp, res$, i
	
	Repeat
		pos = FindString(Path$, #PS$ + "." + #PS$)
		If pos
			Path$ = ReplaceString(Path$, #PS$ + "." + #PS$, #PS$, #PB_String_CaseSensitive, pos, 1)
		EndIf
	Until Not pos
	
	Repeat
		pos = FindString(Path$, #PS$ + ".." + #PS$)
		If pos
			pos -1
			Repeat
				tmp = pos2
				pos2 = FindString(Path$, #PS$, pos2 + 1)
				Debug pos2
;				i + 1
; 				If i > 16
; 					Break
; 				EndIf
			Until pos2 > pos
			
			If tmp - 1 >= pos + 4
				Break
			EndIf
			Path$ = Mid(Path$, 1, tmp - 1) + Mid(Path$, pos + 4)
			Debug Path$
;			i + 1
; 			If i > 16
; 				Break
; 			EndIf
		EndIf
; 				Debug pos
	Until Not pos
	
	ProcedureReturn Path$
EndProcedure  


; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\Test.png")
; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\Test.png")
; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\Test.png")
GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\Test.png")
; GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\Test.png")
; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\Test.png")
; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\..\..\Test.png")
; Debug GetAbsolutePath("C:\PureBasic\purebasic-devel\Residents\Windows\.\.\.\Test.png")
User avatar
mk-soft
Always Here
Always Here
Posts: 6246
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: GetAbsolutePath

Post by mk-soft »

Sorry,

Only Windows ...

Code: Select all

;-TOP by mk-soft, v1.01.0, 10.09.2023

Procedure.s GetFullPath(Path.s)
  Protected r1.s, len
  r1 = Space(#MAX_PATH * 4)
  len = GetFullPathName_(Path, #MAX_PATH * 4, @r1, 0)
  If len <= 0
    r1 = ""
  EndIf
  ProcedureReturn r1
EndProcedure

; ----

Define path.s, fullpath.s

path = "C:\WinAPP\PureBasic-v6.03x64\..\displayC.exe"
fullpath = GetFullPath(path)
Debug fullpath

path = "C:\PureBasic\purebasic-devel\Residents\Windows\..\..\..\Test.png"
fullpath = GetFullPath(path)
Debug fullpath
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Quin
Addict
Addict
Posts: 1133
Joined: Thu Mar 31, 2022 7:03 pm
Location: Colorado, United States
Contact:

Re: GetAbsolutePath

Post by Quin »

Very nice. Thanks both of you!
Post Reply