⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 是一个获取磁盘信息的代码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      Visible         =   0   'False
      Width           =   1605
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00C0C0C0&
      Height          =   225
      Index           =   2
      Left            =   3465
      Top             =   705
      Visible         =   0   'False
      Width           =   645
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00C0C0C0&
      Height          =   225
      Index           =   1
      Left            =   1425
      Top             =   705
      Visible         =   0   'False
      Width           =   525
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00C0C0C0&
      Height          =   225
      Index           =   0
      Left            =   4185
      Top             =   225
      Width           =   520
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "磁盘卷标:"
      Height          =   195
      Left            =   120
      TabIndex        =   15
      Top             =   1440
      Width           =   900
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "字符长度:"
      Height          =   195
      Left            =   120
      TabIndex        =   13
      Top             =   2160
      Width           =   900
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "磁盘序列号:"
      Height          =   195
      Left            =   120
      TabIndex        =   12
      Top             =   1060
      Width           =   1065
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "文件系统:"
      Height          =   195
      Left            =   120
      TabIndex        =   10
      Top             =   2520
      Width           =   900
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "当前盘还剩:               %空间可用"
      Height          =   195
      Left            =   2400
      TabIndex        =   9
      Top             =   720
      Width           =   2640
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "可用空间数:               GB"
      Height          =   195
      Left            =   120
      TabIndex        =   8
      Top             =   1820
      Width           =   1950
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "磁盘已用空间:              GB"
      Height          =   195
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Width           =   2085
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "磁盘总容量:              GB"
      Height          =   195
      Left            =   3120
      TabIndex        =   6
      Top             =   240
      Width           =   1905
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "磁盘选择:"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   900
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
'**说     明:SAIL软件工作室 版权所有2007 - 2008(C)
'**注:       转载请注明出处
'**创 建 人:陈峰
'**日     期:2007-10-16 11:24:14
'**描     述:磁盘信息获取
'**版     本:V1.0.0
'**博客地址:http://hi.baidu.com/陈峰clg
'**QQ   号码:251475547
'**E - mail:clg-123@126.com
'*************************************************************************
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

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 GetLogicalDriveStrings _
                Lib "kernel32" _
                Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
                                                 ByVal lpBuffer As String) As Long
                                                 
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

'Dd用于取得驱动器名
'sectors=每一簇的扇区数
'bytes=每一簇的字迹数
'freec=磁盘剩余簇数
'totalc=磁盘簇的总数
'Gg=磁盘剩余空间
'Tt=磁盘空间总数
'磁盘空间总数=磁盘簇的总数x每一簇的扇区数x每一簇的字迹数
'磁盘剩余空间=磁盘剩余簇数x每一簇的扇区数x每一簇的字迹数
Dim Dd                   As String, Gg As Single, Tt As Single

Dim sDriveNames          As String

Dim Volume_Name          As String

Dim Serial_Number        As Long

Dim Max_Component_Length As Long

Dim File_System_Flags    As Long

Dim File_System_Name     As String

Sub Driv()

    On Error GoTo err

    Dd = Left(Drive1.Drive, 2) & "\"
    'Dd = Combo1.Text & "\"
    GetDiskFreeSpace Dd, sectors, bytes, freec, totalc
    Tt = totalc * sectors * bytes
    Tt = Tt / 1024 / 1024 / 1024
    Gg = freec * sectors * bytes
    Gg = Gg / 1024 / 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")
    Volume_Name = Space$(1024)
    File_System_Name = Space$(1024)
    GetVolumeInformation Dd, Volume_Name, Len(Volume_Name), Serial_Number, Max_Component_Length, File_System_Flags, File_System_Name, Len(File_System_Name)
    'End If
    Pos = InStr(Volume_Name, Chr$(0))
    Volume_Name = Left$(Volume_Name, Pos - 1)
    Text8 = Volume_Name
    
    Pos = InStr(File_System_Name, Chr$(0))
    File_System_Name = Left$(File_System_Name, Pos - 1)
    Text5 = " " & File_System_Name
    
    Text6 = Serial_Number & "     --     " & Hex(Serial_Number)
    
    Text7 = Max_Component_Length
    ' vkBar2.Value = Text4
    'vkBar1.Value = 100 - Text4
    Image1.Visible = True
    Image2.Visible = True
    Image2.Width = Text4 / 2
    Image1.Left = Image2.Width
    Image1.Width = Picture1.ScaleWidth - Image1.Left
    Label5.Caption = "可用:(" & Text4 & ")"
    Label4.Caption = "已用:(" & 100 - Text4 & ")"

    With MSChart1
        .Row = 2
        .Data = Text4
        .Row = 1
        .Data = 100 - Text4
    End With

    Exit Sub

err:
    Text1 = "": Text2 = "": Text3 = "": Text4 = "": Text5 = "": Text6 = "": Text7 = "": Text8 = "": Image1.Visible = False: Image2.Visible = False

    With MSChart1
        .Row = 2
        .Data = 0 'Text4
        .Row = 1
        .Data = 0 '100 - Text4
    End With

    'MsgBox "此驱动器中没有磁盘或磁盘已损坏!"
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Drive1_Change()
    Driv
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()

    Dim i As Integer

    'lB = 26 * 4 + 1
    'sDriveNames = Space$(lB)
    'lReturn = GetLogicalDriveStrings(lB, sDriveNames)
    'i = 1
    'Do

    'sTempStr = Mid$(sDriveNames, i, 2)
    'If Left$(sTempStr, 1) = vbNullChar Then Exit Do
    'Combo1.AddItem UCase(sTempStr)
    'i = i + 4
    'vkListBox1.Path
    'Loop
    For i = 0 To 7
        Shape2(i).Visible = True
    Next

    Drive1.Drive = "C:\"
    'Combo1.Text = "C:"
    Driv

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -