Question

VB6中如何获取磁盘信息？

要求用VB6获得各个分区的大小、已用空间、剩余空间。注意要VB6不要VB.NET。如果答案可用，追100分感谢！
1楼的：GetDriveTypeA找不到入口点

Answer 1

楼上的朋友可能有点小小的误会楼主的意思了，

楼主朋友可能要现在已经分好区的空间大小，已用空间、剩余空间。

当然我也不敢保证谁对谁错，

我还是把我的理解 然后 也把代码贴出来让楼主看看吧

下面代码的功能：显示光驱当前分区，以及各个盘的总空间，剩余空间。
当然。如果要硬盘总空间，我们可以把所有空间加起来，就达到要求了。

希望下面的代码对楼主有用！

'硬盘空间大小 以及光驱

'添加Drive1 Label1 Label2

Private 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
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Const DRIVE_CDROM = 5
Public drivenm As String, cddrive As String

Private Sub Form_Load()
'查找CD-ROM的驱动器号
cddrive = ""
For i = 65 To 90
If GetDriveType(Chr$(i) & ":\") = DRIVE_CDROM Then
cddrive = UCase(Chr$(i)) & ":\"
Exit For
End If
Next i
drivenm = "c:"
Label1.AutoSize = True
Label2.AutoSize = True
Drive1.Left = (Me.Width - Drive1.Width) \ 2
Drive1.Drive = "c"
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
gethd
End Sub

Private Sub Form_Activate()
MsgBox "你的光驱在:" & cddrive
End Sub

Private Sub Drive1_Change()
drivenm = Mid(Drive1.Drive, 1, 3)
gethd
End Sub

Private Sub gethd() '得知硬盘容量
On Error Resume Next
Dim dfs&, cl1&, cl2&, sec1&, byt1&, tspace&, getdiskvolm&, lSize&, kk%
Dim hdtype$, hdspace$, hdfspace$

dfs = GetDiskFreeSpace(drivenm, sec1, byt1, cl1, cl2)
If dfs Then
cl2 = Int(cl2 * sec1 / 1024 * byt1)
lSize = Len(Format$(cl2, "#########"))
If lSize < 11 Then
kk = 11 - lSize
End If
hdspace = Space(kk) + Format$(cl2, "#########") + " KBytes"

cl1 = Int(cl1 * sec1 / 1024 * byt1)
lSize = Len(Format$(cl1, "#########"))
If lSize < 11 Then
kk = 11 - lSize
End If
hdfspace = Space(kk) + Format$(cl1, "#########") + " KBytes"
Else
hdspace = ""
hdfspace = ""
End If
Label1.Caption = "你的" & drivenm & "盘的总空间是:" & Format(Str(Val(hdspace) / 1024 / 1024), "##0.0") + " G"
Label2.Caption = "你的" & drivenm & "盘剩余空间是:" & Format(Str(Val(hdfspace) / 1024), "###,##0.0") + " M"
If UCase(Left(Drive1.Drive, 2)) = UCase(Left(cddrive, 2)) Then
If Val(Label1.Caption) = 0 And Val(Label2.Caption) = 0 Then
MsgBox "这张盘是空的光盘"
Else
If Val(Label1.Caption) > 0 And Val(Label2.Caption) > 0 Then
MsgBox "这张盘不是空的光盘,但还有空间"
Else
If Val(Label1.Caption) > 0 And Val(Label2.Caption) = 0 Then
MsgBox "这张盘是写满并终止的光盘"
End If
End If
End If
End If
End Sub

Answer 2

许你并不了解硬盘分区信息应该包括些什么，但如果你曾经对硬盘分过区，你或许对此有所了解，在此为各位介绍一个用VB编写的获取硬盘分区信息的程序。在这个程序中，它将详细地告诉你：你的硬盘总容量、分过几个区、每个区的总容量、及现在剩余的可用容量、硬盘分区表为几位（即是FAT32还是FAT16），每个分区是几个字节……怎么样？够完整详细了吧！好的，就让我们一起来看一下吧：
首先做准备工作：在FORM1上新建二个LABEL(LABEL1和LABEL2)一个COMMAND1命令按钮。然后输入以下代码：
Private Declare Function GetDriveType Lib
kernel32“Alias "GetDriveTypeA(ByVal nDrive As String) As Long
Private 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
Private Const DRIVE_FIXED = 3
Private Sub Form_Load() ‘作初始化设置
COMMAND1.Caption = “测试硬盘"
Form1.Caption = “测试硬盘程序"
Label1.WordWrap = True
Label1.Caption = “"
Label2.WordWrap = True
Label2.Caption = “"
End Sub
Private Sub COMMAND1_Click()
Dim DriveNum As Integer
Dim TempDrive As String
Dim X As Long
For DriveNum = 97 To 122 Step 1 ‘检测从A－Z（盘符）
TempDrive = GetDriveType(Chr(DriveNum) ＆ “:\")
Select Case TempDrive ‘如是3则表示是硬盘，测试你有几个盘
Case 3: X = GetDiskSpace(Chr(DriveNum)) ‘调用子程序
End Select
Next DriveNum
End Sub
Public Function GetDiskSpace(DrivePath As String)
Dim Drive As String
Dim SectorsPerCluster As Long
Dim BytesPerSector As Long
Dim NumberOfFreeClusters As Long
Dim TotalClusters As Long
Dim Check As Integer
Dim DiskSpace
Dim diskTotal
Static AllDiskTotal As Long
Static NUM As Integer
NUM = NUM ＋ 1 ‘分几个区的计算
Drive = Left(Trim(DrivePath), 1) ＆ “:\"
Check = GetDiskFreeSpace(Drive, SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalClusters)
If Check <> 0 Then
DiskSpace = SectorsPerCluster ＊ BytesPerSector ＊ NumberOfFreeClusters
‘这是一个分区磁盘剩余空间的计算公式
DiskSpace = Format＄(DiskSpace, “＃＃＃,＃＃＃") ‘以规定格式显示，如732，324，231
diskTotal = SectorsPerCluster ＊ BytesPerSector ＊ TotalClusters
‘这是一个分区磁盘总容量的计算公式
diskTotal = Format＄(diskTotal, “＃＃＃,＃＃＃")
AllDiskTotal = AllDiskTotal ＋ diskTotal ‘整个硬盘的总容量
Label1.Caption =“你的硬盘总容量为:” ＆ Format＄(AllDiskTotal,“＃＃＃,＃＃＃") ＆个字节,即:” ＆ Left(AllDiskTotal, 1) ＆ . ＆ Mid(AllDiskTotal, 2, 1) ＆“G,一共分了”＆ NUM ＆“个区,其中:"
Label2.Caption = Label2.Caption ＆ UCase(DrivePath) ＆ “盘的整个容量为:" ＆ diskTotal ＆“个字节" ＆ ",其剩余磁盘空间为:“＆ DiskSpace ＆ " 个字节,磁盘已FAT“＆ SectorsPerCluster ＆ ",每个分区为:“＆ BytesPerSector ＆ "个字节。“＆ vbCrLf ＆ vbCrLf”
End If
End Function
OK！现在你运行一下，你是否满意它？
注：以上程序在中文WINDOWS98，中文VB6.0企业版中调试通过。

Answer 3

本代码避免普通统计不准备的做法，统计结果准确。
复制下面代码，运行即可。

Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private 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

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

Private Sub Form_Load()
Dim userbytes As LARGE_INTEGER ' 目前 User 可用磁盘空间
Dim totalbytes As LARGE_INTEGER ' 磁盘总空间
Dim freebytes As LARGE_INTEGER ' 磁盘剩余总空间
Dim retval As Long ' 的返回值
Dim mUserBytes As Double, mTotalBytes As Double, mFreeBytes As Double
Dim ctlNew As Control
Dim t As Double, i As Integer, DriveName As String, S As String

Set ctlNew = Me.Controls.Add("VB.drivelistbox", "cmdNew", Me)
With ctlNew
For i = 0 To .ListCount - 1 '枚举所有盘符
DriveName = Left(.List(i), InStr(.List(i), ":"))
If GetDriveType(DriveName) = 3 Then '如果是硬盘盘符
retval = GetDiskFreeSpaceEx(DriveName & "\", userbytes, totalbytes, freebytes)
mTotalBytes = (totalbytes.highpart * (16 ^ 8) + totalbytes.lowpart + IIf(totalbytes.lowpart < 0, (16 ^ 8), 0)) / 2 ^ 30
mUserBytes = (userbytes.highpart * (16 ^ 8) + userbytes.lowpart + IIf(userbytes.lowpart < 0, (16 ^ 8), 0)) / 2 ^ 30
If Fix(mTotalBytes) <> mTotalBytes Then mTotalBytes = Fix(mTotalBytes) + 1
S = S & DriveName & "总空间" & Format(mTotalBytes, "#,###G") _
& " 可用空间" & Format(mUserBytes, "#,###.##G") _
& " 剩余空间 " & Format(mTotalBytes - mUserBytes, "#,###.##G") & vbNewLine
t = t + mTotalBytes
End If
Next
End With
S = S & "磁盘总空间：" & Format(t, "#,###G")
MsgBox S, vbInformation, "磁盘空间统计"
Controls.Remove ctlNew
End
End Sub

Answer 4

Option Explicit

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long

Private Sub command1_Click()
Dim r As Long
Dim BytesFreeToCalller As Currency
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
Dim TotalBytesUsed As Currency
Dim RootPathName As String
Dim DiskName As String

RootPathName = Drive1.Drive
RootPathName = Mid(RootPathName, 1, 2)
DiskName = StrConv(Left(RootPathName, 1), vbUpperCase)

Dim x As String

Label1 = DiskName + "盘的容量信息"
'调用API函数获取容量信息
r = GetDiskFreeSpaceEx(RootPathName, BytesFreeToCalller, TotalBytes, TotalFreeBytes)
'用FORMAT函数输出习惯的数据显示格式
text1.Text = Format$(TotalBytes * 10000 / 1024 / 1024 / 1024, "###0.###") & " " & "GB"
text2.Text = Format$(TotalFreeBytes * 10000 / 1024 / 1024 / 1024, "##0.###") & " " & "GB"
text3.Text = Format$((TotalBytes - TotalFreeBytes) * 10000 / 1024 / 1024 / 1024, "###0.###") & " " & "GB"
End Sub
Private Sub command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
checkdiskform.Left = (Screen.Width - checkdiskform.Width) / 2
checkdiskform.Top = (Screen.Height - checkdiskform.Height) / 2
command1.Caption = "检测磁盘容量"
command2.Caption = "退出"
text1.Text = "磁盘总容量（GB）"
text2.Text = "可用空间（GB）"
text3.Text = "已用空间（GB）"
End Sub

很准确的 可对照 我的电脑 各盘符属性
控件一共有 Drive1 3个text 2个command 1个lable(可有可无)

Answer 5

Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private 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

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

Private Sub Form_Load()
Dim userbytes As LARGE_INTEGER ' 目前 User 可用磁盘空间
Dim totalbytes As LARGE_INTEGER ' 磁盘总空间
Dim freebytes As LARGE_INTEGER ' 磁盘剩余总空间
Dim retval As Long ' 的返回值
Dim mUserBytes As Double, mTotalBytes As Double, mFreeBytes As Double
Dim ctlNew As Control
Dim t As Double, i As Integer, DriveName As String, S As String

Set ctlNew = Me.Controls.Add("VB.drivelistbox", "cmdNew", Me)
With ctlNew
For i = 0 To .ListCount - 1 '枚举所有盘符
DriveName = Left(.List(i), InStr(.List(i), ":"))
If GetDriveType(DriveName) = 3 Then '如果是硬盘盘符
retval = GetDiskFreeSpaceEx(DriveName & "\", userbytes, totalbytes, freebytes)
mTotalBytes = (totalbytes.highpart * (16 ^ 8) + totalbytes.lowpart + IIf(totalbytes.lowpart < 0, (16 ^ 8), 0)) / 2 ^ 30
mUserBytes = (userbytes.highpart * (16 ^ 8) + userbytes.lowpart + IIf(userbytes.lowpart < 0, (16 ^ 8), 0)) / 2 ^ 30
If Fix(mTotalBytes) <> mTotalBytes Then mTotalBytes = Fix(mTotalBytes) + 1
S = S & DriveName & "总空间" & Format(mTotalBytes, "#,###G") _
& " 可用空间" & Format(mUserBytes, "#,###.##G") _
& " 剩余空间 " & Format(mTotalBytes - mUserBytes, "#,###.##G") & vbNewLine
t = t + mTotalBytes
End If
Next
End With
S = S & "磁盘总空间：" & Format(t, "#,###G")
MsgBox S, vbInformation, "磁盘空间统计"
Controls.Remove ctlNew
End
End Sub

Answer 6

本代码避免普通统计不准备的做法，统计结果准确。