List Files/Folders (Recursive)

Category: Files/Folders

Date: 03-28-2012

Return to Index


 
'Often, a program needs a list of the files/folders that are found more
'than 1 level below the starting path - all children and all subfolders.
'This is sometimes called a recursive listing, although the algorithm to
'get the list may or may not use recursive techniques. The example on this
'pages is NOT recursive (it does not call itself).
 
'Primary code
'This puts a list of subfolders into a Global array Folders()
Sub ListSubFolders(startfolder$)            'Start$ cannot end in \
   'returns list of folder (full paths) in Folder() - unsorted
   Dim iPOS As Long
   Folders(FolderCount) = startfolder$
   While Len(Folders(iPOS))
      temp$ = Dir$(Build$(Folders(iPOS),"\*.*"), Only %SubDir)  'subfolders only
      While Len(temp$)
         Incr FolderCount
         Folders(FolderCount) =  Build$(Folders(iPos),"\",temp$)
         temp$ =  Dir$ (Next)
      Wend
      Incr iPOS
   Wend
End Sub
 
'Compilable Example:
'Creates two string arrays, Files() and Folders()
'Content of each are displayed in a ListBox
#Compiler PBWin 9, PBWin 10
#Compile EXE
Global hDlg As Dword, Folders() As String, Files() as String
Global FolderCount As Long, FileCount As Long
 
Function PBMain() As Long
   Dim Folders(10000), Files(100000)
   Dialog New Pixels, 0, "ListBox Test",300,100,400,405, _
      %WS_OverlappedWindow, 0 To hDlg
   Control Add Button, hDlg, 100,"Select Folder", 10,10,100,20
   Control Add Label, hDlg, 150,"", 120,10,100,20, %WS_Border Or %SS_Center
   Control Add Button, hDlg, 250,"", 240,10,100,20, %WS_Border Or %SS_Center
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local i As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      For i = 0 to UBound(Folders)
         if IsFalse (IsFile(Folders(i))) Then MsgBox "Not a folder!"
      Next i
   End If
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      Local start$
      start$ = GetFolder(Exe.path$)
      If Len(start$) Then
         ListSubFolders(start$)     'one folder up from whereever the snippet EXE is found
         Control Add ListBox, hDlg, 200, Folders(), 10,40,380,170, %WS_TABSTOP Or %WS_VSCROLL, %WS_EX_ClientEdge
         ListFiles    'use array of folders just created
         Control Add ListBox, hDlg, 300, Files(), 10,210,380,200, %WS_TABSTOP Or %WS_VSCROLL, %WS_EX_ClientEdge
         Control Set Text hDlg, 150, Str$(FolderCount+1) + "  " + Str$(FileCount+1)  'folder/file count
      End If
   End If
End Function
 
Sub ListFiles
   'uses the Folders() array to populates Files() array
   Dim i as Long, file$       '100K
   For i = 0 to UBound(Folders)
      file$ = Dir$(Folders(i) + "\*.*")   'the folder paths do not have the ending "\"
      While Len(file$)
         Files(FileCount) = Folders(i) + "\" + file$
         Incr FileCount
         file$ = Dir$
      Wend
   Next i
   ReDim Preserve Files(FileCount)
End Sub
 
Sub ListSubFolders(startfolder$)            'Start$ cannot end in \
   'returns list of folder (full paths) in Folder() - unsorted
   'the paths DO NOT end in "\"
   Dim iPOS As Long
   Folders(FolderCount) = startfolder$
   While Len(Folders(iPOS))
      temp$ = Dir$(Build$(Folders(iPOS),"\*.*"), Only %SubDir)  'subfolders only
      While Len(temp$)
         Incr FolderCount
         Folders(FolderCount) =  Build$(Folders(iPos),"\",temp$)
         temp$ =  Dir$ (Next)
      Wend
      Incr iPOS
   Wend
   ReDim Preserve Folders(FolderCount)
End Sub
 
Function GetFolder(start$) as String
   Local title$, flags&, folder$
   title$ = "Select Folder"    'if "" then "Open" is used
   flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
   Display Browse  hDlg, 200, 100, title$, start$, flags& To folder$   'folder$ is set to "" if Cancel/Escape is pressed
   Function = folder$
End Function
 
'gbs_00155
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm