main.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Main 
   Caption         =   "Form1"
   ClientHeight    =   5895
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5640
   LinkTopic       =   "Form1"
   ScaleHeight     =   5895
   ScaleWidth      =   5640
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1920
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   4920
      Width           =   2655
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   840
      TabIndex        =   1
      Top             =   720
      Width           =   3615
   End
   Begin VB.ListBox List1 
      Height          =   3120
      Left            =   840
      TabIndex        =   0
      Top             =   1440
      Width           =   3735
   End
   Begin VB.Label Label1 
      Caption         =   "软件注册号："
      Height          =   255
      Left            =   720
      TabIndex        =   3
      Top             =   5040
      Width           =   1215
   End
End
Attribute VB_Name = "Main"
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 Volume As String, SysName As String
    Dim SerialNum As Long, SysFlags As Long, _
        ComponentLength As Long, Res As Long
    Dim SectorsPerCluster As Long, BytesPerSector As Long, _
        NumberOfFreeClustors As Long, TotalNumberOfClustors As Long
    Dim PercentFree As Long, Dl As Long
    Dim DrvName As String
    List1.Clear
    Volume = String(256, 0)
    SysName = String(256, 0)
    DrvName = Left(Drive1.Drive, 2) & "\"
    ' 获取磁盘信息
    Res = GetVolumeInformation(DrvName, Volume, 255, SerialNum, _
        ComponentLength, SysFlags, SysName, 255)
    If Res = 0 Then
        List1.AddItem "不能得到磁盘信息"
    Else
        List1.AddItem "卷标: " & Trim(Volume)
        List1.AddItem "序列号: " & SerialNum
        List1.AddItem "成分长度: " & ComponentLength
        List1.AddItem "文件系统: " & Trim(SysName)
        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")
        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
    ' 计算序列号
    Dim SerialNumber As Long
    ' 这里修改计算方法
    SerialNumber = SerialNum And 12345678
    Text1.Text = SerialNumber
End Sub

Private Sub Form_Load()
    Call Drive1_Change
End Sub