Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Private IsBaseFirst As Boolean = True
Private IsHardFirst As Boolean = True
Private IsCPUFirst As Boolean = True
Private IsROMFirst As Boolean = True
Private IsAuidoFirst As Boolean = True
Private IsVidoFirst As Boolean = True
Private IsMACFirst As Boolean = True
Private IsSoftwareFirst As Boolean = True
Private IsLoad As Boolean
Private Sub Form4_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
IsLoad = True
StatusBar1.Panels(0).Text = "就绪."
Dim objectQuery As New ObjectQuery("select * from Win32_Share")
Dim searcher As New ManagementObjectSearcher(objectQuery)
Dim share As ManagementObject
For Each share In searcher.Get()
Console.WriteLine("Share = " & share("Name"))
Next share
End Sub
Private Sub TableControl_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TableControl.SelectedIndexChanged
Me.Cursor = Cursors.WaitCursor
If IsLoad Then StatusBar1.Panels(0).Text = "正在搜索信息,请稍候..."
Select Case TableControl.SelectedIndex
Case 0
If IsBaseFirst Then BaseInfo()
Case 1
If IsHardFirst Then HardInfo()
Case 2
If IsCPUFirst Then CPUinfo()
Case 3
If IsROMFirst Then ROMinfo()
Case 4
If IsAuidoFirst Then AuidoInfo()
Case 5
If IsVidoFirst Then VidoInfo()
Case 6
If IsMACFirst Then MACinfo()
Case 7
If IsSoftwareFirst Then FontInfo()
End Select
Me.Cursor = Cursors.Default
If IsLoad Then StatusBar1.Panels(0).Text = "就绪."
End Sub
'测试硬盘读写速度
Private Sub MenuItem6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem6.Click
Dim testString As String = String.Empty
If MessageBox.Show("整个测试过程需要几分钟,你确定要测试吗?", "测试", _
MessageBoxButtons.OKCancel, MessageBoxIcon.Question) = Windows.Forms.DialogResult.OK Then
Me.Cursor = Cursors.WaitCursor
Dim I As Int32
Dim f As New FileStream("E:/BigFile.big", FileMode.Create)
Dim fw As New BinaryWriter(f)
Dim fr As New BinaryReader(f)
Dim Size As Int32 = 1024 * 1024 * 1024 - 1 'File size = 1GB
Dim bufSize As Int32 = 30 * 1024 * 1024 'Buffer Size = 30MB
Dim jLast As Int32 = bufSize - 1
Dim Bytes(bufSize) As Byte
Dim StartWrite As Date = Date.Now
StatusBar1.Panels(0).Text = "开始写数据测试时间：" & StartWrite
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "正在进行写数据测试,请稍候..."
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
For I = 0 To Size Step bufSize '1GB
fw.Write(Bytes)
Next
Dim EndWrite As Date = Date.Now
Dim TimePassed As TimeSpan = EndWrite.Subtract(StartWrite)
StatusBar1.Panels(0).Text = "结束写数据测试时间：" & EndWrite
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "写数据测试用时：" & Format(TimePassed.ToString, "h:m:s")
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "硬盘写数据速度为：" & CInt(1000 / TimePassed.TotalSeconds) & "M/s"
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
fw.Flush()
Dim StartRead As Date = Date.Now
StatusBar1.Panels(0).Text = "开始读数据测试时间：" & StartRead
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "正在进行读数据测试,请稍候..."
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
For I = 0 To Size Step bufSize
Bytes = fr.ReadBytes(bufSize)
Next
Dim EndRead As Date = Date.Now
TimePassed = EndRead.Subtract(StartRead)
StatusBar1.Panels(0).Text = "结束读数据测试时间：" & EndRead
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "读数据测试用时：" & Format(TimePassed.ToString, "hh:ss:mm")
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
StatusBar1.Panels(0).Text = "硬盘读数据速度为：" & CInt(1000 / TimePassed.TotalSeconds) & "M/s"
testString = testString & StatusBar1.Panels(0).Text & Environment.NewLine
fw.Close()
Me.Cursor = Cursors.Default
If MessageBox.Show(testString & Environment.NewLine & Environment.NewLine & _
"测试已经完成,是否保存测试记录?", "测试完成", _
MessageBoxButtons.OKCancel, MessageBoxIcon.Question) = Windows.Forms.DialogResult.OK Then
End If
End If
End Sub
Region "dfd"
Function processorfamily(ByVal procssfam As String) As String
Dim processtype As String = String.Empty
Select Case procssfam
Case 1
processtype = "Other"
Case 2
processtype = "Unknown "
Case 3
processtype = "8086 "
Case 4
processtype = "80286 "
Case 5
processtype = "80386 "
Case 6
processtype = "80486 "
Case 7
processtype = "8087 "
Case 8
processtype = "80287 "
Case 9
processtype = "80387 "
Case 10
processtype = "80487 "
Case 11
processtype = "Pentium brand "
Case 12
processtype = "Pentium Pro "
Case 13
processtype = "Pentium II "
Case 14
processtype = "Pentium processor with MMX technology "
Case 15
processtype = "Celeron "
Case 16
processtype = "Pentium II Xeon "
Case 17
processtype = "Pentium III "
Case 18
processtype = "M1 Family "
Case 19
processtype = "M2 Family "
Case 24
processtype = "K5 Family "
Case 25
processtype = "K6 Family "
Case 26
processtype = "K6-2 "
Case 27
processtype = "K6-3 "
Case 28
processtype = "AMD Athlon Processor Family "
Case 29
processtype = "AMD Duron Processor "
Case 30
processtype = "AMD2900 Family "
Case 31
processtype = "K6-2+ "
Case 32
processtype = "Power PC Family "
Case 33
processtype = "Power PC 601 "
Case 34
processtype = "Power PC 603 "
Case 35
processtype = "Power PC 603+ "
Case 36
processtype = "Power PC 604 "
Case 37
processtype = "Power PC 620 "
Case 38
processtype = "Power PC X704 "
Case 39
processtype = "Power PC 750 "
Case 48
processtype = "Alpha Family "
Case 49
processtype = "Alpha 21064 "
Case 50
processtype = "Alpha 21066 "
Case 51
processtype = "Alpha 21164 "
Case 52
processtype = "Alpha 21164PC "
Case 53
processtype = "Alpha 21164a "
Case 54
processtype = "Alpha 21264 "
Case 55
processtype = "Alpha 21364 "
Case 64
processtype = "MIPS Family "
Case 65
processtype = "MIPS R4000 "
Case 66
processtype = "MIPS R4200 "
Case 67
processtype = "MIPS R4400 "
Case 68
processtype = "MIPS R4600 "
Case 69
processtype = "MIPS R10000 "
Case 80
processtype = "SPARC Family "
Case 81
processtype = "SuperSPARC "
Case 82
processtype = "microSPARC II "
Case 83
processtype = "microSPARC IIep "
Case 84
processtype = "UltraSPARC "
Case 85
processtype = "UltraSPARC II "
Case 86
processtype = "UltraSPARC IIi "
Case 87
processtype = "UltraSPARC III "
Case 88
processtype = "UltraSPARC IIIi "
Case 96
processtype = "68040 "
Case 97
processtype = "68xxx Family "
Case 98
processtype = "68000 "
Case 99
processtype = "68010 "
Case 100
processtype = "68020 "
Case 101
processtype = "68030 "
Case 112
processtype = "Hobbit Family "
Case 120
processtype = "Crusoe TM5000 Family "
Case 121
processtype = "Crusoe TM3000 Family "
Case 128
processtype = "Weitek "
Case 130
processtype = "Itanium Processor "
Case 144
processtype = "PA-RISC Family "
Case 145
processtype = "PA-RISC 8500 "
Case 146
processtype = "PA-RISC 8000 "
Case 147
processtype = "PA-RISC 7300LC "
Case 148
processtype = "PA-RISC 7200 "
Case 149
processtype = "PA-RISC 7100LC "
Case 150
processtype = "PA-RISC 7100 "
Case 160
processtype = "V30 Family "
Case 176
processtype = "Pentium III Xeon "
Case 177
processtype = "Pentium III Processor with Intel SpeedStep Technology "
Case 178
processtype = "Pentium 4 "
Case 179
processtype = "Intel Xeon "
Case 180
processtype = "AS400 Family "
Case 181
processtype = "Intel Xeon processor MP "
Case 182
processtype = "AMD AthlonXP Family "
Case 183
processtype = "AMD AthlonMP Family "
Case 184
processtype = "Intel Itanium 2 "
Case 185
processtype = "AMD Opteron Family "
Case 190
processtype = "K7 "
Case 200
processtype = "IBM390 Family "
Case 201
processtype = "G4 "
Case 202
processtype = "G5 "
Case 250
processtype = "i860 "
Case 251
processtype = "i960 "
Case 260
processtype = "SH-3 "
Case 261
processtype = "SH-4 "
Case 280
processtype = "ARM "
Case 281
processtype = "StrongARM "
Case 300
processtype = "6x86 "
Case 301
processtype = "MediaGX "
Case 302
processtype = "MII "
Case 320
processtype = "WinChip "
Case 350
processtype = "DSP "
Case 500
processtype = "Video Processor "
End Select
Return processtype
End Function
Function CpuStat(ByVal CpuStNUM As String) As String
Dim stat As String
Select Case CpuStNUM
Case 0
stat = "Unknown "
Case 1
stat = "CPU Enabled "
Case 2
stat = "CPU Disabled by User via BIOS Setup "
Case 3
stat = "CPU Disabled By BIOS (POST Error) "
Case 4
stat = "CPU is Idle "
Case 5
stat = "Reserved "
Case 6
stat = "Reserved "
Case 7
stat = "Other "
Case Else
stat = ""
End Select
Return stat
End Function
Function processortype(ByVal proctypenum As String) As String
Dim proctype As String = String.Empty
Select Case proctypenum
Case 1
proctype = "Other "
Case 2
proctype = "Unknown "
Case 3
proctype = "Central Processor "
Case 4
proctype = "Math Processor "
Case 5
proctype = "DSP Processor "
Case 6
proctype = "Video Processor "
End Select
Return proctype
End FunctionEnd Region
Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
'打开CD-ROM
Dim lRet As Long
lRet = mciSendString("set cdAudio door open", 0&, 0, 0)
End Sub
Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click
'关闭CD-ROM
Dim lRet As Long
lRet = mciSendString("set cdAudio door Closed", 0&, 0, 0)
End Sub
Private Sub MenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem4.Click
' Win32_NetworkAdapterConfiguration()
End Sub
'基本信息
Private Sub BaseInfo()
IsBaseFirst = False
lsvSystemInfo.Items.Clear()
'得到特殊文件夹的路径
'"Desktop"桌面文件夹路径
lsvSystemInfo.Items.Add("Desktop桌面文件夹路径：" & (Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)))
'"Favorites"收藏夹路径
lsvSystemInfo.Items.Add("Favorites收藏夹路径：" & (Environment.GetFolderPath(Environment.SpecialFolder.Favorites)))
'"Application Data"路径
lsvSystemInfo.Items.Add("Application Data路径：" & (Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)))
'通用写法
'Dim SPEC As String = Environment.GetFolderPath(Environment.SpecialFolder.XXXXXXX)
'XXXXXXX是特殊文件夹的名字
'得到操作系统版本信息
lsvSystemInfo.Items.Add("操作系统版本信息：" & (Environment.OSVersion.ToString))
'得到当前登录的用户名
lsvSystemInfo.Items.Add("前登录的用户名：" & (Environment.UserName))
'得到当前应用程序的路径
lsvSystemInfo.Items.Add("当前应用程序的路径：" & (Environment.CurrentDirectory))
'得到计算机IP和计算机全名
Dim MYIP As System.Net.IPHostEntry = System.Net.Dns.GetHostEntry(System.Net.Dns.GetHostName)
lsvSystemInfo.Items.Add("您的IP地址：" & (MYIP.AddressList.GetValue(0).ToString))
lsvSystemInfo.Items.Add("您的计算机全名：" & (MYIP.HostName.ToString))
'-----------------------------------------------------
'使用win32_operatingSystem (wmi Class)得到计算机信息
Dim opSearch As New ManagementObjectSearcher("SELECT * FROM Win32_OperatingSystem")
Dim opInfo As ManagementObject
For Each opInfo In opSearch.Get()
With lsvSystemInfo.Items
.Add("Name: " & opInfo("name").ToString())
.Add("Version: " & opInfo("version").ToString())
.Add("Manufacturer: " & opInfo("manufacturer").ToString())
.Add("Computer name: " & opInfo("csname").ToString())
.Add("Windows Directory: " & opInfo("windowsdirectory").ToString())
End With
Next
End Sub
Private Sub MACinfo()
IsMACFirst = False
lsvMAC.Items.Clear()
'网卡的MAC
Dim mc As System.Management.ManagementClass = New System.Management.ManagementClass("Win32_NetworkAdapterConfiguration")
Dim moc As System.Management.ManagementObjectCollection = mc.GetInstances()
Dim mo As System.Management.ManagementObject
For Each mo In moc
If CBool(mo("IPEnabled")) = True Then
lsvMAC.Items.Add(mo("MacAddress").ToString()) '//---网卡MAC地址
lsvMAC.Items.Add(mo("IPAddress")(0).ToString()) '//---网卡IP地址
End If
Next
End Sub
'得到硬盘信息
Private Sub HardInfo()
IsHardFirst = False
''获得硬盘序列号
Dim cmicWmi As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive")
Dim Uint32 As UInt32
For Each cmicWmiObj As ManagementObject In cmicWmi.Get
Uint32 = cmicWmiObj("signature")
Next
ListBox5.Items.Add("硬盘序列号：" & Uint32.ToString)
''获得硬盘总容量
Dim Wmi1 As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive")
Dim Uint64 As UInt64
For Each WmiObj As ManagementObject In Wmi1.Get
Uint64 = WmiObj("size")
Next
ListBox5.Items.Add("硬盘总容量：" & Uint64.ToString / 1000000000 & "G")
On Error Resume Next
Dim HDDDeviceQuery As New SelectQuery("Win32_DiskDrive")
Dim HDDDeviceSearch As New ManagementObjectSearcher(HDDDeviceQuery)
Dim HDDDeviceInfo As ManagementObject
For Each HDDDeviceInfo In HDDDeviceSearch.Get()
With ListBox5.Items
.Add("HDD Description: " & HDDDeviceInfo("caption").ToString())
.Add("HDD BytesPerSector: " & HDDDeviceInfo("BytesPerSector").ToString())
.Add("HDD CompressionMethod: " & HDDDeviceInfo("CompressionMethod").ToString())
.Add("HDD Index: " & HDDDeviceInfo("Index").ToString())
.Add("HDD InstallDate: " & HDDDeviceInfo("InstallDate").ToString())
.Add("HDD Manufacturer: " & HDDDeviceInfo("Manufacturer").ToString())
.Add("HDD Partitions: " & HDDDeviceInfo("Partitions").ToString())
.Add("HDD Size: " & Int(Val(HDDDeviceInfo("Size").ToString()) / 2 ^ 30) & " GBytes")
.Add("HDD TotalCylinders: " & HDDDeviceInfo("TotalCylinders").ToString())
.Add("HDD TotalSectors: " & HDDDeviceInfo("TotalSectors").ToString())
.Add("HDD TracksPerCylinder: " & HDDDeviceInfo("TracksPerCylinder").ToString())
.Add("HDD TotalHeads: " & HDDDeviceInfo("TotalHeads").ToString())
.Add("HDD TotalTracks: " & HDDDeviceInfo("TotalTracks").ToString())
.Add("HDD SectorsPerTrack: " & HDDDeviceInfo("SectorsPerTrack").ToString())
.Add("HDD SCSILogicalUnit: " & HDDDeviceInfo("SCSILogicalUnit").ToString())
End With
Next
'-------------------------------
'获取硬盘信息
Dim disk As ManagementBaseObject
Dim strResult As String
Dim diskClass As ManagementClass = New ManagementClass("Win32_LogicalDisk")
Dim disks As ManagementObjectCollection
disks = diskClass.GetInstances()
For Each disk In disks
strResult = ""
strResult += "设备ID:" & disk("DeviceID") & vbCrLf
strResult += "磁盘名称:" & disk("Name") & vbCrLf
strResult += "磁盘卷标:" & disk("VolumeName") & vbCrLf
If disk("FileSystem") <> "" Then strResult += "文件系统:" & disk("FileSystem") & vbCrLf
strResult += "磁盘描述:" & disk("Description") & vbCrLf
If System.Convert.ToInt64(disk("Size")) > 0 Then
strResult += "磁盘大小:" & System.Convert.ToInt64(disk("Size").ToString()) & vbCrLf
strResult += "磁盘类型:" & System.Convert.ToInt16(disk("DriveType").ToString())
End If
lsvHardInfo.Items.Add(strResult)
Next
End Sub
'使用Win32_Processor列出处理器的信息
Private Sub CPUinfo()
IsCPUFirst = False
''获得CPU序列号
Dim Wmi As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_Processor")
Dim Uint33 As String = String.Empty
For Each WmiObj As ManagementObject In Wmi.Get
Uint33 = WmiObj("ProcessorId")
Next
ListBox3.Items.Add("CPU序列号：" & Uint33)
Dim ProcQuery As New SelectQuery("Win32_Processor")
Dim ProcSearch As New ManagementObjectSearcher(ProcQuery)
Dim ProcInfo As ManagementObject
For Each ProcInfo In ProcSearch.Get()
lsvSystemInfo.Items.Add("Family: " & processorfamily(ProcInfo("Family").ToString))
lsvSystemInfo.Items.Add("Processor Type: " & _
processortype(ProcInfo("ProcessorType").ToString()))
lsvSystemInfo.Items.Add("CpuStatus: " & CpuStat(ProcInfo("CpuStatus").ToString))
With ListBox3.Items
.Add("Description: " & ProcInfo("Description").ToString())
.Add("caption: " & ProcInfo("caption").ToString())
.Add("Architecture: " & ProcInfo("Architecture").ToString())
.Add("MaxClockSpeed: " & ProcInfo("MaxClockSpeed").ToString() & "MHZ")
'.Add("L2CacheSpeed: " & ProcInfo("L2CacheSpeed").ToString() & "MHZ")
'.Add("ExtClock: " & ProcInfo("L2CacheSpeed").ToString() & "MHZ")
.Add("ProcessorId: " & ProcInfo("ProcessorId").ToString())
.Add("AddressWidth: " & ProcInfo("AddressWidth").ToString() & "Bits")
.Add("DataWidth: " & ProcInfo("DataWidth").ToString() & "Bits")
.Add("Version: " & ProcInfo("Version").ToString())
.Add("ExtClock: " & ProcInfo("ExtClock").ToString() & "MHZ")
End With
Next
End Sub
'显卡信息
Private Sub VidoInfo()
IsVidoFirst = False
'得到显示器分辨率
Dim X As Short = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width
Dim Y As Short = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
lsvVidoInfo.Items.Add("显示器分辨率：" & X & " X " & Y)
End Sub
'得到声卡信息
Private Sub AuidoInfo()
IsAuidoFirst = False
Dim SoundDeviceQuery As New SelectQuery("Win32_SoundDevice")
Dim SoundDeviceSearch As New ManagementObjectSearcher(SoundDeviceQuery)
Dim SoundDeviceInfo As ManagementObject
For Each SoundDeviceInfo In SoundDeviceSearch.Get()
With ListBox6.Items
.Add("Sound Device Description: " & SoundDeviceInfo("Caption").ToString())
.Add("Sound Device Status: " & SoundDeviceInfo("status").ToString())
.Add("Sound Device Manufacturer: " & SoundDeviceInfo("Manufacturer").ToString())
End With
Next
End Sub
Private Sub FontInfo()
IsSoftwareFirst = False
' 计算机安装的全部字体
Dim fntCollection As InstalledFontCollection = New InstalledFontCollection
Dim fntFamily() As FontFamily
fntFamily = fntCollection.Families
'ListBox1.Items.Clear()
Dim i As Integer = 0
For i = 0 To fntFamily.Length - 1
ListBox2.Items.Add(fntFamily(i).Name)
Next
'列出所有进程
With lsvProcess
.Clear()
.Columns.Add("进程名：", 115, HorizontalAlignment.Left)
.Columns.Add("路径：", 270, HorizontalAlignment.Left)
End With
Dim tempStr As String
Dim cmicWmi As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_Process")
For Each cmicWmiObj As ManagementObject In cmicWmi.Get
Dim lsv As New ListViewItem
tempStr = cmicWmiObj("Name")
lsv = lsvProcess.Items.Add(New ListViewItem(tempStr))
tempStr = cmicWmiObj("ExecutablePath")
lsv.SubItems.Add(tempStr)
Next
End Sub
'得到CD-ROM信息
Private Sub ROMinfo()
IsROMFirst = False
On Error Resume Next
Dim CRDeviceQuery As New SelectQuery("Win32_CDROMDrive")
Dim CRDeviceSearch As New ManagementObjectSearcher(CRDeviceQuery)
Dim CRDeviceInfo As ManagementObject
For Each CRDeviceInfo In CRDeviceSearch.Get()
Dim SizeInMBs As Long = (Val(CRDeviceInfo("Size").ToString()))
SizeInMBs = Int((SizeInMBs / (1024 * 1024)))
With ListBox4.Items
.Add("CD-Rom Description: " & CRDeviceInfo("caption").ToString())
.Add("CD-Rom Manufacturer: " & CRDeviceInfo("Manufacturer").ToString())
.Add("CD-Rom Drive: " & CRDeviceInfo("drive").ToString())
.Add("CD-Rom Media Loaded: " & CRDeviceInfo("MediaLoaded").ToString())
.Add("CD-Rom Media Type: " & CRDeviceInfo("MediaType").ToString())
.Add("CD-Rom Volume Name: " & CRDeviceInfo("VolumeName").ToString())
.Add("CD-Rom Size: " & SizeInMBs & " MBytes")
.Add("CD-Rom Status: " & CRDeviceInfo("Status").ToString())
.Add("CD-Rom MaxMediaSize: " & CRDeviceInfo("MaxMediaSize").ToString())
.Add("CD-Rom Id: " & CRDeviceInfo("Id").ToString())
.Add("CD-Rom TransferRate: " + Int(CRDeviceInfo("TransferRate").ToString()) + " KBs/秒")
End With
Next
End Sub
End Class
555
555
@pHqghUme : 555