VBA操作檔案四大方法之之四-API函式
阿新 • • 發佈：2019-01-29
3、GetDiskFreeSpaceEx
作用：獲取與一個磁碟的組織以及剩餘空間容量有關的資訊
宣告：Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As LARGE_INTEGER, lpTotalNumberOfBytes As LARGE_INTEGER, lpTotalNumberOfFreeBytes As LARGE_INTEGER) As Long
說明：此函式的返回值型別為Long，非零表示成功，零表示失敗。會設定GetLastError.
在採用FAT16格式的windows95系統中，如一個驅動器（分割槽）的容量超過了2GB，則不應使用這個函式。此時，這個函式能識別的最大分割槽容量只有2GB
引數說明：
lpRootPathName String，不包括卷名的磁碟根路徑名
lpFreeBytesAvailableToCaller LARGE_INTEGER，指定一個變數，用於容納呼叫者可用的位元組數量
lpTotalNumberOfBytes LARGE_INTEGER，指定一個變數，用於容納磁碟上的總位元組數
lpTotalNumberOfFreeBytes LARGE_INTEGER，指定一個變數，用於容納磁碟上可用的位元組數
LARGE_INTEGER結構用來代表一個64位帶符號的整數值，它的定義如下：
Type LARGE_INTEGER ' 8 Bytes
lowpart As Long
highpart As Long
End Type
其中lowpart為 Long，指定低32位,highpart 為 Long，指定高32位。
示例：雖然此函式能識別的最大分割槽容量只有2GB，但通過調整，對大於2G的仍然能得出正確容量。以下的調整公式是本人通過逆向推算出來的，至於其中的原理也不是很清楚，大家可一測試一下。
Private Sub Get_DiskFreeSpaceEx()
Dim temp As Long, Dms$
Dim tempa, tempb, tempc
Dim RootPathName As String
Dim FreeBytesAvailabletoCaller As LARGE_INTEGER
Dim TotalNumberOfBytes As LARGE_INTEGER
Dim TotalNumberOfFreeBytes As LARGE_INTEGER
RootPathName = "d:"
'取得磁碟空間
temp = GetDiskFreeSpaceEx(RootPathName, FreeBytesAvailabletoCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes)
Dms = Dms + "磁碟容量:" + vbCrLf
tempa = TotalNumberOfBytes.highpart * 2 ^ 32 + IIf(TotalNumberOfBytes.lowpart > 0, _
TotalNumberOfBytes.lowpart, TotalNumberOfBytes.lowpart + 2 ^ 32) '計算容量
Dms = Dms + CStr(tempa) + "位元組" + vbCrLf
tempa = Format(tempa / 1024 / 1024 / 1024, "0.00")
Dms = Dms + tempa + "G" + vbCrLf
'取得磁碟可用空間
Dms = Dms + "磁碟可用空間:" + vbCrLf
tempb = TotalNumberOfFreeBytes.highpart * 2 ^ 32 + IIf(TotalNumberOfFreeBytes.lowpart > 0, TotalNumberOfFreeBytes.lowpart, TotalNumberOfFreeBytes.lowpart + 2 ^ 32) '計算
Dms = Dms + CStr(tempb) + "位元組" + vbCrLf
tempb = Format(tempb / 1024 / 1024 / 1024, "0.00")
Dms = Dms + tempb + "G" + vbCrLf
'取得磁碟已用空間
Dms = Dms + "磁碟已用空間:" + vbCrLf
tempc = tempa - tempb
Dms = Dms + CStr(tempc) + "G" + vbCrLf
MsgBox Dms
End Sub
作用：獲取與一個磁碟的組織以及剩餘空間容量有關的資訊
宣告：Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As LARGE_INTEGER, lpTotalNumberOfBytes As LARGE_INTEGER, lpTotalNumberOfFreeBytes As LARGE_INTEGER) As Long
說明：此函式的返回值型別為Long，非零表示成功，零表示失敗。會設定GetLastError.
在採用FAT16格式的windows95系統中，如一個驅動器（分割槽）的容量超過了2GB，則不應使用這個函式。此時，這個函式能識別的最大分割槽容量只有2GB
引數說明：
lpRootPathName String，不包括卷名的磁碟根路徑名
lpFreeBytesAvailableToCaller LARGE_INTEGER，指定一個變數，用於容納呼叫者可用的位元組數量
lpTotalNumberOfBytes LARGE_INTEGER，指定一個變數，用於容納磁碟上的總位元組數
lpTotalNumberOfFreeBytes LARGE_INTEGER，指定一個變數，用於容納磁碟上可用的位元組數
LARGE_INTEGER結構用來代表一個64位帶符號的整數值，它的定義如下：
Type LARGE_INTEGER ' 8 Bytes
lowpart As Long
highpart As Long
End Type
其中lowpart為 Long，指定低32位,highpart 為 Long，指定高32位。
示例：雖然此函式能識別的最大分割槽容量只有2GB，但通過調整，對大於2G的仍然能得出正確容量。以下的調整公式是本人通過逆向推算出來的，至於其中的原理也不是很清楚，大家可一測試一下。
Private Sub Get_DiskFreeSpaceEx()
Dim temp As Long, Dms$
Dim tempa, tempb, tempc
Dim RootPathName As String
Dim FreeBytesAvailabletoCaller As LARGE_INTEGER
Dim TotalNumberOfBytes As LARGE_INTEGER
Dim TotalNumberOfFreeBytes As LARGE_INTEGER
RootPathName = "d:"
'取得磁碟空間
temp = GetDiskFreeSpaceEx(RootPathName, FreeBytesAvailabletoCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes)
Dms = Dms + "磁碟容量:" + vbCrLf
tempa = TotalNumberOfBytes.highpart * 2 ^ 32 + IIf(TotalNumberOfBytes.lowpart > 0, _
TotalNumberOfBytes.lowpart, TotalNumberOfBytes.lowpart + 2 ^ 32) '計算容量
Dms = Dms + CStr(tempa) + "位元組" + vbCrLf
tempa = Format(tempa / 1024 / 1024 / 1024, "0.00")
Dms = Dms + tempa + "G" + vbCrLf
'取得磁碟可用空間
Dms = Dms + "磁碟可用空間:" + vbCrLf
tempb = TotalNumberOfFreeBytes.highpart * 2 ^ 32 + IIf(TotalNumberOfFreeBytes.lowpart > 0, TotalNumberOfFreeBytes.lowpart, TotalNumberOfFreeBytes.lowpart + 2 ^ 32) '計算
Dms = Dms + CStr(tempb) + "位元組" + vbCrLf
tempb = Format(tempb / 1024 / 1024 / 1024, "0.00")
Dms = Dms + tempb + "G" + vbCrLf
'取得磁碟已用空間
Dms = Dms + "磁碟已用空間:" + vbCrLf
tempc = tempa - tempb
Dms = Dms + CStr(tempc) + "G" + vbCrLf
MsgBox Dms
End Sub