Code: Select all
Procedure.s x_chop(string.s,left.i,right.i) ; chop a bit of the left and right side of a string
Protected l.i
;
; *** chop 'n' characters from the left or right of a string
;
l = Len(string)
If left+right >= l
string = ""
Else
If right > 0
string = Left(string,l-right)
EndIf
If left > 0
string = Mid(string,left+1,l)
EndIf
EndIf
;
ProcedureReturn string
;
EndProcedure
Procedure.s x_getparentpathpart(s.s) ; returns parent folder part of a given path
Protected q.s, p.i
;
; *** get the 'parent' folder from the given string, ie. c:\windows\system32\ would return c:\windows\
;
; notes:
;
; - assume that given string is a path, regardless if it ended on a backslash or not
; - if it cannot find a parent path it returns an empty string
; - might :-) hancle unc paths
;
If Mid(s,2,1) = ":" ; local root
q = Left(s,2)
s = Mid(s,3,#MAX_PATH)
ElseIf Left(s,2) = "\\" ; unc path
p = FindString(s,"\",3)
If p > 0 ; valid unc path
q = Left(s,p)
s = Mid(s,p+1,#MAX_PATH)
Else ; invalid unc path
q = ""
s = ""
EndIf
EndIf
;
If s > "" ; if there is something to find the parent of...
If Right(s,1) = "\" ; strip the trailing backslash to getpathpart() returns one level higher
s = x_chop(s,0,1)
EndIf
If s > "" ; there must be something left, in which case we'll put the leading drive / unc path in front of it
s = q+GetPathPart(s)
EndIf
EndIf
ProcedureReturn s
;
EndProcedure
Procedure.s x_modifypath(path.s,modifier.s) ; modify path with modifier
Protected file.s, root.s, p.i, modifierpart.s, pathpart.s
;
; *** modify absolute path with absolute or relative modifier
;
; in: path.s - a relative or absolute path, with an optional filename
; modifier.s - a relative or absolute path, with an optional filename
; retval: .s - the resulting path
;
; notes:
;
; - limited unc support
;
; example:
;
; debug x_modifypath("c:\purebasic\","..\test\z.pb") ; returns "c:\purebasic\test\z.pb"
;
If GetFilePart(modifier) > ""
file = GetFilePart(modifier)
Else
file = GetFilePart(path)
EndIf
;
path = GetPathPart(path)
modifier = GetPathPart(modifier)
;
root = ""
If Len(path) >= 3 And Mid(path,2,2)=":\"
root = Left(path,3)
If Len(path) = 3
path = ""
Else
path = Mid(path,4,#MAX_PATH)
EndIf
EndIf
If Len(modifier) >= 3 And Mid(modifier,2,2)=":\"
root = ""
path = modifier
modifier = ""
EndIf
;
While modifier > ""
If path > ""
pathpart = GetFilePart(x_chop(path,0,1))
Else
pathpart = ""
EndIf
p = FindString(modifier,"\",1)
modifierpart = Left(modifier,p-1)
If p = Len(modifier)
modifier = ""
Else
modifier = Mid(modifier,p+1,#MAX_PATH)
EndIf
;
If modifierpart = ".."
If pathpart = ".."
path = path+"..\"
Else
path = GetPathPart(x_chop(path,0,1))
EndIf
ElseIf modifierpart > ""
path = path+modifierpart+"\"
EndIf
;
Wend
;
ProcedureReturn root+path+file
EndProcedure
Procedure.s x_absolutepath(s.s) ; change relative path to absolute path
Protected d.s, f.s, p.s
;
; *** turn a path into an absolute path based on current directory and re-attach filename
;
; notes:
;
; - passed parameter is considered a filename if it does not end on a backslash
; - might (or might not) support unc paths
; - leaves absolute paths intact
;
f = GetFilePart(s)
p = GetPathPart(s)
d = GetCurrentDirectory()
;
If Left(p,3) = "..\" ; a relative path pointing to a higher level
While Left(p,3) = "..\" ; repeat until there are no levels left
p = x_chop(p,3,0)
d = x_getparentpathpart(d)
Wend
ProcedureReturn d+p+f
ElseIf Mid(s,2,2) = ":\" ; absolute path to a local drive
ProcedureReturn s
ElseIf Left(s,2) = "\\" ; an absolute unc path
ProcedureReturn s
ElseIf Left(s,1) = "\" And Left(d,2) = "\\" ; root of an unc path (does this actually make sense?)
ProcedureReturn "\\"+StringField(d,3,"\")+s
ElseIf Left(s,1) = "\" ; root of current path
ProcedureReturn Left(d,3)+x_chop(s,1,0)
Else ; anything else
ProcedureReturn d+s
EndIf
EndProcedure
Procedure.s x_validpathname(s.s) ; check / reformat given path
;
; *** checks / reformats paths, does not check for existence
;
; in: s.s - path
; retval: - reformatted string, empty if invalid
; out: x_retval.i - #true if valid, #false if invalid
; x_retval_string.s - same as retval
;
; notes:
;
; - relative paths are NOT supported
; - this isn't totally safe, but it helps a bit
;
; input and output examples
;
; c - c:\
; c: - c:\
; c:\ - c:\
; c:\test - c:\test\
; \\media4\ - \\media4\
;
x_retval = #False
;
; remove doublequote chars
;
If Right(s,1) = Chr(34) And Left(s,1) = Chr(34)
s = x_chop(s,1,1)
EndIf
;
; trim
;
s = Trim(s)
;
; single char drive letter
;
If Len(s) = 1 And UCase(s) >= "A" And UCase(s) <= "Z"
s = s+":\"
EndIf
;
; ends on a backslash? if not add one
;
If Len(s) >= 2 And Right(s,1) <> "\"
s = s+"\"
EndIf
;
; only accept if there are no illegal characters
;
If FindString(s,"/") = 0 And FindString(s,"$") = 0 And FindString(s,"%") = 0 And FindString(s,",") = 0 And FindString(s,"|") = 0
If FindString(s,"&") = 0 And FindString(s,"*") = 0 And FindString(s,"\\",2) = 0 And FindString(s,";",3) = 0 And FindString(s,";") = 0
;
; is it a 'root path' like C:\ ?
;
If Mid(s,2,2) = ":\"
If UCase(Left(s,1)) >= "A" And UCase(Left(s,1)) <= "Z"
s = UCase(Left(s,1))+Mid(s,2)
x_retval = #True
EndIf
ElseIf Left(s,2) = "\\"
x_retval = #True
EndIf
EndIf
EndIf
;
If x_retval = #True
x_retval_string = s
ProcedureReturn s
Else
x_retval_string = ""
ProcedureReturn ""
EndIf
;
EndProcedure
Have a good day
