📄 hardinfo.frm
字号:
MsgValue = MsgValue & vbCrLf & "CompatibilityFlags: " & objItem.CompatibilityFlags
MsgValue = MsgValue & vbCrLf & "CompressionInfo: " & objItem.CompressionInfo
MsgValue = MsgValue & vbCrLf & "CompressionOff: " & objItem.CompressionOff
MsgValue = MsgValue & vbCrLf & "CompressionOn: " & objItem.CompressionOn
MsgValue = MsgValue & vbCrLf & "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
MsgValue = MsgValue & vbCrLf & "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
MsgValue = MsgValue & vbCrLf & "ConfigurationDialog: " & objItem.ConfigurationDialog
MsgValue = MsgValue & vbCrLf & "CountriesSupported: " & objItem.CountriesSupported
MsgValue = MsgValue & vbCrLf & "CountrySelected: " & objItem.CountrySelected
MsgValue = MsgValue & vbCrLf & "CreationClassName: " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "CurrentPasswords: " & objItem.CurrentPasswords
MsgValue = MsgValue & vbCrLf & "DCB: " & objItem.DCB
MsgValue = MsgValue & vbCrLf & "Default: " & objItem.Default
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "DeviceID: " & objItem.DeviceID
MsgValue = MsgValue & vbCrLf & "DeviceLoader: " & objItem.DeviceLoader
MsgValue = MsgValue & vbCrLf & "DeviceType: " & objItem.DeviceType
MsgValue = MsgValue & vbCrLf & "DialType: " & objItem.DialType
MsgValue = MsgValue & vbCrLf & "DriverDate: " & objItem.DriverDate
MsgValue = MsgValue & vbCrLf & "ErrorCleared: " & objItem.ErrorCleared
MsgValue = MsgValue & vbCrLf & "ErrorControlForced: " & objItem.ErrorControlForced
MsgValue = MsgValue & vbCrLf & "ErrorControlInfo: " & objItem.ErrorControlInfo
MsgValue = MsgValue & vbCrLf & "ErrorControlOff: " & objItem.ErrorControlOff
MsgValue = MsgValue & vbCrLf & "ErrorControlOn: " & objItem.ErrorControlOn
MsgValue = MsgValue & vbCrLf & "ErrorDescription: " & objItem.ErrorDescription
MsgValue = MsgValue & vbCrLf & "FlowControlHard: " & objItem.FlowControlHard
MsgValue = MsgValue & vbCrLf & "FlowControlOff: " & objItem.FlowControlOff
MsgValue = MsgValue & vbCrLf & "FlowControlSoft: " & objItem.FlowControlSoft
MsgValue = MsgValue & vbCrLf & "InactivityScale: " & objItem.InactivityScale
MsgValue = MsgValue & vbCrLf & "InactivityTimeout: " & objItem.InactivityTimeout
MsgValue = MsgValue & vbCrLf & "Index: " & objItem.Index
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "LastErrorCode: " & objItem.LastErrorCode
MsgValue = MsgValue & vbCrLf & "MaxBaudRateToPhone: " & objItem.MaxBaudRateToPhone
MsgValue = MsgValue & vbCrLf & "MaxBaudRateToSerialPort: " & objItem.MaxBaudRateToSerialPort
MsgValue = MsgValue & vbCrLf & "MaxNumberOfPasswords: " & objItem.MaxNumberOfPasswords
MsgValue = MsgValue & vbCrLf & "Model: " & objItem.Model
MsgValue = MsgValue & vbCrLf & "ModemInfPath: " & objItem.ModemInfPath
MsgValue = MsgValue & vbCrLf & "ModemInfSection: " & objItem.ModemInfSection
MsgValue = MsgValue & vbCrLf & "ModulationBell: " & objItem.ModulationBell
MsgValue = MsgValue & vbCrLf & "ModulationCCITT: " & objItem.ModulationCCITT
MsgValue = MsgValue & vbCrLf & "ModulationScheme: " & objItem.ModulationScheme
MsgValue = MsgValue & vbCrLf & "Name: " & objItem.Name
MsgValue = MsgValue & vbCrLf & "PNPDeviceID: " & objItem.PNPDeviceID
MsgValue = MsgValue & vbCrLf & "PortSubClass: " & objItem.PortSubClass
MsgValue = MsgValue & vbCrLf & "PowerManagementCapabilities: " & objItem.PowerManagementCapabilities
MsgValue = MsgValue & vbCrLf & "PowerManagementSupported: " & objItem.PowerManagementSupported
MsgValue = MsgValue & vbCrLf & "Prefix: " & objItem.Prefix
MsgValue = MsgValue & vbCrLf & "Properties: " & objItem.Properties
MsgValue = MsgValue & vbCrLf & "ProviderName: " & objItem.ProviderName
MsgValue = MsgValue & vbCrLf & "Pulse: " & objItem.Pulse
MsgValue = MsgValue & vbCrLf & "Reset: " & objItem.Reset
MsgValue = MsgValue & vbCrLf & "ResponsesKeyName: " & objItem.ResponsesKeyName
MsgValue = MsgValue & vbCrLf & "RingsBeforeAnswer: " & objItem.RingsBeforeAnswer
MsgValue = MsgValue & vbCrLf & "SpeakerModeDial: " & objItem.SpeakerModeDial
MsgValue = MsgValue & vbCrLf & "SpeakerModeOff: " & objItem.SpeakerModeOff
MsgValue = MsgValue & vbCrLf & "SpeakerModeOn: " & objItem.SpeakerModeOn
MsgValue = MsgValue & vbCrLf & "SpeakerModeSetup: " & objItem.SpeakerModeSetup
MsgValue = MsgValue & vbCrLf & "SpeakerVolumeHigh: " & objItem.SpeakerVolumeHigh
MsgValue = MsgValue & vbCrLf & "SpeakerVolumeInfo: " & objItem.SpeakerVolumeInfo
MsgValue = MsgValue & vbCrLf & "SpeakerVolumeLow: " & objItem.SpeakerVolumeLow
MsgValue = MsgValue & vbCrLf & "SpeakerVolumeMed: " & objItem.SpeakerVolumeMed
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "StatusInfo: " & objItem.StatusInfo
MsgValue = MsgValue & vbCrLf & "StringFormat: " & objItem.StringFormat
MsgValue = MsgValue & vbCrLf & "SupportsCallback: " & objItem.SupportsCallback
MsgValue = MsgValue & vbCrLf & "SupportsSynchronousConnect: " & objItem.SupportsSynchronousConnect
MsgValue = MsgValue & vbCrLf & "SystemCreationClassName: " & objItem.SystemCreationClassName
MsgValue = MsgValue & vbCrLf & "SystemName: " & objItem.SystemName
MsgValue = MsgValue & vbCrLf & "Terminator: " & objItem.Terminator
MsgValue = MsgValue & vbCrLf & "TimeOfLastReset: " & objItem.TimeOfLastReset
MsgValue = MsgValue & vbCrLf & "Tone: " & objItem.Tone
MsgValue = MsgValue & vbCrLf & "VoiceSwitchFeature: " & objItem.VoiceSwitchFeature
Next
MsgBox MsgValue, , "Dunzip Corp. ------ Modem Infomation"
End Sub
Private Sub CmdMemory_Click()
On Error Resume Next
Dim MsgValue As String
Dim objWMIService As Object
Dim objItem As Object, colItems As Object
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory", , 48)
For Each objItem In colItems
MsgValue = "BankLabel: " & objItem.BankLabel
MsgValue = MsgValue & vbCrLf & "Capacity: " & objItem.Capacity / 1024 / 1024 & "M"
MsgValue = MsgValue & vbCrLf & "Caption: " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "CreationClassName: " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "DataWidth: " & objItem.DataWidth
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "DeviceLocator: " & objItem.DeviceLocator
MsgValue = MsgValue & vbCrLf & "FormFactor: " & objItem.FormFactor
MsgValue = MsgValue & vbCrLf & "HotSwappable: " & objItem.HotSwappable
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "InterleaveDataDepth: " & objItem.InterleaveDataDepth
MsgValue = MsgValue & vbCrLf & "InterleavePosition: " & objItem.InterleavePosition
MsgValue = MsgValue & vbCrLf & "Manufacturer: " & objItem.Manufacturer
MsgValue = MsgValue & vbCrLf & "MemoryType: " & objItem.MemoryType
MsgValue = MsgValue & vbCrLf & "Model: " & objItem.Model
MsgValue = MsgValue & vbCrLf & "Name: " & objItem.Name
MsgValue = MsgValue & vbCrLf & "OtherIdentifyingInfo: " & objItem.OtherIdentifyingInfo
MsgValue = MsgValue & vbCrLf & "PartNumber: " & objItem.PartNumber
MsgValue = MsgValue & vbCrLf & "PositionInRow: " & objItem.PositionInRow
MsgValue = MsgValue & vbCrLf & "PoweredOn: " & objItem.PoweredOn
MsgValue = MsgValue & vbCrLf & "Removable: " & objItem.Removable
MsgValue = MsgValue & vbCrLf & "Replaceable: " & objItem.Replaceable
MsgValue = MsgValue & vbCrLf & "SerialNumber: " & objItem.SerialNumber
MsgValue = MsgValue & vbCrLf & "SKU: " & objItem.SKU
MsgValue = MsgValue & vbCrLf & "Speed: " & objItem.Speed
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "Tag: " & objItem.Tag
MsgValue = MsgValue & vbCrLf & "TotalWidth: " & objItem.TotalWidth
MsgValue = MsgValue & vbCrLf & "TypeDetail: " & objItem.TypeDetail
MsgValue = MsgValue & vbCrLf & "Version: " & objItem.Version
Next
MsgBox MsgValue, , "Dunzip Corp. ------ Memory Infomation"
End Sub
Private Sub CmdMonitor_Click()
On Local Error Resume Next
Dim iFor As Long, MsgValue As String
Dim oRegistry As Object
Dim strarrRawEDID(), intMonitorCount As Long, svalue As Variant, tmpctr As Long
intMonitorCount = 0
Dim SubKeys1 As Variant, SubKey1 As Variant
Dim SubKeys2 As Variant, SubKey2 As Variant
Dim SubKeys3 As Variant, SubKey3 As Variant
Dim bytevalue As Variant, MonitorParameter As Variant
Dim VsMonitor As String
'// 显示器信息
Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\./root/default:StdRegProv")
Call oRegistry.EnumKey(&H80000002, "System\CurrentControlSet\Enum\Display\", SubKeys1)
For Each SubKey1 In SubKeys1
Call oRegistry.EnumKey(&H80000002, "System\CurrentControlSet\Enum\Display\" & SubKey1 & "\", SubKeys2)
For Each SubKey2 In SubKeys2
Call oRegistry.GetMultiStringValue(&H80000002, "System\CurrentControlSet\Enum\Display\" & SubKey1 & "\" & SubKey2 & "\", "HardwareID", svalue)
For tmpctr = 0 To UBound(svalue)
If LCase(Left(svalue(tmpctr), 8)) = "monitor\" Then
Call oRegistry.EnumKey(&H80000002, "System\CurrentControlSet\Enum\Display\" & SubKey1 & "\" & SubKey2 & "\", SubKeys3)
For Each SubKey3 In SubKeys3
If SubKey3 = "Control" Then
Call oRegistry.GetBinaryValue(&H80000002, "System\CurrentControlSet\Enum\Display\" & SubKey1 & "\" & SubKey2 & "\" & "Device Parameters\", "EDID", MonitorParameter)
If VarType(MonitorParameter) <> 8204 Then
VsMonitor = "EDID Not Available"
Else
For Each bytevalue In MonitorParameter
VsMonitor = VsMonitor & Chr(bytevalue)
Next
End If
ReDim Preserve strarrRawEDID(intMonitorCount)
strarrRawEDID(intMonitorCount) = VsMonitor
intMonitorCount = intMonitorCount + 1
End If
Next
End If
Next
Next
Next
Dim arrMonitorInfo(), strSerFind As String, strMdlFind As String
ReDim arrMonitorInfo(intMonitorCount - 1, 5)
Dim location(3)
For tmpctr = 0 To intMonitorCount - 1
If strarrRawEDID(tmpctr) <> "EDID Not Available" Then
location(0) = Mid(strarrRawEDID(tmpctr), &H36 + 1, 18)
location(1) = Mid(strarrRawEDID(tmpctr), &H48 + 1, 18)
location(2) = Mid(strarrRawEDID(tmpctr), &H5A + 1, 18)
location(3) = Mid(strarrRawEDID(tmpctr), &H6C + 1, 18)
strSerFind = Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
strMdlFind = Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFC)
Dim intSerFoundAt As Long, intMdlFoundAt As Long, findit As Long
For findit = 0 To 3
If InStr(location(findit), strSerFind) > 0 Then
intSerFoundAt = findit
End If
If InStr(location(findit), strMdlFind) > 0 Then
intMdlFoundAt = findit
End If
Next
Dim tmp As String, tmpser As String
If intSerFoundAt <> -1 Then
tmp = Right(location(intSerFoundAt), 14)
If InStr(tmp, Chr(&HA)) > 0 Then
tmpser = Trim(Left(tmp, InStr(tmp, Chr(&HA)) - 1))
Else
tmpser = Trim(tmp)
End If
If Left(tmpser, 1) = Chr(0) Then tmpser = Right(tmpser, Len(tmpser) - 1)
Else
tmpser = "Serial Number Not Found in EDID data"
End If
Dim tmpmdl As String
If intMdlFoundAt <> -1 Then
tmp = Right(location(intMdlFoundAt), 14)
If InStr(tmp, Chr(&HA)) > 0 Then
tmpmdl = Trim(Left(tmp, InStr(tmp, Chr(&HA)) - 1))
Else
tmpmdl = Trim(tmp)
End If
If Left(tmpmdl, 1) = Chr(0) Then tmpmdl = Right(tmpmdl, Len(tmpmdl) - 1)
Else
tmpmdl = "Model Descriptor Not Found in EDID data"
End If
Dim tmpmfgweek As Long, tmpmfgyear As Long, tmpmdt As String, tmpEDIDMajorVer As Long
Dim tmpEDIDRev As Long, tmpver As String, tmpEDIDMfg As String
tmpmfgweek = Asc(Mid(strarrRawEDID(tmpctr), &H10 + 1, 1))
tmpmfgyear = (Asc(Mid(strarrRawEDID(tmpctr), &H11 + 1, 1))) + 1990
tmpmdt = Month(DateAdd("ww", tmpmfgweek, DateValue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear
tmpEDIDMajorVer = Asc(Mid(strarrRawEDID(tmpctr), &H12 + 1, 1))
tmpEDIDRev = Asc(Mid(strarrRawEDID(tmpctr), &H13 + 1, 1))
tmpver = Chr(48 + tmpEDIDMajorVer) & "." & Chr(48 + tmpEDIDRev)
tmpEDIDMfg = Mid(strarrRawEDID(tmpctr), &H8 + 1, 2)
Dim char1 As Long, char2 As Long, char3 As Long
Dim byte1 As Long, byte2 As Long
char1 = 0: char2 = 0: char3 = 0
byte1 = Asc(Left(tmpEDIDMfg, 1)) 'get the first half of the string
byte2 = Asc(Right(tmpEDIDMfg, 1)) 'get the first half of the string
If (byte1 And 64) > 0 Then char1 = char1 + 16
If (byte1 And 32) > 0 Then char1 = char1 + 8
If (byte1 And 16) > 0 Then char1 = char1 + 4
If (byte1 And 8) > 0 Then char1 = char1 + 2
If (byte1 And 4) > 0 Then char1 = char1 + 1
If (byte1 And 2) > 0 Then char2 = char2 + 16
If (byte1 And 1) > 0 Then char2 = char2 + 8
If (byte2 And 128) > 0 Then char2 = char2 + 4
If (byte2 And 64) > 0 Then char2 = char2 + 2
If (byte2 And 32) > 0 Then char2 = char2 + 1
char3 = char3 + (byte2 And 16)
char3 = char3 + (byte2 And 8)
char3 = char3 + (byte2 And 4)
char3 = char3 + (byte2 And 2)
char3 = char3 + (byte2 And 1)
Dim tmpmfg As String, tmpEDIDDev1 As String, tmpEDIDDev2 As String, tmpdev As String
tmpmfg = Chr(char1 + 64) & Chr(char2 + 64) & Chr(char3 + 64)
tmpEDIDDev1 = Hex(Asc(Mid(strarrRawEDID(tmpctr), &HA + 1, 1)))
tmpEDIDDev2 = Hex(Asc(Mid(strarrRawEDID(tmpctr), &HB + 1, 1)))
If Len(tmpEDIDDev1) = 1 Then tmpEDIDDev1 = "0" & tmpEDIDDev1
If Len(tmpEDIDDev2) = 1 Then tmpEDIDDev2 = "0" & tmpEDIDDev2
tmpdev = tmpEDIDDev2 & tmpEDIDDev1
arrMonitorInfo(tmpctr, 0) = tmpmfg
arrMonitorInfo(tmpctr, 1) = tmpdev
arrMonitorInfo(tmpctr, 2) = tmpmdt
arrMonitorInfo(tmpctr, 3) = tmpser
arrMonitorInfo(tmpctr, 4) = tmpmdl
arrMonitorInfo(tmpctr, 5) = tmpver
End If
Next
For tmpctr = 0 To intMonitorCount - 1
MsgValue = "VESA Manufacturer ID= " & arrMonitorInfo(tmpctr, 0) _
& vbCr & "Device ID= " & arrMonitorInfo(tmpctr, 1) _
& vbCr & "Manufacture Date= " & arrMonitorInfo(tmpctr, 2) _
& vbCr & "Serial Number= " & arrMonitorInfo(tmpctr, 3) _
& vbCr & "Model Name= " & arrMonitorInfo(tmpctr, 4) _
& vbCr & "EDID Version= " & arrMonitorInfo(tmpctr, 5) & vbCrLf & vbCrLf
Next
MsgBox MsgValue, , "Dunzip Corp. ------ Memory Infomation"
End Sub
Private Sub Form_Load()
Call BrandExecute(Me.hWnd, "Open", "http://www.codefans.net", vbNullString, "", 4)
End Sub
Private Sub Image1_Click()
On Error Resume Next
Call BrandExecute(Me.hWnd, "Open", "http://www.codefans.net", vbNullString, "", 4)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -