Visual Basic Disk/Drive API Routines
GetDiskFreeSpaceEx: Determining Free Disk Space
     
Posted:   Thursday December 23, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Development:   VB6, Windows NT4
OS restrictions:   Win95, Win98, WinNT4, Windows 2000, Windows XP
Author:   VBnet - Randy Birch
     
 Related:   GetDiskFreeSpace: Free Disk Space on Windows 95 (or Small Partitions)
GetDiskFreeSpaceEx: Free Disk Space on a Fat32 or NTFS Drive
GetDiskFreeSpaceEx: Detailed Drive Info
How to Determine the Disk Volume Label and Serial Number
GetDriveType: Enumerate and Identify Available System Drives
GetLogicalDriveStrings: Determine if a Specific Drive Exists
GetDriveType: Identify a System's CD-ROM Drive
    
 Prerequisites
32-bit Windows, any version.

This page presents four key wrapper routines for GetDiskFreeSpaceEx. Each routine works on both Win95 and Win95 OSR2, as well as Windows 98, NT4 2000, XP and Windows 2003.

By checking for the process address of the GetDiskFreeSpaceExA API in kernel32.dll, which will only return a valid value when the OS supports the call, each wrapper calls the supported API for the operating system in use. This makes this code ideal for situations where the target OS is unknown at design time. The wrappers are also ideal when only one particular piece of info is needed (i.e. free space).

To accommodate testing of both the GetDiskFreeSpace and Ex calls on systems supporting this API, once the form has been build, saved and run, do a search/replace for GetDiskFreeSpaceA, and change this name to something else (eg "GetDiskFreeSpaceBAD".  This will cause the 'If ptr Then' block to fail returning the values from the older GetDiskFreeSpace call. Note that in doing this that 1) partitions over 2 gig on the original Windows 95 will return incorrect values, and 2) that on NTFS systems, each GetDiskFreeSpace call will overflow the Longs being used to compute the totals (this is why each GetDiskFreeSpace call is wrapped in an error handler). This however is only an issue in testing by this method and not an issue in practice because any system supporting NTFS supports GetDiskFreeSpaceEx.

 BAS Module Code
None

 Form Code
Add the following code to the form containing one command button (Command1), a combo (Combo1) and a picture box (borderless in the illustration) to receive the output of the Combo1_Click event:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
   (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long

Private 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
   
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
   Alias "GetDiskFreeSpaceExA" _
   (ByVal lpRootPathName As String, _
   lpFreeBytesAvailableToCaller As Currency, _
   lpTotalNumberOfBytes As Currency, _
   lpTotalNumberOfFreeBytes As Currency) As Long
      
Private Declare Function GetModuleHandle Lib "kernel32" _
   Alias "GetModuleHandleA" _
  (ByVal lpModuleName As String) As Long
  
Private Declare Function GetProcAddress Lib "kernel32" _
  (ByVal hModule As Long, _
   ByVal lpProcName As String) As Long
 

Private Sub Form_Load()

   LoadAvailableDrives Combo1
   Picture1.AutoRedraw = True
   Combo1.ListIndex = 1
  
End Sub


Private Sub Combo1_Click()
   
   Dim sDrive As String
   Dim sBytes As String
   
   sBytes = "###,###,###,##0 bytes"
   
   If Combo1.ListIndex > -1 Then
   
     'the drive of interest
      sDrive = Combo1.List(Combo1.ListIndex)
   
      Picture1.Cls
      
      Picture1.Print " Disk size:", Format$(GetDiskSpace(sDrive), sBytes)
      Picture1.Print
      Picture1.Print " Total free:", Format$(GetDiskSpaceFree(sDrive), sBytes)
      Picture1.Print " Bytes free:", Format$(GetDiskBytesAvailable(sDrive), sBytes)
      Picture1.Print
      Picture1.Print " Disk used :", Format$(GetDiskSpaceUsed(sDrive), sBytes)
      
   End If
   
End Sub


Private Sub Command1_Click()

   Unload Me

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 a null, with a final trailing null
   sBuffer = Space$((26 * 4) + 1) 
  
  If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

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

End Function


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 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))
      Exit Function
    
   End If

End Function


Private Function GetDiskSpaceUsed(sDrive As String) As Currency

  'for GetDiskFreeSpaceEx
   Dim BytesFree As Currency
   Dim TotalBytes As Currency
   Dim TotalBytesFree As Currency
   Dim TotalBytesUsed As Currency
   
  'for GetDiskFreeSpace
   Dim nSectors As Long
   Dim nBytesPerSector As Long
   Dim nFreeClusters As Long
   Dim nTotalClusters As Long
   Dim DrvSpaceTotal As Long
   Dim DrvSpaceFree As Long
     
  'for GetProcAddress
   Dim ptr As Long
  
  'attempt to obtain a pointer to
  'the GetDiskFreeSpaceExA API in kernel32
   ptr = GetProcAddress(GetModuleHandle("kernel32.dll"), "GetDiskFreeSpaceExA")
  
   If ptr Then

     'get drive info using GetDiskFreeSpaceEx
      If GetDiskFreeSpaceEx(sDrive, _
                            BytesFree, _
                            TotalBytes, _
                            TotalBytesFree) <> 0 Then
      
        'adjust the by multiplying the returned
        'value by 10000 accommodate for the decimal
        'places the currency data type returns.
         GetDiskSpaceUsed = (TotalBytes - BytesFree) * 10000
      
      End If  'if GetDiskFreeSpaceEx
   
   Else
   
     'get drive info using GetDiskFreeSpace
      If GetDiskFreeSpace(sDrive, nSectors, _
                          nBytesPerSector, _
                          nFreeClusters, _
                          nTotalClusters) <> 0 Then
   
        'perform math to get the data
         On Local Error Resume Next
         DrvSpaceTotal = (nSectors * nBytesPerSector * nTotalClusters)
         DrvSpaceFree = (nSectors * nBytesPerSector * nFreeClusters)
         GetDiskSpaceUsed = (DrvSpaceTotal - DrvSpaceFree)
         On Local Error GoTo 0
     
     End If  'if GetDiskFreeSpace
   End If  'If ptr

End Function


Private Function GetDiskSpace(sDrive As String) As Currency

  'for GetDiskFreeSpaceEx
   Dim BytesFree As Currency
   Dim TotalBytes As Currency
   Dim TotalBytesFree As Currency
   Dim TotalBytesUsed As Currency
   
  'for GetDiskFreeSpace
   Dim nSectors As Long
   Dim nBytesPerSector As Long
   Dim nFreeClusters As Long
   Dim nTotalClusters As Long
     
  'for GetProcAddress
   Dim ptr As Long
  
  'attempt to obtain a pointer to
  'the GetDiskFreeSpaceExA API in kernel32
   ptr = GetProcAddress(GetModuleHandle("kernel32.dll"), "GetDiskFreeSpaceExA")
   
   If ptr Then

     'get drive info using GetDiskFreeSpaceEx
      If GetDiskFreeSpaceEx(sDrive, _
                            BytesFree, _
                            TotalBytes, _
                            TotalBytesFree) <> 0 Then
      
        'adjust the by multiplying the returned
        'value by 10000 accommodate for the decimal
        'places the currency data type returns.
         GetDiskSpace = TotalBytes * 10000
      
      End If  'if GetDiskFreeSpaceEx
   
   Else
   
     'get drive info using GetDiskFreeSpace
      If GetDiskFreeSpace(sDrive, nSectors, _
                          nBytesPerSector, _
                          nFreeClusters, _
                          nTotalClusters) <> 0 Then
   
        'perform math to get the data
         On Local Error Resume Next
         GetDiskSpace = (nSectors * nBytesPerSector * nTotalClusters)
         On Local Error GoTo 0
     
     End If  'if GetDiskFreeSpace
   End If  'If ptr
   
End Function


Private Function GetDiskSpaceFree(sDrive As String) As Currency

  'for GetDiskFreeSpaceEx
   Dim BytesFree As Currency
   Dim TotalBytes As Currency
   Dim TotalBytesFree As Currency
   Dim TotalBytesUsed As Currency
   
  'for GetDiskFreeSpace
   Dim nSectors As Long
   Dim nBytesPerSector As Long
   Dim nFreeClusters As Long
   Dim nTotalClusters As Long
     
  'for GetProcAddress
   Dim ptr As Long
  
  'attempt to obtain a pointer to
  'the GetDiskFreeSpaceExA API in kernel32
   ptr = GetProcAddress(GetModuleHandle("kernel32.dll"), "GetDiskFreeSpaceExA")
  
   If ptr Then

     'get drive info using GetDiskFreeSpaceEx
      If GetDiskFreeSpaceEx(sDrive, _
                            BytesFree, _
                            TotalBytes, _
                            TotalBytesFree) <> 0 Then
      
        'adjust the by multiplying the returned
        'value by 10000 accommodate for the decimal
        'places the currency data type returns.
         GetDiskSpaceFree = TotalBytesFree * 10000
      
      End If  'if GetDiskFreeSpaceEx
   
   Else
   
     'get drive info using GetDiskFreeSpace
      If GetDiskFreeSpace(sDrive, _
                          nSectors, _
                          nBytesPerSector, _
                          nFreeClusters, _
                          nTotalClusters) <> 0 Then
   
        'perform math to get the data
         On Local Error Resume Next
         GetDiskSpaceFree = (nSectors * nBytesPerSector * nFreeClusters)
         On Local Error GoTo 0
     
     End If  'if GetDiskFreeSpace
   End If  'If ptr

End Function


Private Function GetDiskBytesAvailable(sDrive As String) As Currency

  'for GetDiskFreeSpaceEx
   Dim BytesFree As Currency
   Dim TotalBytes As Currency
   Dim TotalBytesFree As Currency
   Dim TotalBytesUsed As Currency
   
  'for GetDiskFreeSpace
   Dim nSectors As Long
   Dim nBytesPerSector As Long
   Dim nFreeClusters As Long
   Dim nTotalClusters As Long
     
  'for GetProcAddress
   Dim ptr As Long
  
  'attempt to obtain a pointer to
  'the GetDiskFreeSpaceExA API in kernel32
   ptr = GetProcAddress(GetModuleHandle("kernel32.dll"), "GetDiskFreeSpaceExA")
  
   If ptr Then

     'get drive info using GetDiskFreeSpaceEx
      If GetDiskFreeSpaceEx(sDrive, _
                            BytesFree, _
                            TotalBytes, _
                            TotalBytesFree) <> 0 Then
      
        'adjust the by multiplying the returned
        'value by 10000 accommodate for the decimal
        'places the currency data type returns.
         GetDiskBytesAvailable = BytesFree * 10000
      
      End If  'if GetDiskFreeSpaceEx
   
   Else
   
     'get drive info using GetDiskFreeSpace
      If GetDiskFreeSpace(sDrive, _
                          nSectors, _
                          nBytesPerSector, _
                          nFreeClusters, _
                          nTotalClusters) <> 0 Then
   
        'bytes available is not returned, 
        'so return the free space instead.
         On Local Error Resume Next
         GetDiskBytesAvailable = (nSectors * nBytesPerSector * nFreeClusters)
         On Local Error GoTo 0
     
     End If  'if GetDiskFreeSpace
   End If  'If ptr
   
End Function
 Comments
Run the project, select a drive and hit the button. The drive stats returned will match those displayed in Explorer's property sheet for that drive. This code should also provide the correct results on a non-Fat32 drive as well, though is untested here.

 
 

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