Get Available Drivespace with VB6
As a developer, from time to time you are called upon to build or process large chunks of data. During this process, you can use the the local hard drive as a temporary holding area. Admittedly, with todays well-specc'd computers, you shouldn't need to do this, but back in the day, this was the norm.
By request, here is a set of API functions for use with Visual Basic 6 that will return various pieces of information about local storage, such as total space, free space, etc.
I've tried to take line wrap in to account, but watch out! I may have missed one.
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName 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 'C Bool
Private Declare Function GetDiskFreeSpaceExAsCurrency Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
(ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long 'C Bool
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpvDest As Any, _
lpvSource As Any, _
ByVal cbCopy As Long)
Public Function vbGetAvailableBytesAsString(Optional ByVal sPath As String = "") As String
Dim lo As Long, hi As Long
Dim sOut As String
If ExistGetDiskFreeSpaceEx() Then
sOut = vbGetAvailableBytesEx(sPath)
Else
sOut = CStr(vbGetAvailableBytes(sPath))
End If
vbGetAvailableBytesAsString = sOut
End Function
Public Function vbGetAvailableKBytesAsString(Optional ByVal sPath As String = "") As String
Dim bytes As Currency, kBytes As Currency
Dim sTmp As String
sTmp = vbGetAvailableBytesAsString(sPath)
bytes = CCur(sTmp)
If bytes Then 'avoid divide by 0 errors
kBytes = bytes / 1024
kBytes = Fix(kBytes)
Else
kBytes = 0
End If
vbGetAvailableKBytesAsString = CStr(kBytes)
End Function
Public Function vbGetAvailableMBytesAsString(Optional ByVal sPath As String = "") As String
Dim kBytes As Currency, mBytes As Currency
Dim sTmp As String
sTmp = vbGetAvailableKBytesAsString(sPath)
kBytes = CCur(sTmp)
If kBytes Then 'avoid divide by 0 errors
mBytes = kBytes / 1024
mBytes = Fix(mBytes)
Else
mBytes = 0
End If
vbGetAvailableMBytesAsString = CStr(mBytes)
End Function
Public Function vbGetTotalBytesAsString(Optional ByVal sPath As String = "") As String
Dim lo As Long, hi As Long
Dim sOut As String
If ExistGetDiskFreeSpaceEx() Then
sOut = vbGetTotalBytesEx(sPath)
Else
sOut = CStr(vbGetTotalBytes(sPath))
End If
vbGetTotalBytesAsString = sOut
End Function
Public Function vbGetTotalKBytesAsString(Optional ByVal sPath As String = "") As String
Dim numbytes As Currency, kBytes As Currency
Dim sTmp As String
sTmp = vbGetTotalBytesAsString(sPath)
numbytes = CCur(sTmp)
If numbytes Then 'avoid divide by 0 errors
kBytes = numbytes / 1024
kBytes = Fix(kBytes)
Else
kBytes = 0
End If
vbGetTotalKBytesAsString = CStr(kBytes)
End Function
Public Function vbGetTotalMBytesAsString(Optional ByVal sPath As String = "") As String
Dim kBytes As Currency, mBytes As Currency
Dim sTmp As String
sTmp = vbGetTotalKBytesAsString(sPath)
kBytes = CCur(sTmp)
If kBytes Then 'avoid divide by 0 errors
mBytes = kBytes / 1024
mBytes = Fix(mBytes)
Else
mBytes = 0
End If
vbGetTotalMBytesAsString = CStr(mBytes)
End Function
Public Function ExistGetDiskFreeSpaceEx() As Boolean
Dim hInst As Long
Dim procAddress As Long
hInst = LoadLibrary("kernel32.dll")
If hInst Then
procAddress = GetProcAddress(hInst, "GetDiskFreeSpaceExA")
Call FreeLibrary(hInst)
End If
ExistGetDiskFreeSpaceEx = CBool(procAddress)
End Function
Private Function vbGetAvailableBytesEx(ByVal sPath As String) As String
Dim BytesAvailable As Currency
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
Dim tmp As Currency
On Error GoTo APIfailed
If "" = sPath Then
Call GetDiskFreeSpaceExAsCurrency(vbNullString, BytesAvailable, TotalBytes, TotalFreeBytes)
Else
Call GetDiskFreeSpaceExAsCurrency(sPath, BytesAvailable, TotalBytes, TotalFreeBytes)
End If
'If BytesAvailable Then
BytesAvailable = BytesAvailable * 10000
vbGetAvailableBytesEx = CStr(BytesAvailable)
'End If
Exit Function
APIfailed:
'returns false
Debug.Print "GetDiskFreeSpaceEx() API Failed!"
End Function
Private Function vbGetTotalBytesEx(ByVal sPath As String) As String
Dim BytesAvailable As Currency
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
On Error GoTo APIfailed
If "" = sPath Then
Call GetDiskFreeSpaceExAsCurrency(vbNullString, BytesAvailable, TotalBytes, TotalFreeBytes)
Else
Call GetDiskFreeSpaceExAsCurrency(sPath, BytesAvailable, TotalBytes, TotalFreeBytes)
End If
If TotalBytes Then
TotalBytes = TotalBytes * 10000
Else
TotalBytes = 0
End If
vbGetTotalBytesEx = CStr(TotalBytes)
Exit Function
APIfailed:
'returns false
Debug.Print "GetDiskFreeSpaceEx() API Failed!"
End Function
Private Function vbGetAvailableBytes(ByVal sPath As String) As Long
Dim lSpc As Long 'sectors per cluster
Dim lBps As Long 'bytes per sector
Dim lNfc As Long 'number of free clusters
Dim lTnc As Long 'total number of clusters
Call GetDiskFreeSpace(sPath, lSpc, lBps, lNfc, lTnc)
vbGetAvailableBytes = lSpc * lBps * lNfc
End Function
Private Function vbGetTotalBytes(ByVal sPath As String) As Long
Dim lSpc As Long 'sectors per cluster
Dim lBps As Long 'bytes per sector
Dim lNfc As Long 'number of free clusters
Dim lTnc As Long 'total number of clusters
Call GetDiskFreeSpace(sPath, lSpc, lBps, lNfc, lTnc)
vbGetTotalBytes = lSpc * lBps * lTnc
End Function
Public Function vbGetPercentAvailable(Optional ByVal sPath As String = "") As Long
Dim freeEX As Currency
Dim totalEX As Currency
Dim availEX As Currency
Dim percent As Long
On Error Resume Next 'if API fails there will be divide by zero errors
If ExistGetDiskFreeSpaceEx() Then
If "" = sPath Then
Call GetDiskFreeSpaceExAsCurrency(vbNullString, availEX, totalEX, freeEX)
Else
Call GetDiskFreeSpaceExAsCurrency(sPath, availEX, totalEX, freeEX)
End If
Else
totalEX = vbGetTotalBytes(sPath)
availEX = vbGetAvailableBytes(sPath)
End If
totalEX = totalEX * 10000
availEX = availEX * 10000
percent = (availEX * 100) / totalEX
vbGetPercentAvailable = percent
End Function
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.