如何得到大容量DISK的容量，以及其它系统信息？

[zhangyi520]

getdiskfreespace 不能算出容量,如何锝到系统信息.

[goodname008]

' 能算出容量啊，用我编的这个函数试试。

Option Explicit
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
Public Enum DiskSpace
FreeSpace
TotalSpace
End Enum

Private Sub Command1_Click()
Debug.Print GetDiskSpace("c:", TotalSpace)
End Sub

' 获得指定磁盘的剩余容量/总容量
' Drive 为驱动器的根路径( 如"C:\"), Action 为获得磁盘容量的动作( 剩余容量/总容量 )
Function GetDiskSpace(ByVal Drive As String, ByVal Action As DiskSpace) As Double
Dim SecPerClt As Long, BytPerSec As Long, FreeClt As Long, TotalClt As Long
GetDiskFreeSpace Drive, SecPerClt, BytPerSec, FreeClt, TotalClt
If Action = FreeSpace Then
GetDiskSpace = CDbl(SecPerClt) * CDbl(BytPerSec) * CDbl(FreeClt)
Else
GetDiskSpace = CDbl(SecPerClt) * CDbl(BytPerSec) * CDbl(TotalClt)
End If
End Function

[道素]

Option Explicit

Private Declare Function GetDiskFreeSpace Lib "kernel32.dll" 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.dll" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As ULARGE_INTEGER, _
lpTotalNumberOfBytes As ULARGE_INTEGER, _
lpTotalNumberOfFreeBytes As ULARGE_INTEGER) As Long

Private Declare Function GetVersionEx Lib "kernel32.dll" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

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

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, _
ByVal Length As Long)

Private Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32s = 0 ' Win 3.1 mit 32 Bit-Erweiterung
Private Const VER_PLATFORM_WIN32_WINDOWS = 1 ' Win NT/2000
Private Const VER_PLATFORM_WIN32_NT = 2 ' Win 9x

Private Sub Command1_Click()
Dim Retval As Long
Dim OS As OSVERSIONINFO
Dim InputRet As String
Dim Buffer As String

Buffer = Space(256)
Retval = GetLogicalDriveStrings(Len(Buffer), Buffer)
Buffer = Left$(Buffer, Retval)
Buffer = Replace(Buffer, "\" & vbNullChar, ", ")

InputRet = InputBox("输入要查看的分区 " & _
"(" & Buffer & ").", "容量空间信息", "C:\")
If InputRet = "" Or Len(InputRet) > 3 Then
MsgBox "输入无效或者取消了输入"
Exit Sub
End If

OS.dwOSVersionInfoSize = Len(OS)
Retval = GetVersionEx(OS)
If Retval = 0 Then
MsgBox "无法判断操作系统版本."
Exit Sub
End If


With OS
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
If InStr(1, OS.szCSDVersion, "B") <> 0 Or _
.dwMinorVersion > 0 Then
' Win98 oder h鐬er
Call GetNewFreespace(InputRet)
Else
Call GetOldFreespace(InputRet)
End If
Case VER_PLATFORM_WIN32_NT
If .dwMajorVersion >= 4 Then
' WinNT 4/Win2000/WinXP
Call GetNewFreespace(InputRet)
Else
Call GetOldFreespace(InputRet)
End If
Case Else
MsgBox "Windows 3.x Version ."
End Select
End With
End Sub

Private Function GetOldFreespace(ByVal Root As String)
Dim Retval As Long
Dim SC As Long, BC As Long, FC As Long, TC As Long
Dim TSpace As Long, FSpace As Long, USpace As Long

Retval = GetDiskFreeSpace(Root, SC, BC, FC, TC)
TSpace = TC * SC * BC / 1024 / 1024
FSpace = FC * SC * BC / 1024 / 1024
USpace = TSpace - FSpace

MsgBox "总和: " & Format$(TSpace, "##.00 MB") & vbCrLf & _
"使用: " & Format$(USpace, "##.00 MB") & vbCrLf & _
"空闲: " & Format$(FSpace, "##.00 MB") & vbCrLf _
, , "当前查看分区 """ & Root & """"
End Function

Private Function GetNewFreespace(ByVal Root As String)
Dim Retval As Long
Dim CBytes As ULARGE_INTEGER
Dim TBytes As ULARGE_INTEGER
Dim FBytes As ULARGE_INTEGER
Dim CB As Currency
Dim TB As Currency
Dim FB As Currency
Dim UB As Currency

Retval = GetDiskFreeSpaceEx(Root, CBytes, TBytes, FBytes)
CopyMemory CB, CBytes, 8
CB = CB * 10000 / 1024 / 1024
CopyMemory TB, TBytes, 8
TB = TB * 10000 / 1024 / 1024
CopyMemory FB, FBytes, 8
FB = FB * 10000 / 1024 / 1024
UB = TB - FB

MsgBox "总和: " & Format$(TB, "##.00 MB") & vbCrLf & _
"使用: " & Format$(UB, "##.00 MB") & vbCrLf & _
"空闲: " & Format$(FB, "##.00 MB") & vbCrLf _
, , "当前查看分区 """ & Root & """"
End Function

[hcj2002]

可以用shell "C:\Program Files\Common Files\Microsoft Shared\msinfo32.exe"调用系统的系统信息的函数。如果要自己写用api函数。
要得到disk得大小：用 File System Object(FSO)对象模型,具体实现如下:
Dim fso As New FileSystemObject
Dim drv As Drive
Dim s As String
Dim c As Integer
Dim cf As Integer
Set drv = fso.GetDrive(fso.GetDriveName("C:"))
s = "Drive " & UCase("C:") & " " & drv.VolumeName & vbCrLf
s = s & " " & "总空间大小：" & FormatNumber(drv.TotalSize / 1024 / 1024 / 1024) & "GB "
s = s & "可用空间： " & FormatNumber(drv.FreeSpace / 1024 / 1024 / 1024) & "GB" & vbCrLf
Label9.Caption = Label9.Caption & s
另外,我写了一个得到系统信息的程序,如果要愿码的话,给我联系:
[e-mail]

[hcj2002]

不好意思,我的邮箱写错了.
[e-mail]
QQ:250484418