Date: 02-16-2022
Return to Index
created by gbSnippets
List Files/Folders (Recursive)
'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 coding techniques. The example on this
'pages is NOT recursive (it does not call itself).
'Primary code
'This is the primary procedure - it 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
'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
'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
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
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Static start$
ReDim Folders(10000), Files(100000)
Control Kill hDlg, 200 : Control Kill hDlg, 300
If Len(start$) = 0 Then start$ = Exe.path$
start$ = GetFolder(start$) : FileCount = 0 : FolderCount = 0
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
If MsgBox("Deleting files AND folders. Are you sure?" + $crlf + $crlf + start$, %MB_okcancel + %MB_IconExclamation, "Delete Files AND Folders") = %IDok Then
Select Case LCase$(start$)
Case "c:\", "d:\", "c:\windows" 'protection of specific folders - add any you want protected
Case Else
DeleteFiles
DeleteFolders
RmDir start$ 'include this is you want the top folder deleted
End Select
End If
End If
End If
End Function
Sub ListFiles
'uses the Folders() array to populate 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
'opens the built-in folder browser dialog, letting the user select the folder to delete.
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
Sub DeleteFiles
Dim i as long, iCount as Long, sFileName as String
ListBox Get Count hDlg, 300 to iCount
For i = 1 to iCount
ListBox Get Text hDlg, 300, i To sFileName
Kill sFileName
Next i
End Sub
Sub DeleteFolders
Dim i as long, iCount as Long, sFolderName as String
ListBox Get Count hDlg, 200 to iCount
For i = iCount to 1 Step -1
ListBox Get Text hDlg, 200, i To sFolderName
RmDir sFolderName
Next i
End Sub
'gbs_00144
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm