Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Advanced
Sep 4, 1999

GetDiskFreeBytes - Determine number of free bytes on disk

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
Marco Losavio
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date