form1.frm

Visual Basic,获取硬盘信息的源代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox List1 
      Height          =   1680
      Left            =   1920
      TabIndex        =   1
      Top             =   420
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   120
      TabIndex        =   0
      Top             =   420
      Width           =   1395
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
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
Private Const FS_CASE_IS_PRESERVED = &H2
Private Const FS_CASE_SENSITIVE = &H1
Private Const FS_UNICODE_STORED_ON_DISK = &H4
Private Const FS_PERSISTENT_ACLS = &H8
Private Const FS_FILE_COMPRESSION = &H10
Private Const FS_VOL_IS_COMPRESSED = 32768

Private Sub Drive1_Change()
Dim Vol As String, SysN As String
Dim SN As Long, SysFlags As Long, ComponentLen As Long, Res As Long
Dim SectorsPerCluster As Long, BytesPerSector As Long, NumberOfFreeClustors As Long, TotalNumberOfClustors As Long
Dim FreeBytes As Long, TotalBytes As Long, PercentFree As Long, Dl As Long
Dim DrvName As String

List1.Clear
Vol = String(256, 0)
SysN = String(256, 0)
DrvName = Left(Drive1.Drive, 2) & "\"
Res = GetVolumeInformation(DrvName, Vol, 255, SN, ComponentLen, SysFlags, SysN, 255)
If Res = 0 Then
List1.AddItem "不能得到磁盘信息"
Else
List1.AddItem "卷标: " & Trim(Vol)
List1.AddItem "序列号: " & SN
List1.AddItem "成分长度: " & ComponentLen
List1.AddItem "文件系统: " & Trim(SysN)
Dl = GetDiskFreeSpace(DrvName, SectorsPerCluster, BytesPerSector, NumberOfFreeClustors, TotalNumberOfClustors)
List1.AddItem "每簇中扇区数: " & Format(SectorsPerCluster, "#,0")
List1.AddItem "每扇区中字节数: " & Format(BytesPerSector, "#,0")
List1.AddItem "总簇数: " & Format(TotalNumberOfClustors, "#,0")
List1.AddItem "剩余簇数: " & Format(NumberOfFreeClustors, "#,0")
'TotalBytes = TotalNumberOfClustors * SectorsPerCluster * BytesPerSector
List1.AddItem "总字节数: " & Format(TotalBytes, "#,0")
'FreeBytes = NumberOfFreeClustors * SectorsPerCluster * BytesPerSector
List1.AddItem "剩余字节数: " & Format(FreeBytes, "#,0")
If SysFlags And FS_CASE_IS_PRESERVED Then
List1.AddItem "文件名的大小写记录于文件系统"
End If
If SysFlags And FS_CASE_SENSITIVE Then
List1.AddItem "文件名要区分大小写"
End If
If SysFlags And FS_UNICODE_STORED_ON_DISK Then
List1.AddItem "文件名保存为 Unicode 格式"
End If
If SysFlags And FS_PERSISTENT_ACLS Then
List1.AddItem "文件系统支持文件的访问 控制列表（ACL）安全机制"
End If
If SysFlags And FS_FILE_COMPRESSION Then
List1.AddItem "文件系统支持逐文件地进行文件压缩"
End If
If SysFlags And FS_VOL_IS_COMPRESSED Then
List1.AddItem "整个磁盘卷都是压缩的"
End If
End If
End Sub

Private Sub Form_Load()
Call Drive1_Change
End Sub