PureBasic Forums - English

Posted: **Sat Nov 08, 2003 10:42 pm**

Just some stuff you may find useful. May be a little duplication with the CodeArchive so check that out as well if you haven't already. See the Test() procedure for example usage. Note the glaring omission of a ChangeDir() function, still thinking on how to do that one without maintaining a variable, probably going to use Get/SetCurrentDirectory_() but I'd prefer a platform independent method.

Code: Select all

Declare test()
test()

;- GENERAL

Procedure DebugStringList(l.s, s.s)
  ; l: list
  ; s: seperator
  ;
  Protected i.l, t.s
  i = 1
  t.s = StringField(l, i, s)
  While t
    Debug t: i+1: t = StringField(l, i, "|")
  Wend
EndProcedure

;- DIR/FILE UTILS

Procedure.s CrtPath()
  Protected cd.s
  cd=Space(511)
  GetCurrentDirectory_(Len(cd),@cd)
  If (Right(cd,1)<>"\") Or (Right(cd,1)<>"/"): cd+"/": EndIf
  ReplaceString(cd, "\", "/", 3)
  ProcedureReturn cd
EndProcedure

Procedure.s GetDirList(d.s, p.s, t.l)
  ; d: directory
  ; p: pattern
  ; t: type [0:File or directory | 1:File | 2:Directory]
  ;
  Protected f.s, l.s, et.l
  
  If ExamineDirectory(0, d, p)=0: ProcedureReturn "": EndIf
  et = NextDirectoryEntry()
  While et
    If (et=t) Or (t=0)
      f = DirectoryEntryName()
      If et=2: f+"/": EndIf
      If l="": l=f: Else: l=l+"|"+f: EndIf
    EndIf
    et = NextDirectoryEntry()
  Wend
  ProcedureReturn l
EndProcedure

Procedure.l DirExistsD(d.s, p.s)
  ; d: directory
  ; p: pattern
  ;
  Protected l.s
  l.s = GetDirList(d, p, 2)
  If l<>"": ProcedureReturn 1: Else: ProcedureReturn 0: EndIf
EndProcedure

Procedure.l DirExists(p.s)
  ProcedureReturn DirExistsD("", p)
EndProcedure

Procedure.l FileExistsD(d.s, p.s)
  ; d: directory
  ; p: pattern
  ;
  Protected l.s
  l.s = GetDirList(d, p, 1)
  If l<>"": ProcedureReturn 1: Else: ProcedureReturn 0: EndIf
EndProcedure

Procedure.l FileExists(p.s)
  ProcedureReturn FileExistsD("", p)
EndProcedure

Procedure.s GetDirectoriesD(d.s, p.s)
  ProcedureReturn GetDirList(d, p, 2)
EndProcedure

Procedure.s GetDirectories(p.s)
  ProcedureReturn GetDirList("", p, 2)
EndProcedure

Procedure.s GetFilesD(d.s, p.s)
  ProcedureReturn GetDirList(d, p, 1)
EndProcedure

Procedure.s GetFiles(p.s)
  ProcedureReturn GetDirList("", p, 1)
EndProcedure

;- URL UTILS

Procedure.s URLProtoPart(u.s)
  Protected p.l
  p = FindString(u,"://",1)
  If p
    ProcedureReturn Left(u,p-1)
  Else
    ProcedureReturn ""
  EndIf
EndProcedure

Procedure.s URLHostPart(u.s)
  If FindString(u,"://",1)
    ProcedureReturn StringField(u,3,"/")
  Else
    ProcedureReturn StringField(u,1,"/")
  EndIf
EndProcedure

Procedure.s URLResourcePart(u.s)
  Protected r.s, p.l
  
  If FindString(u,".",1)=0: ProcedureReturn "": EndIf
  
  For p=Len(u) To 1 Step -1
    If Mid(u, p, 1)="/"
      Break
    EndIf
  Next
  ProcedureReturn Right(u, Len(u)-p)
EndProcedure

Procedure.s URLPathPart(u.s)
  Protected r.s, tl.l, tr.l
  tl=0: tr=0
  If UCase(Left(u,7))="HTTP://": tl=8: EndIf
  tl+Len(URLHostPart(u))
  tr=Len(URLResourcePart(u))
  ProcedureReturn Mid(u, tl, Len(u)-tl-tr)
EndProcedure

;- TEST

Procedure test()
  ; May need your own test data in some cases below
  
  Debug "Current Path: "+CrtPath()
  
  Debug ">>>>> DIR LISTING >>>>"
  DebugStringList(GetDirList("","*.*",0), "|")
  Debug ""

  Debug ">>>>> FILES ONLY >>>>"
  DebugStringList(GetFiles(""),"|")
  Debug ""

  Debug ">>>>> DIR'S ONLY >>>>"
  DebugStringList(GetDirectories(""),"|")
  Debug ""

  Debug ">>>>> DIR EXISTS? >>>>"
  dn.s = ".." ; Replace with something else!
  If DirExists(dn): Debug "Dir Found": Else: Debug "Dir not found!": EndIf
  Debug ">>>>> FILE EXISTS? >>>>"
  fn.s = "myfile.txt" ; Replace with something else!
  If FileExists(fn): Debug "Found file": Else: Debug "File not found!": EndIf
  Debug ""
  
  Debug ">>>>> URL PARTS >>>>"
  url.s = "http://www.purebasic.com/download/PureBasic_Demo.exe"
  Debug "URL: "+url
  Debug "PROTO: "+URLProtoPart(url)
  Debug "HOST: "+URLHostPart(url)
  Debug "PATH: "+URLPathPart(url)
  Debug "RESOURCE: "+URLResourcePart(url)
EndProcedure

PureBasic Forums - English

Dir, File and URL utils

Dir, File and URL utils