Binaryworld - GetDiskFreeBytes - Determine number of free bytes on disk ... [ VB -> Windows ]

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal _
  lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
  ByVal lpProcName As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
  "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
  lpFreeBytesAvailableToCaller As Any, lpTotalNumberOfBytes As Any, _
  lpTotalNumberOfFreeBytes As Any) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
  "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
  lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
  lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

' Return the number of free bytes available to caller, total bytes available
' to caller, and total free bytes on a disk. This function supports volumes
' larger than 2G and Windows systems that supports disk quotas, where a
' user might be prevented to use all the free space on disk.
' If disk quotes aren't in use, the 1st and 3rd argument always return
' the same values.

' On entry, driveName is the name of a drive or a directory. If running on
' Windows 95 OSR2 or later versions, you can also pass a UNC path, but in this
' case you must append a backslash, as in "\\MyServer\MyShare\". If you pass
' a null string, the current drive is used.
' On exit, the three arguments you've passed receive the desired information.

' What makes this function advanced is that it is based on the
' GetDiskFreeSpaceEx API function, which is available only on Windows 95
' OSR2, Windows 98, Windows NT4 and later release. Before calling the API
' routine, this function ensures that it is available, otherwise it
' reverts to the older GetDiskFreeSpace API function.
' Another detail that makes the implementation of this function more
' difficult is that the GetDiskFreeSpaceEx routine expects pointers to
' LARGE_INTEGER structures, which aren't supported in VB. The code below
' uses Currency values, and then scales them up by 4 decimal positions.

Sub GetDiskFreeBytes(driveName As String, FreeBytesAvailableToCaller As _
  Currency, TotalBytesAvailableToCaller As Currency, _
  TotalFreeBytes As Currency)

  Dim hModule As Long, procAddr As Long, res As Long

  ' first, determine whether we can call the GetDiskFreeSpaceEx function
  hModule = LoadLibrary("kernel32.Dll")
  If hModule Then
    procAddr = GetProcAddress(hModule, "GetDiskFreeSpaceExA")
    If procAddr Then
      ' we call safely call the GetDiskFreeSpaceEx
      ' Note that instead of passing LARGE_INTEGER values, we're
      ' using Currency values (8 bytes)
      res = GetDiskFreeSpaceEx(driveName, FreeBytesAvailableToCaller, _
        TotalBytesAvailableToCaller, TotalFreeBytes)
      ' decrement Dll's usage counter (not really necessary)
      FreeLibrary hModule

      If res = 0 Then
        ' a null result means error (probably invalid drive)
        Err.Raise 5, , Err.LastDllError
      Else
        ' we must scale up the Currency by a factor of 10,000
        FreeBytesAvailableToCaller = FreeBytesAvailableToCaller * 10000
        TotalBytesAvailableToCaller = TotalBytesAvailableToCaller * _
          10000
        TotalFreeBytes = TotalFreeBytes * 10000
        Exit Sub
      End If
    End If
    ' decrement Dll's usage counter (not really necessary)
    FreeLibrary hModule
  End If

  ' if we get here, GetDiskFreeSpaceEx isn't available or raised an error
  Dim lpSectorsPerCluster As Long
  Dim lpBytesPerSector As Long
  Dim lpNumberOfFreeClusters As Long
  Dim lpTotalNumberOfClusters As Long

  res = GetDiskFreeSpace(driveName, lpSectorsPerCluster, lpBytesPerSector, _
    lpNumberOfFreeClusters, lpTotalNumberOfClusters)
  If res = 0 Then
    ' a null result means error (probably invalid drive)
    Err.Raise 5, , Err.LastDllError
  Else
    ' return result through parameters
    FreeBytesAvailableToCaller = lpNumberOfFreeClusters * _
      lpSectorsPerCluster * lpBytesPerSector
    TotalBytesAvailableToCaller = lpTotalNumberOfClusters * _
      lpSectorsPerCluster * lpBytesPerSector
    ' without quotas, this value is the same as FreeBytesAvailableToCaller
    TotalFreeBytes = FreeBytesAvailableToCaller
  End If
End Sub