FreeSpaceDsk

' 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

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