当我们的软件需要在磁盘上建立一个或多个历史存储文档或文件夹时,我们当然希望充分利用系统的逻辑磁盘资源,即把这些临时文档存储到剩余空间最大的本地驱动器中(最典范的有 Office 的安装程序),通过
GetDiskFreeSpace(),
GetLogicalDriveStrings() 和
GetDriveType() WinAPI函数我们编写出下面的函数可以帮助检测并返回剩余空间最大的逻辑磁盘驱动器。
对函数的引用部分,我们在剩余空间最大的逻辑磁盘驱动器的根目录下创建一个名为
"CW&WYC" 的文本文件,并写入
"CW Love WYC!"
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 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
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
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
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