mfreespace.bas

文件传送

Attribute VB_Name = "MFreeSpace"
'获取磁盘空余空间
Option Explicit

' used to determine if an API function is exported.
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

' used to determine drive freespace.
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

Public Function GetDriveFreeSpace(Optional ByVal Drive As String = "") As Variant
    ' use current drive if not specified
    If Drive = "" Then Drive = CurDir$

    ' default to zero in case drive is empty/non-existant
    GetDriveFreeSpace = CDec(0)

    ' check if enhanced function is available.
    If Exported("kernel32", "GetDiskFreeSpaceExA") Then
        Dim cAvail As Currency
        Dim cTotal As Currency
        Dim cFree As Currency
        ' return available bytes, as that's more important to know
        ' than total free bytes if they differ.
        If GetDiskFreeSpaceEx(Drive, cAvail, cTotal, cFree) Then
            GetDriveFreeSpace = CDec(cAvail * 10000)
        End If

    Else  ' enhanced function not exported.
        Dim nSecPerClus As Long
        Dim nBytPerSec As Long
        Dim nFreeClus As Long
        Dim nTotalClus As Long
        ' do the math to return total free bytes.
        If GetDiskFreeSpace(Drive, nSecPerClus, nBytPerSec, nFreeClus, nTotalClus) Then
            GetDriveFreeSpace = CDec(nSecPerClus * nBytPerSec * nFreeClus)
        End If
    End If
End Function

Public Function FormatFileSize(ByVal Size As Variant, Optional ByVal LongDisplay As Boolean = False) As String
    Dim sRet As String
    Const KB& = 1024
    Const MB& = KB * KB

    ' Return size of file in kilobytes.
    If Size < KB Then
        sRet = Format(Size, "#,##0") & " byte"
        If Size <> 1 Then sRet = sRet & "s"
    Else
        Select Case Size / KB
            Case Is < 10
                sRet = Format(Size / KB, "0.00") & " KB"
            Case Is < 100
                sRet = Format(Size / KB, "0.0") & " KB"
            Case Is < 1000
                sRet = Format(Size / KB, "0") & " KB"
            Case Is < 10000
                sRet = Format(Size / MB, "0.00") & " MB"
            Case Is < 100000
                sRet = Format(Size / MB, "0.0") & " MB"
            Case Is < 1000000
                sRet = Format(Size / MB, "0") & " MB"
            Case Is < 10000000
                sRet = Format(Size / MB / KB, "0.00") & " GB"
        End Select
    End If

    ' return more detailed string on request
    If LongDisplay Then
        If Size >= KB Then
            sRet = sRet & " (" & Format(Size, "#,##0") & " bytes)"
        End If
    End If
    FormatFileSize = sRet
End Function

Private Function Exported(ByVal ModuleName As String, ByVal ProcName As String) As Boolean
    Dim hModule As Long
    Dim lpProc As Long
    Dim FreeLib As Boolean

    ' check first to see if the module is already
    ' mapped into this process.
    hModule = GetModuleHandle(ModuleName)
    If hModule = 0 Then
        ' need to load module into this process.
        hModule = LoadLibrary(ModuleName)
        FreeLib = True
    End If

    ' if the module is mapped, check procedure
    ' address to verify it's exported.
    If hModule Then
        lpProc = GetProcAddress(hModule, ProcName)
        Exported = (lpProc <> 0)
    End If

    ' unload library if we loaded it here.
    If FreeLib Then Call FreeLibrary(hModule)
End Function