📄 frmdisk.frm
字号:
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 16
Top = 1080
Width = 855
End
Begin VB.Label lblUsed
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 15
Top = 1800
Width = 855
End
Begin VB.Label Label6
Caption = "已用空间:"
Height = 255
Left = 120
TabIndex = 14
Top = 1800
Width = 1335
End
Begin VB.Label Label5
Caption = "剩余空间:"
Height = 255
Left = 120
TabIndex = 13
Top = 1440
Width = 1335
End
Begin VB.Label Label4
Caption = "磁盘总大小:"
Height = 255
Left = 120
TabIndex = 12
Top = 1080
Width = 1335
End
Begin VB.Label lblVolumeName
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 11
Top = 2160
Width = 2175
End
Begin VB.Label Label1
Caption = "卷标:"
Height = 255
Index = 6
Left = 120
TabIndex = 10
Top = 2160
Width = 1335
End
Begin VB.Label lblFileSystem
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 9
Top = 2880
Width = 2175
End
Begin VB.Label lblSerialNumber
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 8
Top = 2520
Width = 975
End
Begin VB.Label Label1
Caption = "文件系统:"
Height = 255
Index = 5
Left = 120
TabIndex = 7
Top = 2880
Width = 1335
End
Begin VB.Label Label1
Caption = "序列号:"
Height = 255
Index = 2
Left = 120
TabIndex = 6
Top = 2520
Width = 1335
End
Begin VB.Label lblFree
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 5
Top = 1440
Width = 855
End
Begin VB.Label lblTotal
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 4
Top = 1080
Width = 855
End
Begin VB.Label Label9
Caption = "字符长度:"
Height = 255
Left = 120
TabIndex = 3
Top = 3240
Width = 1335
End
Begin VB.Label lblLenghtString
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 2
Top = 3240
Width = 2175
End
End
Attribute VB_Name = "frmDisk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/29
'描 述：高级硬盘信息获取源代码 Ver 1.0
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Private Graph As New clsGraph
Private Sub cboDrives_Click()
picGraph.Refresh
cmdShowInfo_Click
End Sub
Private Sub cboPrimaryMaster_Click()
Dim Drv_Info As DRIVE_INFO
Dim sInfo As String
Dim sInfoAttr As String
Dim i As Integer
Drv_Info = GetDriveInfo(cboPrimaryMaster.ListIndex)
sInfo = cboPrimaryMaster.List(cboPrimaryMaster.ListIndex)
sInfo = sInfo & ": " & vbCrLf
txtAdvancedInfo.Text = ""
With Drv_Info
lblFirmware.Caption = .FirmWare
lblModelo.Caption = .Model
lblSerialN.Caption = .SerialNumber
lblCilinders.Caption = .Cilinders
lblHeads.Caption = .Heads
lblSecPerTrack.Caption = .SecPerTrack
If .bDriveType = 0 Then sInfo = sInfo & "[Not present]"
lblType.Caption = "[Not present]"
If .bDriveType = 2 Then sInfo = sInfo & "[ATAPI drive - 无可用信息]"
lblType.Caption = "[ATAPI drive - 无可用信息]"
If .bDriveType = 1 Then
lblType.Caption = "[IDE drive]"
sInfoAttr = Format("特征名称", String(24, "@") & "!") & Format("值", String(7, "@") & "!") & Format("极限", String(11, "@") & "!") & Format("最差值", String(12, "@") & "!") & "状态" & vbCrLf
sInfoAttr = sInfoAttr & String(60, "-") & vbCrLf
For i = 1 To .NumAttributes - 1
sInfoAttr = sInfoAttr & Format(.Attributes(i).AttrName, String(25, "@") & "!") & Format(.Attributes(i).AttrValue, String(3, "@")) & vbTab & Space(2) & Format(.Attributes(i).ThresholdValue, String(3, "@")) & vbTab & Format(.Attributes(i).WorstValue, String(8, "@")) & vbTab & Format("&H" & Hex(.Attributes(i).StatusFlags), String(4, "@"))
sInfoAttr = sInfoAttr & vbNewLine
Next i
txtAdvancedInfo.Text = sInfoAttr
End If
End With
End Sub
Private Sub cmdShowInfo_Click()
Dim Bytes_Avail As LARGE_INTEGER
Dim Bytes_Total As LARGE_INTEGER
Dim Bytes_Free As LARGE_INTEGER
lReturn = GetDiskFreeSpace(sDrive, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
lblSectorPerClusters.Caption = lSectorsPerCluster
lblBytesPerClusters.Caption = lBytesPerSector
lblFreeCluster.Caption = lFreeClusters
lblTotalClusters.Caption = lTotalClusters
On Error Resume Next
GetDiskFreeSpaceEx cboDrives.Text, Bytes_Avail, Bytes_Total, Bytes_Free
Dbl_Total = LargeIntegerToDouble(Bytes_Total.Lowpart, Bytes_Total.Highpart)
Dbl_Free = LargeIntegerToDouble(Bytes_Free.Lowpart, Bytes_Free.Highpart)
lblTotal.Caption = SizeString(Dbl_Total)
lblFree.Caption = SizeString(Dbl_Free)
lblUsed.Caption = SizeString(Dbl_Total - Dbl_Free)
lblPercentTotal.Caption = Format$(1, "percent")
lblPercentFree.Caption = Format$(Dbl_Free / Dbl_Total, "percent")
lblPercentUsed.Caption = Format$((Dbl_Total - Dbl_Free) / Dbl_Total, "percent")
txtFree.Text = Format$(Dbl_Free / Dbl_Total) * 100
txtUsed.Text = Format$((Dbl_Total - Dbl_Free) / Dbl_Total) * 100
Root = cboDrives.Text
Volume_Name = Space$(1024)
File_System_Name = Space$(1024)
'*********
If GetVolumeInformation(Root, Volume_Name, Len(Volume_Name), Serial_Number, Max_Component_Length, File_System_Flags, File_System_Name, Len(File_System_Name)) = 0 Then
picGraph.Cls
lblPercentTotal.Caption = ""
lblPercentFree.Caption = ""
lblPercentUsed.Caption = ""
lblVolumeName.Caption = ""
lblSerialNumber.Caption = ""
lblFileSystem.Caption = ""
lblLenghtString.Caption = ""
lblSectorPerClusters.Caption = ""
lblBytesPerClusters.Caption = ""
lblFreeCluster.Caption = ""
lblTotalClusters.Caption = ""
lblSerialNumber2.Caption = ""
chkCASE_IS_PRESERVED.Value = 0
chkCASE_SENSITIVE.Value = 0
chkUNICODE_STORED_ON_DISK.Value = 0
chkPERSISTENT_ACLS.Value = 0
chkFILE_COMPRESSION.Value = 0
chkVOL_IS_COMPRESSED.Value = 0
chkNAMED_STREAMS.Value = 0
chkSUPPORTS_ENCRYPTION.Value = 0
chkSUPPORTS_OBJECT_IDS.Value = 0
chkSUPPORTS_REPARSE_POINTS.Value = 0
chkSUPPORTS_SPARSE_FILES.Value = 0
chkVOLUME_QUOTAS.Value = 0
MsgBox "No Disk!", vbExclamation, "Error when Reading the Disk"
Exit Sub
End If
'**********
Dim VolumeNameBuffer As String * 11
Dim VolumeSerialNumber As Long
Dim MaximumComponentLength As Long
Dim FileSystemFlags As Long
Dim FileSystemNameBuffer As String
If GetVolumeInformation(Left$(cboDrives, 2) & "\", VolumeNameBuffer, Len(VolumeNameBuffer), VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, FileSystemNameBuffer, Len(FileSystemNameBuffer)) = 0 Then
Exit Sub
End If
lblSerialNumber2.Caption = Hex(VolumeSerialNumber)
If FileSystemFlags And FS_CASE_IS_PRESERVED Then chkCASE_IS_PRESERVED.Value = 1
If FileSystemFlags And FS_CASE_SENSITIVE Then chkCASE_SENSITIVE.Value = 1
If FileSystemFlags And FS_UNICODE_STORED_ON_DISK Then chkUNICODE_STORED_ON_DISK.Value = 1
If FileSystemFlags And FS_PERSISTENT_ACLS Then chkPERSISTENT_ACLS.Value = 1
If FileSystemFlags And FS_FILE_COMPRESSION Then chkFILE_COMPRESSION.Value = 1
If FileSystemFlags And FS_VOL_IS_COMPRESSED Then chkVOL_IS_COMPRESSED.Value = 1
'Second half
If FileSystemFlags And FILE_NAMED_STREAMS Then chkNAMED_STREAMS.Value = 1
If FileSystemFlags And FILE_SUPPORTS_ENCRYPTION Then chkSUPPORTS_ENCRYPTION.Value = 1
If FileSystemFlags And FILE_SUPPORTS_OBJECT_IDS Then chkSUPPORTS_OBJECT_IDS.Value = 1
If FileSystemFlags And FILE_SUPPORTS_REPARSE_POINTS Then chkSUPPORTS_REPARSE_POINTS.Value = 1
If FileSystemFlags And FILE_SUPPORTS_SPARSE_FILES Then chkSUPPORTS_SPARSE_FILES.Value = 1
If FileSystemFlags And FILE_VOLUME_QUOTAS Then chkVOLUME_QUOTAS.Value = 1
'********
Pos = InStr(Volume_Name, Chr$(0))
Volume_Name = Left$(Volume_Name, Pos - 1)
lblVolumeName.Caption = Volume_Name
lblSerialNumber.Caption = Format$(Serial_Number)
Pos = InStr(File_System_Name, Chr$(0))
File_System_Name = Left$(File_System_Name, Pos - 1)
lblFileSystem.Caption = File_System_Name
lblLenghtString.Caption = Format$(Max_Component_Length)
'********************************
Graph.AddSegment txtFree.Text, "剩余空间", &HFF00FF 'Magenta'
Graph.AddSegment txtUsed.Text, "使用空间", &HFF0000 'Blue'
Graph.DrawPie picGraph.hdc, picGraph.hwnd, True, "硬盘使用饼图"
Graph.Clear
'******************************
End Sub
Private Sub Form_Load()
lBuffer = 26 * 4 + 1
sDriveNames = Space$(lBuffer)
lReturn = GetLogicalDriveStrings(lBuffer, sDriveNames)
nOffset = 1
Do
sTempStr = Mid$(sDriveNames, nOffset, 3)
If Left$(sTempStr, 1) = vbNullChar Then Exit Do
cboDrives.AddItem UCase(sTempStr)
nOffset = nOffset + 4
Loop
cboDrives.ListIndex = 1
With cboPrimaryMaster
.AddItem "PRIMARY_MASTER"
.AddItem "PRIMARY_SLAVE"
.AddItem "SECONDARY_MASTER"
.AddItem "SECONDARY_SLAVE"
End With
cboPrimaryMaster.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Graph = Nothing
End Sub
Private Sub cmdAboutMe_Click()
MsgBox "htp://www.mndsoft.com" & vbNewLine & vbNewLine & "QQ:" & vbNewLine & "88382850" & vbNewLine & "E-mail:mndsoft@126.com" & vbNewLine & vbNewLine & "感谢", vbInformation + vbOKOnly
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -