Account Login Username:
Active Server Pages Coding Standards Complete Applications Custom Controls/Forms/Menus Data Structures Databases/Data Access/DAO/ADO DDE Debugging and Error Handling DirectX Encryption Files/File Controls/Input/Output Games Graphics Internet/HTML Jokes/Humor Libraries Math/Dates Microsoft Office Apps/VBA Miscellaneous Object Oriented Programming (OOP) OLE/COM/DCOM/Active-X Registry Sound/MP3 String Manipulation VB function enhancement Windows API Call/Explanation Windows CE Windows System Services
by Telefon (2 Submissions) Category: Files/File Controls/Input/OutputCompatability: VB 6.0Difficulty: Beginner Date Added: Fri 12th February 2021 Rating: (0 Votes)
As a developer, from time to time you are called upon to build orprocess large chunks of data. During this process, you can use the thelocal hard drive as a temporary holding area. Admittedly, with today'swell-specc'd computers, you shouldn't need to do this, but back in theday, this was the norm.
Option ExplicitPrivate Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _(ByVal lpLibFileName As String) As LongPrivate Declare Function FreeLibrary Lib "kernel32" _(ByVal hLibModule As Long) As LongPrivate Declare Function GetProcAddress Lib "kernel32" _(ByVal hModule As Long, ByVal lpProcName As String) As LongPrivate 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 BoolPrivate Declare Function GetDiskFreeSpaceExAsCurrency Lib "kernel32" Alias "GetDiskFreeSpaceExA" _(ByVal lpDirectoryName As String, _lpFreeBytesAvailableToCaller As Currency, _lpTotalNumberOfBytes As Currency, _lpTotalNumberOfFreeBytes As Currency) As Long 'C BoolPrivate 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 StringDim lo As Long, hi As LongDim sOut As StringIf ExistGetDiskFreeSpaceEx() ThensOut = vbGetAvailableBytesEx(sPath)ElsesOut = CStr(vbGetAvailableBytes(sPath))End IfvbGetAvailableBytesAsString = sOutEnd FunctionPublic Function vbGetAvailableKBytesAsString(Optional ByVal sPath As String = "") As StringDim bytes As Currency, kBytes As CurrencyDim sTmp As StringsTmp = vbGetAvailableBytesAsString(sPath)bytes = CCur(sTmp)If bytes Then 'avoid divide by 0 errorskBytes = bytes / 1024kBytes = Fix(kBytes)ElsekBytes = 0End IfvbGetAvailableKBytesAsString = CStr(kBytes)End FunctionPublic Function vbGetAvailableMBytesAsString(Optional ByVal sPath As String = "") As StringDim kBytes As Currency, mBytes As CurrencyDim sTmp As StringsTmp = vbGetAvailableKBytesAsString(sPath)kBytes = CCur(sTmp)If kBytes Then 'avoid divide by 0 errorsmBytes = kBytes / 1024mBytes = Fix(mBytes)ElsemBytes = 0End IfvbGetAvailableMBytesAsString = CStr(mBytes)End FunctionPublic Function vbGetTotalBytesAsString(Optional ByVal sPath As String = "") As StringDim lo As Long, hi As LongDim sOut As StringIf ExistGetDiskFreeSpaceEx() ThensOut = vbGetTotalBytesEx(sPath)ElsesOut = CStr(vbGetTotalBytes(sPath))End IfvbGetTotalBytesAsString = sOutEnd FunctionPublic Function vbGetTotalKBytesAsString(Optional ByVal sPath As String = "") As StringDim numbytes As Currency, kBytes As CurrencyDim sTmp As StringsTmp = vbGetTotalBytesAsString(sPath)numbytes = CCur(sTmp)If numbytes Then 'avoid divide by 0 errorskBytes = numbytes / 1024kBytes = Fix(kBytes)ElsekBytes = 0End IfvbGetTotalKBytesAsString = CStr(kBytes)End FunctionPublic Function vbGetTotalMBytesAsString(Optional ByVal sPath As String = "") As StringDim kBytes As Currency, mBytes As CurrencyDim sTmp As StringsTmp = vbGetTotalKBytesAsString(sPath)kBytes = CCur(sTmp)If kBytes Then 'avoid divide by 0 errorsmBytes = kBytes / 1024mBytes = Fix(mBytes)ElsemBytes = 0End IfvbGetTotalMBytesAsString = CStr(mBytes)End FunctionPublic Function ExistGetDiskFreeSpaceEx() As BooleanDim hInst As LongDim procAddress As LonghInst = LoadLibrary("kernel32.dll")If hInst ThenprocAddress = GetProcAddress(hInst, "GetDiskFreeSpaceExA")Call FreeLibrary(hInst)End IfExistGetDiskFreeSpaceEx = CBool(procAddress)End FunctionPrivate Function vbGetAvailableBytesEx(ByVal sPath As String) As StringDim BytesAvailable As CurrencyDim TotalBytes As CurrencyDim TotalFreeBytes As CurrencyDim tmp As CurrencyOn Error GoTo APIfailedIf "" = sPath ThenCall GetDiskFreeSpaceExAsCurrency(vbNullString, BytesAvailable, TotalBytes, TotalFreeBytes)ElseCall GetDiskFreeSpaceExAsCurrency(sPath, BytesAvailable, TotalBytes, TotalFreeBytes)End If'If BytesAvailable ThenBytesAvailable = BytesAvailable * 10000vbGetAvailableBytesEx = CStr(BytesAvailable)'End IfExit FunctionAPIfailed:'returns falseDebug.Print "GetDiskFreeSpaceEx() API Failed!"End FunctionPrivate Function vbGetTotalBytesEx(ByVal sPath As String) As StringDim BytesAvailable As CurrencyDim TotalBytes As CurrencyDim TotalFreeBytes As CurrencyOn Error GoTo APIfailedIf "" = sPath ThenCall GetDiskFreeSpaceExAsCurrency(vbNullString, BytesAvailable, TotalBytes, TotalFreeBytes)ElseCall GetDiskFreeSpaceExAsCurrency(sPath, BytesAvailable, TotalBytes, TotalFreeBytes)End IfIf TotalBytes ThenTotalBytes = TotalBytes * 10000ElseTotalBytes = 0End IfvbGetTotalBytesEx = CStr(TotalBytes)Exit FunctionAPIfailed:'returns falseDebug.Print "GetDiskFreeSpaceEx() API Failed!"End FunctionPrivate Function vbGetAvailableBytes(ByVal sPath As String) As LongDim lSpc As Long 'sectors per clusterDim lBps As Long 'bytes per sectorDim lNfc As Long 'number of free clustersDim lTnc As Long 'total number of clustersCall GetDiskFreeSpace(sPath, lSpc, lBps, lNfc, lTnc)vbGetAvailableBytes = lSpc * lBps * lNfcEnd FunctionPrivate Function vbGetTotalBytes(ByVal sPath As String) As LongDim lSpc As Long 'sectors per clusterDim lBps As Long 'bytes per sectorDim lNfc As Long 'number of free clustersDim lTnc As Long 'total number of clustersCall GetDiskFreeSpace(sPath, lSpc, lBps, lNfc, lTnc)vbGetTotalBytes = lSpc * lBps * lTncEnd FunctionPublic Function vbGetPercentAvailable(Optional ByVal sPath As String = "") As LongDim freeEX As CurrencyDim totalEX As CurrencyDim availEX As CurrencyDim percent As LongOn Error Resume Next 'if API fails there will be divide by zero errorsIf ExistGetDiskFreeSpaceEx() ThenIf "" = sPath ThenCall GetDiskFreeSpaceExAsCurrency(vbNullString, availEX, totalEX, freeEX)ElseCall GetDiskFreeSpaceExAsCurrency(sPath, availEX, totalEX, freeEX)End IfElsetotalEX = vbGetTotalBytes(sPath)availEX = vbGetAvailableBytes(sPath)End IftotalEX = totalEX * 10000availEX = availEX * 10000percent = (availEX * 100) / totalEXvbGetPercentAvailable = percentEnd Function
Download this snippet Add to My Saved Code
No comments have been posted about Get Available Drive Space. Why not be the first to post a comment about Get Available Drive Space.
0/1000 characters