HOWTO:取得剩余空间最大的逻辑磁盘驱动器

当我们的软件需要在磁盘上建立一个或多个历史存储文档或文件夹时，我们当然希望充分利用系统的逻辑磁盘资源，即把这些临时文档存储到剩余空间最大的本地驱动器中（最典范的有 Office 的安装程序），通过 GetDiskFreeSpace()， GetLogicalDriveStrings() 和 GetDriveType() WinAPI函数我们编写出下面的函数可以帮助检测并返回剩余空间最大的逻辑磁盘驱动器。

Option Explicit

Public Const DRIVE_FIXED = 3 '本地磁盘驱动器

Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA"  _
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long , _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Any) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias  _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal  nDrive _
As String) As Long

Public Function GetLargeDrive() Function GetLargeDrive() As String
    
    GetLargeDrive = Chr(0) '//设定函数返回的初始值
    
    On Error GoTo ErrExit

    Dim lFreeSize As Long, sLargeDrive As String
    Dim sDriveRoot As String, sBufferA As String * 105
    Dim hDriveStrLen As Long, sBufferB As String, j As Integer
    Dim lSectorsPerCluster As Long, lBytesPerSector As Long, lNumberOfFreeClusters As Long
    
    lFreeSize = -1: sLargeDrive = Chr(0)
    hDriveStrLen = GetLogicalDriveStrings(Len(sBufferA), sBufferA)
    
    '/*我们假设存在的盘符为 A~Z 共26个,由于返回格式为 A:Chr(0)B:Chr(0)....Z:Chr(0)Chr(0)
    '故我们计算出缓冲区的最大尺寸为 4*26+1=105,若返回值大于105说明有 AB: 等盘符存在,不予讨论*/
    
    If hDriveStrLen < 105 And hDriveStrLen <> 0 Then
        sBufferB = Left$(sBufferA, hDriveStrLen)
        For j = 1 To hDriveStrLen Step 4
            sDriveRoot = Mid$(sBufferB, j, 3)
            If GetDriveType(sDriveRoot) = DRIVE_FIXED Then
                If GetDiskFreeSpace(sDriveRoot, lSectorsPerCluster, lBytesPerSector, _
                lNumberOfFreeClusters, 0&) <> 0 Then
                    If lSectorsPerCluster * lBytesPerSector * _
            lNumberOfFreeClusters > lFreeSize Then
                        lFreeSize = lSectorsPerCluster * lBytesPerSector * lNumberOfFreeClusters
                        sLargeDrive = sDriveRoot
                    End If
                End If
            End If
        Next
        If lFreeSize <> -1 And sLargeDrive <> Chr(0) Then GetLargeDrive = sLargeDrive
    End If

ErrExit:

End Function

对函数的引用部分，我们在剩余空间最大的逻辑磁盘驱动器的根目录下创建一个名为 "CW&WYC" 的文本文件，并写入 "CW Love WYC!"

Sub Main() Sub Main()
    Dim sDrive As String: sDrive = GetLargeDrive()
    On Error Resume Next
    Open sDrive & "CW&WYC.TXT" For Output Access Write As #1
        Print #1, "CW Love WYC!";
    Close #1
    If Dir(sDrive & "CW&WYC.TXT") <> "" Then MsgBox Replace$("建立了新文档" & _
    " %jmouse% 并写入以下内容:" & vbNewLine & "CW Love WYC!", "%jmouse%", sDrive & _
    "CW&WYC.TXT"), vbInformation, "LoVE"
End Sub