VB - Fill a TreeView with the system disks and their directories

December 2016





Here's a routine that can fill a TreeView with the system disks and their directories.

Description


The problem was to find the nodes key, as sometimes a key was published twice, then I found a solution:
  • Use the full path as key and in this way, it is certain that there will be no duplicates.
  • I was not able to test the network drives
  • I eliminated the system directories, my goal is to make a image explore (available for download).
  • The routine is recursive and is relatively short.
  • Do not be surprised how long it takes (depending on your system), but the routine is almost as fast as Windows Explorer except that it is not automatically launched as startup.
  • You can download the project a complete image exploere in VB6.
  • When you click on an image, the message displays the Number and the full path to the image.
  • You can also change the filters to allow the display of other images.


The project contains a custom OCX and DLL, you must:
  • Unzip the folder.
  • Do not click on the project, navigate to the VB6 icon, right click on the icon and open as administrator.
  • At the opening, click on 'Existing' and open the LN_Explorateur.vpb project
  • Modify the width of the TreeView by moving the red line (click on the line and move).
    • Change the size of thumbnails with the 'S' key.



The image display is performed with the Gdi+ dll reduced to its simplest expression.
  • I think the routine can be easily transposed to VB.Net

Code


Option Explicit

Sub Initialise_TreeDir(TreeDir As TreeView)  
Dim ExpDr, Rep, Drv, S As String, N, D, a, r, Unite  
Dim Cle As String, sCle As String, Num As Integer, Sr As Integer  
Dim nodX As Node  
    Num = 64  
    Set ExpDr = CreateObject("Scripting.FileSystemObject")  
    Set Drv = ExpDr.Drives  
    For Each D In Drv  
        S = D.DriveLetter '& ":"  
        If D.DriveType = 3 Then 'réseaux  
            N = D.ShareName  
        ElseIf D.DriveType = 1 Then  'DD externe  
            N = " - Média amovible - (" & D.VolumeName & ")"  
            Incr Num: Cle = S  
            S = S & ":\"  
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 6)  
            AjoutRep S, Cle, TreeDir  
        ElseIf D.DriveType = 2 Then  'DD  
            N = D.VolumeName  
            Incr Num: Cle = S  
            S = S & ":\"  
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & " - (" & N & ")", 2)  
            AjoutRep S, Cle, TreeDir  
        ElseIf D.DriveType = 4 Then 'DVD  
            On Error Resume Next  
            N = D.VolumeName  
            If Err = 71 Then  
                N = "Lecteur DVD - (vide) "  
            Else  
                N = "Lecteur DVD - (" & N & ")"  
            End If  
            Incr Num: Cle = Chr(Num) & "0"  
            S = S & ":\ - "  
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 3)  
        Else  
            Stop  
        End If  
        S = ""  
        D = ""  
    Next  
    Set nodX = Nothing  
    Set ExpDr = Nothing  
    Set Drv = Nothing  

End Sub  

Sub AjoutRep(Chem As String, Cle As String, TreeDir As TreeView)  
Dim Rep, sRp, Obj, sRep, sR2  
Dim sCle As String, Num As Integer, Sr As Integer  
Dim nodX As Node  
Dim NbsR As Integer, S As String  
Sr = 9  
    Chem = Chem & IIf(Right(Chem, 1) = "\", "", "\")  
    Set Obj = CreateObject("Scripting.FileSystemObject")  
    Set Rep = Obj.Getfolder(Chem)  
    If Left(Rep.Name, 1) = "$" Then GoTo Passe2  
    Set sRep = Rep.subfolders  
    For Each sRp In sRep  
        S = UCase(sRp.Name)  
        If Left(S, 1) = "$" Or S = "WINDOWS" Or sRp.Attributes > 100 Or sRp.Attributes = 19 _  
            Or Left(S, 6) = "SYSTEM" Or Left(S, 7) = "PROGRAM" Or Left(S, 4) = "USER" _  
            Or Left(S, 6) = "DRIVER" Or Left(S, 5) = "TOOLS" Then GoTo Passe  
        On Error Resume Next  
        Set sR2 = sRp.subfolders  
        NbsR = sR2.Count  
        If Err <> 0 Then Err = 0: GoTo Passe  
        Incr Sr  
        sCle = sRp.Path & "\"  
        On Error GoTo 0  
        'Debug.Print sRp.Name; "   "; Cle; "  "; sCle  
        Set nodX = TreeDir.Nodes.Add(Cle, tvwChild, sCle, sRp.Name, 5, 4)  
        If NbsR > 0 Then  
            AjoutRep sRp.Path, sCle, TreeDir  
        End If  
Passe:  
    Next  
Passe2:  

    Set Obj = Nothing  
    Set Rep = Nothing  
    Set sRep = Nothing  
    Set nodX = Nothing  
    Set sR2 = Nothing  
End Sub  

Downloads


Credits


Related :

This document entitled « VB - Fill a TreeView with the system disks and their directories » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.