Delete Folder & Sub-Folders

Category: Files/Folders

Date: 03-28-2012

Return to Index


 
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:
'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


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