|
|
|
|
|
|
|
|
|
|
|
 |
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
| 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. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
 |
