PureBasic Forums - English

Code: Select all

PATH C:\;C:\WINDOWS;C:\WINDOWS\COMMAND;C:\PUREBASIC\INCLUDES

Code: Select all

;\\-----------------------------
;\\-Directory Scanner-----------
;\\-----------------------------

;\\-Notes--
; In a moment of genious I have managed to get this to work! Information on files is stored in the
; File array, while info on directories is stored in the Dir array. The total number of files and
; sub directories are stored in File(0)\Files and Dir(0)\Dirs.
; 
; Parameters
    ;IncludeSubDirs.l ~ If 1 then scan sub directories too. If else then do not.
    ;FullPath.s ~ The full path of the directory to be scanned.
;\\--------

;\\-Structures------------------

Structure FileInfo
  FullPath.s
  SubPath.s
  FileName.s
  Files.l
EndStructure

Structure DirInfo
  SubPath.s
  Dirs.l
  Size.l
EndStructure

;\\-----------------------------

;\\-Arrays----------------------

Dim File.FileInfo(9999999)
Dim Dir.DirInfo(9999999)

;\\-----------------------------

;\\-Procedure-------------------

Procedure ScanDirectory(IncludeSubDirs.l,FullPath.s)

If Right(FullPath,1)<>"\" ;If there isn't a "\" at the end of the string
  FullPath+"\" ;Add the "\"
EndIf

If IncludeSubDirs<>1 ;If SubDirs are not to be included

  If FileSize(FullPath)=-2 ;If directory exists
    ExamineDirectory(0,FullPath,"*.*")
    Repeat
      Select NextDirectoryEntry()
        Case 0
          StopLoop=1
        Case 1
          Files+1
          File(Files)\FullPath=FullPath+DirectoryEntryName()
          File(Files)\FileName=DirectoryEntryName()
          Dir(0)\Size+FileSize(FullPath+DirectoryEntryName())
      EndSelect
    Until StopLoop=1
    File(0)\Files=Files
    ProcedureReturn 1
  Else ;If it does not
    ProcedureReturn 0
  EndIf

EndIf
  

For t=2 To Len(FullPath) ;Cycle through the characters, from second last to start
  SubPart.s=Right(FullPath,t) ;Get the next part of the string
  PathPart.s=Left(FullPath,Len(FullPath)-t+1)
  If Mid(SubPart,1,1)="\" ;If the first character equals '\'
    RootPath.s=PathPart
    SubPath.s=Right(FullPath,t-1) ;Sub path = 2nd chr of Part to last Chr
    Break  
  EndIf
Next t

If FileSize(FullPath.s)=-2 ;If directory exists
  
  ExamineDirectory(0,FullPath,"*.*")
  
  Dir(0)\SubPath=SubPath
  
  Repeat
    
    UseDirectory(Actual)
    
    Repeat
      
      Select NextDirectoryEntry()
      
        Case 0 ;If there are no more files/directorys
          DirFinished=1
        
        Case 1 ;Next entry is a file
          FileName.s=DirectoryEntryName()
          If FileName.s<>OldFileName.s
            
            Files+1
            
            If Right(Dir(Actual)\SubPath,1)="\" ;If the last chr is "\"
              Add.s=FileName ;Don't add a slash
            Else ;If there is no slash
              Add.s="\"+FileName ;Add a slash
            EndIf
            
            File(Files)\FullPath=RootPath+Dir(Actual)\SubPath+Add
            File(Files)\SubPath=Dir(Actual)\SubPath+Add
            File(Files)\FileName=FileName
            Dir(0)\Size+FileSize(RootPath+Dir(Actual)\SubPath+Add)
            
            OldFileName.s=FileName
          
          EndIf
          
        Case 2 ;Next entry is a directory
          DirName.s=DirectoryEntryName()
            
            If DirName<>"." And DirName<>".." ;First two results are always "." and ".." ignore them
              DirsToScan+1 ;Number of directories to scan has increased by one
              
              If Right(Dir(Actual)\SubPath,1)="\" ;If the last chr is "\"
                Add.s=DirName ;Don't add a slash
              Else ;If there is no slash
                Add.s="\"+DirName ;Add a slash
              EndIf
              
              Dir(DirsToScan)\SubPath=Dir(Actual)\SubPath+Add ;New subpath
              
              If ExamineDirectory(DirsToScan,RootPath+Dir(DirsToScan)\SubPath,"*.*") ;Scan directory
                UseDirectory(Actual)
              EndIf 
            EndIf
      
      EndSelect
      
    
    Until DirFinished=1
    
    Actual+1
    DirFinished=0
    
    If Actual>DirsToScan
      File(0)\Files=Files
      Dir(0)\Dirs=DirsToScan
      FinishedScan=1
    EndIf
    
  Until FinishedScan=1
    
  ProcedureReturn 1
Else ;Directory does not exist
  ProcedureReturn 0
EndIf


EndProcedure




;\\-----------------------------