磁盘容量测试 1.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Begin VB.Form 磁盘容量测试 
   AutoRedraw      =   -1  'True
   Caption         =   "磁盘容量测试"
   ClientHeight    =   2400
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6120
   Icon            =   "磁盘容量测试 1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2400
   ScaleWidth      =   6120
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      FillStyle       =   0  'Solid
      Height          =   810
      Left            =   4020
      Picture         =   "磁盘容量测试 1.frx":0442
      ScaleHeight     =   810
      ScaleWidth      =   1170
      TabIndex        =   12
      Top             =   1290
      Width           =   1170
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   1710
      TabIndex        =   10
      Top             =   780
      Width           =   705
   End
   Begin VB.TextBox Text4 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   1320
      TabIndex        =   8
      Top             =   1290
      Width           =   705
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   4410
      TabIndex        =   6
      Top             =   210
      Width           =   705
   End
   Begin VB.TextBox Text3 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   4800
      TabIndex        =   2
      Top             =   720
      Width           =   705
   End
   Begin VB.DriveListBox Drive1 
      Appearance      =   0  'Flat
      Height          =   300
      Left            =   1290
      TabIndex        =   1
      Top             =   210
      Width           =   1245
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退  出"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   420
      TabIndex        =   0
      Top             =   1890
      Width           =   795
   End
   Begin VB.Label Label7 
      Caption         =   "磁盘已用空间为：          GB"
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   810
      Width           =   2625
   End
   Begin VB.Label Label6 
      Caption         =   "当前盘还有：         % 空间可用"
      Height          =   330
      Left            =   240
      TabIndex        =   9
      Top             =   1350
      Width           =   3015
   End
   Begin VB.Label Label5 
      Caption         =   "全部磁盘容量为：          GB"
      Height          =   210
      Left            =   2940
      TabIndex        =   7
      Top             =   285
      Width           =   2715
   End
   Begin VB.Label Label4 
      Caption         =   "磁盘选择："
      Height          =   210
      Left            =   300
      TabIndex        =   5
      Top             =   300
      Width           =   1005
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Height          =   285
      Left            =   4320
      TabIndex        =   4
      Top             =   240
      Width           =   555
   End
   Begin VB.Label Label1 
      Caption         =   "当前盘剩余空间还有：          GB"
      Height          =   210
      Left            =   2940
      TabIndex        =   3
      Top             =   795
      Width           =   3015
   End
End
Attribute VB_Name = "磁盘容量测试"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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
Dim Dd As String, Gg As Single, Tt As Single
Dim Sectors As Long, Bytes As Long, FreeC As Long, TotalC As Long
Private Sub Form_Load()
    Drive1.Drive = "C:\"
    Dd = Drive1 & "\"
    GetDiskFreeSpace Dd, Sectors, Bytes, FreeC, TotalC
    Tt = Sectors * TotalC / 1024
    Tt = Tt * Bytes
    Gg = Sectors * Bytes
    Gg = Gg * FreeC
    Gg = Gg / 1024 / 1024 / 1024
    Tt = Tt / 1024 / 1024
    Text1 = Format(Tt, "0.00")
    Text2 = Format(Tt - Gg, "0.00")
    Text3 = Format(Gg, "0.00")
    Text4 = Format(100 * Gg / Tt, "0.00")
End Sub
Private Sub Drive1_Change()
On Error GoTo A1
    Text3 = ""
    Dd = Drive1 & "\"
    GetDiskFreeSpace Dd, Sectors, Bytes, FreeC, TotalC
    Tt = Sectors * TotalC / 1024
    Tt = Tt * Bytes
    Gg = Sectors * Bytes
    Gg = Gg * FreeC
    Gg = Gg / 1024 / 1024 / 1024
    Tt = Tt / 1024 / 1024
    Text1 = Format(Tt, "0.00")
    Text2 = Format(Tt - Gg, "0.00")
    Text3 = Format(Gg, "0.00")
    Text4 = Format(100 * Gg / Tt, "0.00")
    Exit Sub
A1:
     Text3 = "": Text1 = "": Text4 = ""
     MsgBox "   此驱动器中没有磁盘或磁盘坏了 ！"
End Sub
Private Sub Command1_Click()
Unload Me
End
End Sub