Visual Basic Disk/Drive API Routines
GetDiskFreeSpaceEx: Detailed Drive Info
     
Posted:   Thursday June 29, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   Win95, Win98, WinNT4, Win2000
Author:   VBnet - Randy Birch
     
 Prerequisites
None. This code will work against any drive.

Until Windows 95 OSR2 hit the streets the world was simple, and only the rarest and most expensive hard drives exceeded 2 gigabytes; in fact, a 300-400 megabyte drive was considered high tech server material! Windows 95 provides the GetDiskFreeSpace API to return information about the physical drive, and GetVolumeInformation to return volume-specific data such as the volumes file system and characteristics.

Today, a two gig drive remains unusual - because 'usual' has now become anything between a 120 to 500 gig drive. This movement to larger drives - and the corresponding larger partitions - happened around mid-way through Win95's life. In an updated Win95 release - Win95 OSR2 GetDiskFreeSpaceEx API was introduced to handle the values returned by larger drives formatted into the (then) new FAT32 partitions (Win9x), or the 4 gig partitions available under Windows NT4.

GetDiskFreeSpaceEx, as declared in the MSDN for C developers, uses the ULONG data type for its return values. A 64-bit integer, VB no comparible data type to handle true 64-bit integers. There are workarounds (like creating a Type with two longs), but we do have a specialized 64-bit data type that will fit the bill with some tweaking - the Currency type. The main difference between this and a true ULONG is the need to compensate for the decimal positions that the Currency type adds, but that is not a problem.

The code on this page performs several different operations that you may find useful either together or individually,  in order to get the drive and volume information from a given system's drives:

  • Determines if the GetDiskFreeSpaceEx API is supported on the target OS
  • Uses either GetDiskFreeSpace or GetDiskFreeSpaceEx as the OS allows
  • Shows how to retrieve drive information  (or any number greater than 32 bits) into a Currency data type
  • Enumerates the system's drives
  • Enumerates the drive's volume information
  • Shows one method to populate a TreeView
  • Shows using context menus to change the TreeView styles
  • Shows using context menus to expand/collapse nodes
  • Shows how to disable the menu items based on the TreeView's state.

Because of the length of some of the code lines, particularly the ones to populate the TreeView, this page is somewhat wider than I prefer. It might be easiest to do a select all on the page an paste it into notepad, or to return to the link that brought you here and open the page in its own window.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Type VBNET_DRIVE_INFO
   DrvsAvailable           As String
   DrvType                 As String
   DrvSectors              As Long      'GetDiskFreeSpace only
   DrvBytesPerSector       As Long      'GetDiskFreeSpace only
   DrvFreeClusters         As Long      'GetDiskFreeSpace only
   DrvTotalClusters        As Long      'GetDiskFreeSpace only
   DrvSpaceFree            As Currency  'GetDiskFreeSpaceEx only
   DrvSpaceFreeToCaller    As Currency  'GetDiskFreeSpaceEx only
   DrvSpaceUsed            As Currency  'GetDiskFreeSpaceEx only
   DrvSpaceTotal           As Currency  'GetDiskFreeSpaceEx only
   DrvVolumeName           As String
   DrvSerialNo             As String
   DrvFileSystemName       As String
   DrvFileSystemSupport    As String
   DrvFileSystemFlags      As Long
End Type

Public Declare Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" _
  (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, _
   ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, _
   lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, _
   ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long
       
Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long
       
Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
   Alias "GetDiskFreeSpaceExA" _
  (ByVal lpcurrDrive As String, _
   lpFreeBytesAvailableToCaller As Currency, _
   lpTotalNumberOfBytes As Currency, _
   lpTotalNumberOfFreeBytes As Currency) As Long
       
Public Declare Function GetDiskFreeSpace Lib "kernel32" _
   Alias "GetDiskFreeSpaceA" _
  (ByVal lpRootPathName As String, _
   lpSectorsPerCluster As Long, _
   lpBytesPerSector As Long, _
   lpNumberOfFreeClusters As Long, _
   lpTtoalNumberOfClusters As Long) As Long
   
Public Declare Function GetUserName Lib "advapi32" _
   Alias "GetUserNameA" _
  (ByVal lpBuffer As String, nSize As Long) As Long
      
Public Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" _
  (ByVal nDrive As String) As Long

'drive type constants
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

'file system constants
Public Const FS_CASE_SENSITIVE As Long = &H1
Public Const FS_CASE_IS_PRESERVED As Long = &H2
Public Const FS_UNICODE_STORED_ON_DISK As Long = &H4
Public Const FS_PERSISTENT_ACLS As Long = &H8
Public Const FS_FILE_COMPRESSION As Long = &H10
Public Const FS_VOL_IS_COMPRESSED As Long = &H8000&

Public HasLargeDriveSupport As Boolean


Public Function OsHasLargeDriveSupport() As Boolean

  'Determines whether the method supports a
  'call to the GetDiskFreeSpaceEx API.
  'The method first calls the GetDiskFreeSpaceEx API.
  'If the call fails (no entry point in kernel32)
  'then the function returns false, indicating
  'that the app should use the GetDiskFreeSpace
  'API instead.  GetDiskFreeSpace is limited
  'to partitions less than 2 gig.

   On Local Error GoTo LargeSupport_Error
   
   Dim RootPathName As String
   Dim tmp1 As Currency
   Dim tmp2 As Currency
   Dim tmp3 As Currency
    
   RootPathName = "C:\"
  
  'get the drive's disk parameters
   If GetDiskFreeSpaceEx(RootPathName, _
                         tmp1, _
                         tmp2, _
                         tmp3) Then
      
     'GetDiskFreeSpaceEx supported.
      OsHasLargeDriveSupport = True
      
   End If
   
LargeSupport_Exit:
                         
   Exit Function
   
LargeSupport_Error:

  'No large drive support; use
  'GetDiskFreeSpace instead
  
   OsHasLargeDriveSupport = False
   Resume LargeSupport_Exit

End Function
 Form Code
To a new from, add: a Combo box (Combo1), two labels (Label1 and Label2), two command buttons (Command1 and Command2), a TreeView (Treeview1) and a checkbox (Check1).

Add an ImageList (optional) to the form, and populate with appropriate images. If you chose not to use the ImageList, be sure to remove al the references to the ImageList icon throughout the CreateTreeviewDriveData code. (Alternatively, you can download the base VB6 form and imagelist). The images I used were:

Image No Description
1 "My Computer"
2 Floppy drive
3 Hard drive
4 CD ROM
5 Removable drive
6 Network drive
7 RAM drive (chip)
8 Torn notepaper with paperclip
9 Other Info: paper with floppy drive
10 Other Info: paper with hard drive
11 Other Info: paper with CD ROM drive
12 Other Info: paper with removable drive
13 Other Info: paper with networked drive
14 Other Info: paper with RAM drive

Add two hidden menus to the form as follows:

Menu Name Indent Level Index Caption
mnuBar top 1 HiddenEdit
    mnuTVEdit 1 1 &Expand
    mnuTVEdit 1 2 - (separator)
    mnuTVEdit 1 3 Expand &All
    mnuTVEdit 1 4 Collapse &All
    mnuTVEdit 1 5 - (separator)
    mnuTVEdit 1 6 Display Style
        mnuTVStyle 2 0 Text Only
        mnuTVStyle 2 1 Icons with Text (Default)
        mnuTVStyle 2 2 Plus/minus with Text
        mnuTVStyle 2 3 Plus/minus, with Icons and Text
        mnuTVStyle 2 4 Lines with Text
        mnuTVStyle 2 5 Lines with Icons and Text
        mnuTVStyle 2 6 Lines, Plus/Minus with Text
        mnuTVStyle 2 7 Lines, plus/minus, Icons with Text

With the above in place, add the following code to the form:


Option Explicit

Const mnuExpand As Integer = 1
Const mnuExpandAll As Integer = 3
Const mnuColapseAll As Integer = 4


Private Sub Form_Load()

  'check if the operating system supports
  'calls to the GetDiskFreeSpaceEx API
   HasLargeDriveSupport = OsHasLargeDriveSupport()
   
   Label2.Caption = IIf(HasLargeDriveSupport, _
                "Large drives are supported; GetDiskFreeSpaceEx will be used", _
                "Large drives NOT supported; GetDiskFreeSpace will be used")
   
  'centre form
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
  'load the drives
   LoadAvailableDrives Combo1
   
  'select the second combo item, (should be C)
   Combo1.ListIndex = 1
   
  'initialize the TreeView popup menu.
  '
  'Note that this is NOT the same as
  'calling:
  '  mnuTVStyle(1).Checked = True
  'The above only checks the item,
  'without firing the associated
  'menu code.
   mnuTVStyle_Click 1

End Sub


Private Sub LoadAvailableDrives(cmbo As ComboBox)

  Dim lpBuffer As String

 'get list of available drives
  lpBuffer = GetDriveString()

 'Separate the drive strings
 'and add to the combo. StripNulls
 'will continually shorten the
 'string. Loop until a single
 'remaining terminating null is
 'encountered.
  Do Until lpBuffer = Chr$(0)
  
   'strip off one drive item
   'and add to the combo
    cmbo.AddItem StripNulls(lpBuffer)
    
  Loop
  
End Sub


Private Function GetDriveString() As String

  'returns string of available
  'drives each separated by a null
   Dim sBuffer As String
   
  'possible 26 drives, three characters each, plus trailing null
   sBuffer = Space$(26 * 4)
  
  If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

     'do not trim off trailing null!
      GetDriveString = Trim$(sBuffer)
      
   End If

End Function


Function StripNull(startStrg As String) As String

  'Take a string separated by Chr(0)'s, and split off 1 item, and
  'shorten the string so that the next item is ready for removal.
  
   Dim pos As Integer
   pos = InStr(startStrg, Chr$(0))
   
   If pos Then
      StripNull = Mid(startStrg, 1, pos - 1)
      startStrg = Mid(startStrg, pos + 1, Len(startStrg))
   End If
   
End Function


Function HiWord(dw As Long) As Long
  
   If dw And &H80000000 Then
      HiWord = (dw \ 65535) - 1
   Else
      HiWord = dw \ 65535
   End If
    
End Function
  

Function LoWord(dw As Long) As Long
  
   If dw And &H8000& Then
      LoWord = &H8000& Or (dw And &H7FFF&)
   Else
      LoWord = dw And &HFFFF&
   End If
    
End Function


Private Sub Command2_Click()

  Dim thisDrive As String
  Dim c As Integer
  
   If Combo1.ListCount > 0 Then
   
      Label1.Caption = "Loading drive stats..."
      DoEvents
  
     'increase the apparent speed by setting the
     'control's visible property to false, then
     'clear the TreeView and load the nodes
      TreeView1.Visible = False
      If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
    
      For c = 0 To Combo1.ListCount - 1
         thisDrive = Left$(Combo1.List(c), 1)
         CreateTreeviewDriveData thisDrive
      Next
      
      TreeView1.Visible = True
   
   End If
   
   Label1.Caption = "Select drive and right-click for options."
   
End Sub


Private Sub Command1_Click()

  Dim thisDrive As String
  
  thisDrive = Left$(Combo1.List(Combo1.ListIndex), 1)
  
  If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
  CreateTreeviewDriveData thisDrive
  
  Label1.Caption = "Select '" & thisDrive & "' and right-click for options."
  
End Sub


Private Sub Combo1_Click()

   Dim thisDrive As String
   
   thisDrive = Left$(Combo1.List(Combo1.ListIndex), 1)
   
   If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
   CreateTreeviewDriveData thisDrive
   
   Label1.Caption = "Select '" & thisDrive & "' and right-click for options."
   
   Command1.Caption = "Reload " & Combo1.List(Combo1.ListIndex)
   
End Sub


Private Function rgbGetDriveType(RootPathName As String) As String

  'returns the type of drive.
  
   Select Case GetDriveType(RootPathName)
      Case 0: rgbGetDriveType = "The drive type cannot be determined."
      Case 1: rgbGetDriveType = "The root directory does not exist."
      
         Case DRIVE_REMOVABLE:
            Select Case Left(RootPathName, 1)
                Case "a", "b": rgbGetDriveType = "Floppy drive."
                Case Else:     rgbGetDriveType = "Removable drive."
            End Select
         
      Case DRIVE_FIXED:   rgbGetDriveType = "Hard drive; can not be removed."
      Case DRIVE_REMOTE:  rgbGetDriveType = "Remote (network) drive."
      Case DRIVE_CDROM:   rgbGetDriveType = "CD-ROM drive."
      Case DRIVE_RAMDISK: rgbGetDriveType = "RAM disk."
   End Select
  
End Function


Private Function rgbGetDiskFreeSpace(RootPathName As String, _
                                     VDI As VBNET_DRIVE_INFO) As Long

  'returns data about the selected drive.
  'Passed is the RootPathName; the other
  'variables are filled in here.
  
  'This routine uses the GetDiskFreeSpaceEx API
  'if that API is supported, otherwise it uses
  'the older GetDiskFreeSpace

  'GetDiskFreeSpaceEx only variables
   Dim BytesFreeToCalller As Currency
   Dim TotalBytes As Currency
   Dim TotalFreeBytes As Currency
   Dim TotalBytesUsed As Currency
   Dim msg As String
      
   On Local Error GoTo DiskFreeSpace_error
         
   If HasLargeDriveSupport Then  'use GetDiskFreeSpaceEx
      
     'get the drive's disk parameters
      If GetDiskFreeSpaceEx(RootPathName, _
                            BytesFreeToCalller, _
                            TotalBytes, _
                            TotalFreeBytes) = 1 Then
  
        'multiplying the returned valued by 10000
        'to adjust for the 4 decimal places that the
        'currency data type returns.
         VDI.DrvSpaceTotal = (TotalBytes * 10000)
         VDI.DrvSpaceFree = (TotalFreeBytes * 10000)
         VDI.DrvSpaceFreeToCaller = (BytesFreeToCalller * 10000)
         VDI.DrvSpaceUsed = ((TotalBytes - TotalFreeBytes) * 10000)
 
         rgbGetDiskFreeSpace = 1
         
      End If
      
   
   Else 'use the older GetDiskFreeSpace

      If GetDiskFreeSpace(RootPathName, _
                          VDI.DrvSectors, _
                          VDI.DrvBytesPerSector, _
                          VDI.DrvFreeClusters, _
                          VDI.DrvTotalClusters) = 1 Then

         VDI.DrvSpaceTotal = (VDI.DrvSectors * VDI.DrvBytesPerSector * VDI.DrvTotalClusters)
         VDI.DrvSpaceFree = (VDI.DrvSectors * VDI.DrvBytesPerSector * VDI.DrvFreeClusters)
        'DrvSpaceFreeToCaller is not returned so use DrvSpaceFree
         VDI.DrvSpaceFreeToCaller = VDI.DrvSpaceFree
         VDI.DrvSpaceUsed = VDI.DrvSpaceTotal - VDI.DrvSpaceFree

         rgbGetDiskFreeSpace = 1
         
      End If
   
   End If
   
DiskFreeSpace_exit:

   On Local Error GoTo 0
   Exit Function
   

DiskFreeSpace_error:
   
   If HasLargeDriveSupport Then
      
      msg = "An error occurred processing the GetDiskFreeSpaceEx call." & vbNewLine
      msg = msg & "Check that the variables passed are declared Currency."
      MsgBox msg, vbExclamation
   
   Else

       msg = "Drive information for drive " & RootPathName & _
             " has caused an error." & vbNewLine & vbNewLine & _
              "The probable cause is that the drive" & _
              "exceeds two gig, generating an overflow " & _
              "in the drive space calculations because the " & _
              "operating system does not support GetDiskFreeSpaceEx"
              
      MsgBox msg, vbExclamation
   
   End If
   
   rgbGetDiskFreeSpace = False
   Resume DiskFreeSpace_exit

End Function


Private Function rgbGetVolumeInformation(RootPathName As String, _
                                         VDI As VBNET_DRIVE_INFO) As Long
  
  'Returns information about the passed drive's
  'type, free space, total space, volume information
  
   Dim pos As Integer
   Dim HiWord As Long, HiHexStr As String
   Dim LoWord As Long, LoHexStr As String
   Dim VolumeSN As Long
   Dim MaxFNLen As Long

  'create working strings
   VDI.DrvVolumeName = Space(14)
   VDI.DrvFileSystemName = Space(32)

  'do what it says
   If GetVolumeInformation(RootPathName, _
                           VDI.DrvVolumeName, _
                           Len(VDI.DrvVolumeName), _
                           VolumeSN, MaxFNLen, _
                           VDI.DrvFileSystemFlags, _
                           VDI.DrvFileSystemName, _
                           Len(VDI.DrvFileSystemName)) Then

 
     'the volume label
      pos = InStr(VDI.DrvVolumeName, Chr(0))
      If pos Then VDI.DrvVolumeName = Left(VDI.DrvVolumeName, pos - 1)
      If Len(Trim(VDI.DrvVolumeName)) = 0 Then VDI.DrvVolumeName = "(no label)"
      
     'File system type (FAT, NTFS etc)
      pos = InStr(VDI.DrvFileSystemName, Chr(0))
      If pos Then VDI.DrvFileSystemName = Left(VDI.DrvFileSystemName, pos - 1)
      
     'File type parameters
      VDI.DrvFileSystemSupport = "Supports " & MaxFNLen & "-character filenames"
      
     'Drive volume id
      VDI.DrvSerialNo = Hex(VolumeSN)
      
     'return success
      rgbGetVolumeInformation = 1
  
  End If

End Function


Private Function rgbGetUserName() As String

  'returns the name of the user
   Dim username As String
   
   username = Space$(256)
   
   If GetUserName(username, Len(username)) Then
      rgbGetUserName = Left(username, InStr(username, Chr$(0)) - 1)
   Else
      rgbGetUserName = "(unknown)"
   End If

End Function


Public Sub CreateTreeviewDriveData(thisDrive As String)

   Dim nodX             As Node
   Dim count            As Integer
   
   Dim nIcon            As Integer
   Dim thisDriveFull    As String
   Dim TreeName         As String
   Dim TreeCaption      As String
   Dim dCaption         As String
   Dim dummy            As String
   Dim pKey             As String
   Dim OtherInfoKey     As String
   Dim flagExpand       As Boolean
   
   Const drvFormat      As String = "###,###,###,###,##0 b\y\t\e\s"
   Const cluFormat      As String = "###,###,###,###,##0"
   
  'my own structure to hold the drive info
   Dim VDI As VBNET_DRIVE_INFO
   
  'set the Expand Nodes flag value based on the checkbox
   flagExpand = Check1.Value = 1
   
  'assign the imagelist to the treeview
   TreeView1.ImageList = ImageList1
   
  'If this is the first time through the
  'routine (the treeview is empty), create
  'the text for the root tree item & expand
  'the root node. If the treeview has contents,
  'just get the current parent key. The parent
  'key to the entire tree is stored in 'TreeName'.
   If TreeView1.Nodes.count = 0 Then
   
     'the root item text will also be the key name
      TreeName = "Drive Details on '" & rgbGetUserName() & "'"
      Set nodX = TreeView1.Nodes.Add(, , TreeName, TreeName, 1, 1)
      
     'force the node expanded .. for the
     'others, use the flag
      nodX.Expanded = True
      
   Else: TreeName = TreeView1.Nodes.Item(1).Text
   End If
     
  'increment a counter to create individual
  'keynames for use as a parent keyname for
  'further subordinate childs
   thisDriveFull = thisDrive & ":\"
   count = count + 1
   pKey = CStr(count) & "K" & thisDrive
      
  'set the drive icon no from the imagelist,
  'and the drive caption.
   nIcon = rgbGetDriveIconFromType(thisDriveFull)
    
      
   'If there was no error in the API calls
    If rgbGetDiskFreeSpace(thisDriveFull, VDI) = 1 And _
       rgbGetVolumeInformation(thisDriveFull, VDI) = 1 Then
     
        'display the root drive, and expand as set in the flag
         Set nodX = TreeView1.Nodes.Add(TreeName, tvwChild, _
                                        pKey, _
                                        "Drive " & thisDriveFull, _
                                        nIcon)
         nodX.Expanded = flagExpand

        'create an individual key.  Here I use a form of the
        'variable name appended with the count value.  This
        'ensures that if in a While...Wend loop for all drives,
        'each key will be unique.
         dummy = "DFS" & count & thisDrive
         dCaption = "File System  :  " & VDI.DrvFileSystemName
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "DVN" & count & thisDrive
         dCaption = "Volume Label :  " & VDI.DrvVolumeName
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "DSR" & count & thisDrive
         dCaption = "Volume Serial No :  " & VDI.DrvSerialNo
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "DST" & count & thisDrive
         dCaption = "Total Drive Size :  " & Format$(VDI.DrvSpaceTotal, drvFormat)
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "DSU" & count & thisDrive
         dCaption = "Drive Space Used :  " & Format$(VDI.DrvSpaceUsed, drvFormat)
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "DSF" & count & thisDrive
         dCaption = "Drive Space Free :  " & Format$(VDI.DrvSpaceFree, drvFormat)
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         dummy = "SFC" & count & thisDrive
         dCaption = "Space Free To Caller :  " & Format$(VDI.DrvSpaceFreeToCaller, drvFormat)
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
         
         'If GetDiskFreeSpaceEx was used, the
         'cluster/sector info was not returned
         'so print "n/a"
          dummy = "DRVS" & count & thisDrive
          dCaption = "Sectors :  " & _
                      IIf(VDI.DrvSectors, Format$(VDI.DrvSectors, cluFormat), "n/a")
          Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
          
          dummy = "DBPS" & count & thisDrive
          dCaption = "Bytes Per Sector :  " & _
                      IIf(VDI.DrvSectors, Format$(VDI.DrvBytesPerSector, cluFormat), "n/a")
          Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
          
          dummy = "DFCL" & count & thisDrive
          dCaption = "Free Clusters :  " & _
                      IIf(VDI.DrvSectors, Format$(VDI.DrvFreeClusters, cluFormat), "n/a")
          Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
          
          dummy = "DTFC" & count & thisDrive
          dCaption = "Total Clusters :  " & _
                      IIf(VDI.DrvSectors, Format$(VDI.DrvTotalClusters, cluFormat), "n/a")
          Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)

  
        'The "Other Info" goes next, and this item will
        'be a parent to the other info data shown below it,
        'so the key must be saved and used below.
       
        'The icon is determined by offsetting the
        'drive-type icon by 7 (see the imagelist icons).
       
         OtherInfoKey = "Other" & count & thisDrive
         dCaption = "Other Volume Info"
         Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, OtherInfoKey, dCaption, nIcon + 7)
         nodX.Expanded = flagExpand
  
        'This is where the "Other Info" goes, so we have to
        'create a new indent level, by using the Other Info
        'key as the parent.
        '
        'As these will have no sub-child items, the 'dummy'
        'can be omitted leaving a comma as a placeholder
         Set nodX = TreeView1.Nodes.Add(OtherInfoKey, tvwChild, , rgbGetDriveType(thisDriveFull), 8)
         Set nodX = TreeView1.Nodes.Add(OtherInfoKey, tvwChild, , VDI.DrvFileSystemSupport, 8)
 
        'these are only set based on flags returned in VDI.DrvFileSystemFlags
         If VDI.DrvFileSystemFlags And FS_CASE_IS_PRESERVED Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                          tvwChild, , _
                                          "case preserved when saved", 8)
         End If
         
         If VDI.DrvFileSystemFlags And FS_CASE_SENSITIVE Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                           tvwChild, , _
                                           "supports case-sensitive filenames", 8)
         End If
         
         If VDI.DrvFileSystemFlags And FS_PERSISTENT_ACLS Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                           tvwChild, , _
                                           "preserves and enforces ACL", 8)
         End If
         
         If VDI.DrvFileSystemFlags And FS_UNICODE_STORED_ON_DISK Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                           tvwChild, , _
                                           "supports Unicode filenames", 8)
         End If
         
         If VDI.DrvFileSystemFlags And FS_FILE_COMPRESSION Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                           tvwChild, , _
                                           "supports file-based compression", 8)
         End If
         
         If VDI.DrvFileSystemFlags And FS_VOL_IS_COMPRESSED Then
            Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
                                          tvwChild, , _
                                          "specified volume is compressed", 8)
         End If
   
  End If

End Sub


Private Sub mnuTVEdit_Click(Index As Integer)

   Dim c As Integer
   Dim currNodeIndex As Integer
         
  'currNodeIndex represents the
  'indentation level of the current node
  'Assume that the node is a first-level node.
  'This assures that a Collapse All command
  'will not close the root.
   currNodeIndex = 1 'the drive letter
   
  'if the current node is already expanded,
  'then assume the node desired is at the
  'second indent level
   If TreeView1.Nodes(1).Expanded Then currNodeIndex = 2  'info
   
   Select Case Index
     
      Case mnuExpand
        'toggle the treeview's visible state
        'to avoid the unnecessary repainting
        'as each node changes state
         TreeView1.Visible = False
         TreeView1.SelectedItem.Expanded = Not TreeView1.SelectedItem.Expanded
         TreeView1.Visible = True
      
      Case mnuExpandAll
         
        'toggle the treeview's visible state
        'to avoid the unnecessary repainting
        'as each node changes state
         TreeView1.Visible = False
         
        'expand all the nodes from the current
        'node through the last node for the
        'given tree item
         For c = currNodeIndex To TreeView1.Nodes.count
            If TreeView1.Nodes(c).Children > 0 Then
               TreeView1.Nodes(c).Expanded = True
            End If
         Next
         TreeView1.Visible = True
      
      Case mnuColapseAll
      
        'toggle the treeview's visible state
        'to avoid the unnecessary repainting
        'as each node changes state
         TreeView1.Visible = False
        
       'collapse all the nodes from the current
       'node through the last node for the
       'given tree item
        For c = currNodeIndex To TreeView1.Nodes.count
            If TreeView1.Nodes(c).Children > 0 Then
               TreeView1.Nodes(c).Expanded = False
            End If
         Next
         TreeView1.Visible = True
         
   End Select

End Sub


Private Sub mnuTVStyle_Click(Index As Integer)

   mnuTVStyle(TreeView1.Style).Checked = False
   TreeView1.Style = Index
   mnuTVStyle(Index).Checked = True

End Sub


Private Sub TreeView1_MouseUp(Button As Integer, _
                              Shift As Integer, _
                              x As Single, _
                              y As Single)

  If Button = 2 Then PopupMenu mnuBar(1), , , , mnuTVEdit(1)

End Sub


Private Sub TreeView1_NodeClick(ByVal Node As Node)

 'configure the hidden menu items based on the current selection
 'set the Expand/Collapse captions
 
  If TreeView1.Nodes(Node.Index).Expanded Then
     mnuTVEdit(mnuExpand).Caption = "&Collapse"
  Else
     mnuTVEdit(mnuExpand).Caption = "&Expand"
  End If

  mnuTVEdit(mnuExpand).Enabled = Node.Children > 0

End Sub


Private Function rgbGetDriveIconFromType(RootPathName As String) As Integer

  'returns the index to the imagelist
  'where the specified drive icon is.
  
   Select Case GetDriveType(RootPathName)
      Case 0: rgbGetDriveIconFromType = 1
      Case 1:
      
         Case DRIVE_REMOVABLE:
            Select Case Left(RootPathName, 1)
                Case "a", "b": rgbGetDriveIconFromType = 2
                Case Else:     rgbGetDriveIconFromType = 1
            End Select
         
      Case DRIVE_FIXED:   rgbGetDriveIconFromType = 3
      Case DRIVE_REMOTE:  rgbGetDriveIconFromType = 6
      Case DRIVE_CDROM:   rgbGetDriveIconFromType = 4
      Case DRIVE_RAMDISK: rgbGetDriveIconFromType = 7
   End Select

End Function
 Comments
Run the project and select a drive. The drive and its details will be loaded into the treeview. Label2 reflects the API being used, and the treeview context menu will provide the ability to change the treeview style, and expand or collapse the nodes.

If you want to test the accuracy of the OsHasLargeDriveSupport() function, you can cause the GetDiskFreeSpaceEx API to fail by changing the Alias from GetDiskFreeSpaceEx to another word, ie GetDiskFreeSpaceExXXX. Just make sure that you have at least one partition that is smaller than 2 gigs to try the code against.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter