Get Available Drivespace with VB6

By | 2012-11-25

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

Author: dwirch

Derek Wirch is a seasoned IT professional with an impressive career dating back to 1986. He brings a wealth of knowledge and hands-on experience that is invaluable to those embarking on their journey in the tech industry.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.