📄 getdrive.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "获得系统的信息"
ClientHeight = 4530
ClientLeft = 2100
ClientTop = 345
ClientWidth = 6300
LinkTopic = "Form1"
ScaleHeight = 4530
ScaleWidth = 6300
Begin VB.ComboBox Combo1
Height = 285
Left = 120
TabIndex = 0
Top = 600
Width = 1935
End
Begin VB.Shape Shape3
Height = 2505
Left = 3000
Top = 1920
Width = 3135
End
Begin VB.Shape Shape2
Height = 1575
Left = 3000
Top = 240
Width = 3135
End
Begin VB.Shape Shape1
Height = 3015
Left = 0
Top = 120
Width = 2895
End
Begin VB.Label Label11
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 11
Top = 4110
Width = 105
End
Begin VB.Label Label10
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 10
Top = 3630
Width = 105
End
Begin VB.Label Label9
Caption = "选择驱动器"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 9
Top = 240
Width = 1815
End
Begin VB.Label Label8
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 8
Top = 3100
Width = 105
End
Begin VB.Label Label7
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 7
Top = 2595
Width = 105
End
Begin VB.Label Label6
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 6
Top = 2160
Width = 2655
End
Begin VB.Label Label5
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 5
Top = 1320
Width = 2895
End
Begin VB.Label Label4
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 4
Top = 600
Width = 2895
End
Begin VB.Label Label3
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 240
TabIndex = 3
Top = 2400
Width = 2415
End
Begin VB.Label Label2
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 2
Top = 1800
Width = 2415
End
Begin VB.Label Label1
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 1
Top = 1200
Width = 2415
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
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 Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Dim sinfo As SYSTEM_INFO
Dim minfo As MEMORYSTATUS
Private Sub Combo1_Click()
Dim x As Long
Dim cl1 As Long
Dim cl2 As Long
Dim sec1 As Long
Dim byt1 As Long
Dim buff As String
buff = Combo1.Text + ":\"
x = GetDriveType(buff)
Select Case x
Case 2
Label1.Caption = "该驱动器是可移动驱动器"
Case 3
Label1.Caption = "该驱动器是固定驱动器"
Case 4
Label1.Caption = "该驱动器是网络驱动器"
Case 5
Label1.Caption = "该驱动器是CD-ROM驱动器"
Case 6
Label1.Caption = "该驱动器是RAMDISK驱动器"
Case Else
Label1.Caption = "该驱动器无效"
End Select
x = GetDiskFreeSpace(buff, sec1, byt1, cl1, cl2)
If x Then
cl1 = cl1 * sec1 * byt1
cl2 = cl2 * sec1 * byt1
Label2.Caption = "该驱动器总共容量" + Format$(cl2, "##########0") + " 字节"
Label3.Caption = "该驱动器可用容量" + Format$(cl1, "##########0") + " 字节"
Else
Label2.Caption = ""
Label3.Caption = ""
End If
End Sub
Private Sub Form_Load()
Dim x As Long
Dim buff As String
For i = 0 To 25
buff = Chr$(65 + i) + ":\"
x = GetDriveType(buff)
If x > 1 Then
Combo1.AddItem Chr$(65 + i)
End If
Next i
Combo1.Text = "C"
Combo1_Click
x = GetSystemMetrics(SM_CXSCREEN)
Label4.Caption = "显示器水平分辨率 " + Str$(x)
x = GetSystemMetrics(SM_CYSCREEN)
Label5.Caption = "显示器垂直分辨率 " + Str$(x)
Call GetSystemInfo(sinfo)
Select Case sinfo.dwProcessorType
Case 386
Case 486
Case 586
Label6.Caption = "计算机处理器类型 P5"
Case Else
End Select
Call GlobalMemoryStatus(minfo)
Label7.Caption = "物理内存总容量 " + Str$(minfo.dwTotalPhys) + " 字节"
Label8.Caption = "可用物理内存 " + Str$(minfo.dwAvailPhys) + " 字节"
Label10.Caption = "虚拟内存总容量 " + Str$(minfo.dwTotalVirtual) + " 字节"
Label11.Caption = "可用虚拟内存 " + Str$(minfo.dwAvailVirtual) + " 字节"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -