Public Const MAX_PATH As Long = 260
    
'GetDriveType return values  
Public Const DRIVE_REMOVABLE As Long = 2
Public Const DRIVE_FIXED As Long = 3
Public Const DRIVE_REMOTE As Long = 4
Public Const DRIVE_CDROM As Long = 5
Public Const DRIVE_RAMDISK As Long = 6
  
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
  
Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
   (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long

Public Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
   (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _ 
   (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose  Lib "kernel32" _
 (ByVal hFindFile As Long) As Long
 
'flags for the user options  
Public displayExpanded As Boolean
Public displaySorted As Boolean
Public NoOfDrives As Integer


Public Function TrimNull(startstr As String) As String

  Dim pos As Long

  pos = InStr(startstr, Chr$(0))
  
  If pos Then      
      TrimNull = Left$(startstr, pos - 1)
      Exit Function    
  End If
  
 'if this far, there was no Chr$(0), so return the string 
  TrimNull = startstr
  
End Function


Public Sub GetAllDrivesFolders(tvwTree As Control, nodParentNode As Node)

'this routine uses a pre-dimmed array to speed up 
'processing.  Initially, the array is DIM'med to 
'200 elements; in the While loop it is increased 
'another 200 elements when "found Mod 200 = 0" 
'(or the number found divided by 200 equals 0).  
'At the end of the loop, it is resized down to the 
'total found.  This is significantly faster than 
'using a Redim Preserve statement for each element found.

   Dim nodX As Node
  
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
  
   Dim sFile As String
   Dim sPath As String
   
   Dim i As Long
   Dim r As Long
   Dim found As Long
  
  'assign the fullpath property to the path to search,
  'assuring that the path is qualified. 
   If Right$(nodParentNode.FullPath, 1) <>  "\" Then
      sPath = nodParentNode.FullPath & "\"
   Else
      sPath = nodParentNode.FullPath
   End If
    
 'find the first file matching the parameter \*.* 
  hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
   
  'reset the counter flag 
   found = 0
   ReDim fArray(200)
  
   If hFile <> -1 Then
      sFile = TrimNull(WFD.cFileName)
    
      WFD.dwFileAttributes = vbDirectory
    
      While FindNextFile(hFile, WFD)
    
        sFile = TrimNull(WFD.cFileName)
        
     'ignore the 2 standard root entries 
        If (sFile <>  ".") And (sFile <>  "..") Then
          
           If (WFD.dwFileAttributes And vbDirectory) Then
              
           'if found is at 200, then add some more array elements 
             found = found + 1           
             If found Mod 200 = 0 Then ReDim Preserve fArray(found + 200)
             fArray(found) = sFile
           
            End If
      
         End If
      
     Wend
    
   End If
  
   Call FindClose(hFile)
      
 'trim down the array to equal the elements found 
   ReDim Preserve fArray(found)
   
 'add the folders to the treeview 
   For i = 1 To found
    
     Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
                                  tvwChild, _
                                  sPath & fArray(i) & "Dir", _
                                  fArray(i))
           
    'and get some more 
     GetAllDrivesFolders tvwTree, nodX
    
   Next i
  
   nodParentNode.Sorted = displaySorted
   nodParentNode.Expanded = displayExpanded

End Sub

Option Explicit

Private Sub Form_Load()
 
 'centre the form  
  Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    
 'set initial options 
  displaySorted = True
  displayExpanded = False
  
 'load the system drives 
  GetSystemDrives
    
 'store the initial number of treeview elements for
 'later subtraction when presenting the total number
 'of files loaded (Treeview1_click routine) 
  NoOfDrives = Treeview1.Nodes.Count
  
  Label1.Caption = "Click on any drive letter to load its folders."

End Sub


Private Sub Command1_Click()

  Unload Me

End Sub


Private Sub GetSystemDrives()

  Dim nodX As Node
  Dim r As Long
  Dim allDrives As String
  Dim currDrive As String
  Dim drvIcon As Integer
    
 'get the list of all available drives 
  allDrives = rgbGetAvailableDrives()
  
  Do Until allDrives = Chr$(0)
    
   'strip off one drive item from the allDrives$ 
    currDrive = StripNulls(allDrives)
      
   'we can't have the trailing slash, so .. 
    currDrive = Left$(currDrive, 2)
      
   'add the drive to the treeview 
    Set nodX = Treeview1.Nodes.Add(, tvwChild, _
                                     currDrive & "Dir", _
                                     currDrive)
    nodX.Expanded = True
    
  Loop
  
 'force sorting of the drive letters 
  nodX.Sorted = True

End Sub


Private Function rgbGetAvailableDrives() As String 
 'returns a single string of available drive
 'letters, each separated by a chr$(0) 

  Dim tmp As String
  
  tmp = Space$(64)
  Call GetLogicalDriveStrings(Len(tmp), tmp)
  
  rgbGetAvailableDrives = Trim$(tmp)

End Function


Private Function StripNulls(startstr As String) As String

 'Take a string separated by chr$(0)
 'and split off 1 item, shortening the
 'string so next item is ready for removal.
  Dim pos As Long

  pos = InStr(startstr$, Chr$(0))
  
  If pos Then
      
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
    
  End If

End Function


Private Sub Treeview1_Click()

  Dim nodX As Node
    
 'show a wait message for long searches 
  Label1.Caption = "Searching drive " & Treeview1.SelectedItem & " for folders ... please wait"
  DoEvents
    
 'identify the selected node 
  Set nodX = Treeview1.SelectedItem
    
'verify that it is valid> 
  If (UCase$(Right$(nodX.Key, 3)) = "DIR") And (nodX.Children = 0) Then
     GetAllDrivesFolders Treeview1, nodX
  End If
  
 'subtract NoOfDrives because initial drives loaded 
 'should not be counted as a folder 
  Label1.Caption = "Total folders displayed : " & Treeview1.Nodes.Count - NoOfDrives
  
End Sub