可以用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
另外,我写了一个得到系统信息的程序,如果要愿码的话,给我联系:
hcj_2005@164.com
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
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
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
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