Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
'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
http://www.garybeene.com/sw/gbsnippets.htm