| Prerequisites |
| Windows OSR2, Windows 98, Windows NT or Windows 2000,
Windows XP. |
|
 The
routine presented here will return the correct free and used disk sizes on volumes over 2 gigabytes as supported by the FAT32 partitions
implemented in Windows95 OEM Service Pack 2, aka OSR2, and in Windows 98 where the Fat32 drive conversion has been made, or on NTFS
partitions on NT4, Windows 2000 and Windows XP.
OSR2 was initially provided only to OEMs who pre-installed the
Windows 95 platform on manufactured machines, and was initially not generally available as a release version to the public. Windows 95 OSR2
was eventually released as a public upgrade with Win95b. But regardless how the OS was installed, application developers need to
account for those users who run OSR2 where the drive/space methods using GetDiskFreeSpace will return incorrect values. The
GetDiskFreeSpaceEx API shown here correctly returns the file sizes on drives or volumes over 2 gigabytes, the previous GetDiskFreeSpace
limit.
Construct a form like the one shown with two command buttons
(Command1 and Command2) and a combo box (Combo1). |
|
| BAS
Module Code |
|
| Place the following code into the general declarations
area of a bas module: |
|
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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long/font> |
|
| Form
Code |
|
| Add the following code to the form containing a combo
(Combo1), and two command buttons (Command1 & Command2): |
|
Option Explicit
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command1_Click()
Dim BytesFreeToCalller As Currency
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
Dim TotalBytesUsed As Currency
Dim RootPathName As String
'the drive to find
RootPathName = Combo1.List(Combo1.ListIndex)
'get the drive's disk parameters
Call GetDiskFreeSpaceEx(RootPathName, _
BytesFreeToCalller, _
TotalBytes, _
TotalFreeBytes)
'show the results, multiplying the returned
'value by 10000 to adjust for the 4 decimal
'places that the currency data type returns.
Cls
Print
Print " Total Number Of Bytes:", _
Format$(TotalBytes * 10000, "###,###,###,##0") & " bytes"
Print " Total Free Bytes:", _
Format$(TotalFreeBytes * 10000, "###,###,###,##0") & " bytes"
Print " Free Bytes Available:", _
Format$(BytesFreeToCalller * 10000, "###,###,###,##0") & " bytes"
Print " Total Space Used :", _
Format$((TotalBytes - TotalFreeBytes) * 10000, "###,###,###,##0") & " bytes"
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
LoadAvailableDrives Combo1
Combo1.ListIndex = 1
End Sub
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 GetDriveString() As String
'returns string of available
'drives each separated by a null
Dim sBuffer As String
'possible 26 drives, three characters each, plus trailing null
sBuffer = Space$(26 * 4)
If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then
'do not trim off trailing null!
GetDriveString = Trim$(sBuffer)
End If
End Function
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 |
|
| Comments |
| Run the project, select a drive and hit the
button. The drive stats matching that shown in the same drives property sheet will be displayed. This code also provides the correct
results on a standard FAT16 drive, assuming the operating system supports the call, as well as on NTFS partitions. |
|
