Get Available Drivespace with VB6

Visual Basic 6

Posted On 2012-11-25 by dwirch
Keywords:
Tags: Visual Basic 6 Scripting General  Windows
Views: 785

 

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

Comments On This Post

No comments on this post yet!

 

Do you have a thought relating to this post? You can post your comment here. If you have an unrelated question, you can use the Q&A section to ask it.

Or you can drop a note to the administrators if you're not sure where you should post.


Your IP address is:54.163.91.250

Before you can post, you need to prove you are human. If you log in, this test goes away.