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 GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" _
   (ByVal nDrive As String) As Long

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  'integer for VB432
Public displaySorted As Boolean    'integer for VB432
Public LoadAll As Boolean          'integer for VB432
Public NoOfDrives As Integer


Public Function TrimNull(startstr As String) As String

  Dim pos As Integer

  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 Integer
  Dim r As Long
  Dim found As Integer
  
'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
    
  'strip off the "My Computer" from the FullPath property.
  'The actual fullpath is "My Computer\C:\", however,
  'the Findxxx APIs want only the qualified path, i.e "C:\".      
   sPath = Mid$(sPath, 13, Len(sPath))

 '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
          
            found = found + 1
              
           'if found is at 200, then add some more array elements 
            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), 8, 9)
           
   'and get some more 
    If LoadAll Then GetAllDrivesFolders tvwTree, nodX
    
  Next i
  
  nodParentNode.Sorted = displaySorted
  nodParentNode.Expanded = displayExpanded

End Sub


Sub GetNextLevelFolders(tvwTree As Control, nodParentNode As Node)
  
  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 Integer
  Dim r As Long
  Dim found As Integer

 '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

 'strip off the "My Computer" from the FullPath property.
 'The actual fullpath is "My Computer\C:\", however,
 'the Findxxx APIs want only the qualified path, i.e "C:\".    
  sPath = Mid$(sPath, 13, Len(sPath))

 'find the first file matching the parameter \*.* 
  hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
    
  If hFile <>  -1 Then
  
    sFile = TrimNull(WFD.cFileName)
    
    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
             'add the item and its icon    
              Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
                                           tvwChild, _
                                           sPath & sFile & "Dir", _
                                           sFile, 8, 9)
          End If
      
      End If
      
    Wend
    
  End If
  
  Call FindClose(hFile)
  
  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    
   Check2.Value = 1
   Check1.Value = 1
   Option1(0).Value = True

  '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 = "Set your Load options, then click any drive."

End Sub


Private Sub Command1_Click()

  Unload Me
  
End Sub


Private Sub Check1_Click()

  displayExpanded = Check1.Value = 1

End Sub


Private Sub Check2_Click()

  displaySorted = Check2.Value = 1

End Sub


Private Sub Option1_Click(Index As Integer)

  LoadAll = Option1(1).Value = True

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

 'assign the imagelist to the treeview    
  Treeview1.ImageList = ImageList1

 'add a base "My Computer" to the tree   
  Set nodX = Treeview1.Nodes.Add(, , "Root", "My Computer", 1, 1)
  nodX.Expanded = True

 '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)
     
    'determine the appropriate imagelist icon to display   
     drvIcon = GetDriveDisplayIcon(currDrive)
     
    'we can't have the trailing slash, so ..    
     currDrive = Left$(currDrive, 2)
     
    'Add the drive to the treeview.    
     Set nodX = Treeview1.Nodes.Add("Root", _
                                     tvwChild, _
                                     currDrive$ & "Dir", _
                                     currDrive$, drvIcon, drvIcon)
     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 r As Long
  Dim tmp As String
  
  tmp = Space$(64)
  Call GetLogicalDriveStrings(Len(tmp), tmp)
  
  rgbGetAvailableDrives = Trim$(tmp)

End Function


Private Function GetDriveDisplayIcon(driveName) As Integer

  Dim dIcon As Integer
  
  Select Case GetDriveType(driveName)
    Case 0, 1:            dIcon = 1
    Case DRIVE_REMOVABLE:
        Select Case Left$(driveName, 1)
          Case "a", "b":  dIcon = 2
          Case Else:      dIcon = 5
        End Select
    
    Case DRIVE_FIXED:     dIcon = 3
    Case DRIVE_REMOTE:    dIcon = 6
    Case DRIVE_CDROM:     dIcon = 4
    Case DRIVE_RAMDISK:   dIcon = 7
  End Select
  
  GetDriveDisplayIcon = dIcon
  
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
     
     'based on the user options, ...     
      If LoadAll Then
            GetAllDrivesFolders Treeview1, nodX
      Else: GetNextLevelFolders Treeview1, nodX
      End If
   
  End If

  'subtract NoOfDrives because "My Computer" and the
  'initial drives loaded should not be counted as a folder    
   Label1.Caption = "Total folders displayed : " & _
                      Treeview1.Nodes.Count - NoOfDrives
  
End Sub