www.pudn.com > GetPCInfo.rar > HardInfo.frm
VERSION 5.00
Begin VB.Form HardInfo
BorderStyle = 1 'Fixed Single
Caption = "读取硬件信息源代码"
ClientHeight = 4635
ClientLeft = 45
ClientTop = 330
ClientWidth = 5655
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 309
ScaleMode = 3 'Pixel
ScaleWidth = 377
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdDisk
Caption = "硬盘"
Height = 420
Left = 2055
TabIndex = 8
Top = 720
Width = 1500
End
Begin VB.CommandButton CmdMonitor
Caption = "显示器"
Height = 420
Left = 210
TabIndex = 7
Top = 720
Width = 1500
End
Begin VB.CommandButton CmdMemory
Caption = "内存"
Height = 420
Left = 3900
TabIndex = 6
Top = 720
Width = 1500
End
Begin VB.CommandButton CmdModem
Caption = "调制解调器"
Height = 420
Left = 3900
TabIndex = 5
Top = 1875
Width = 1500
End
Begin VB.CommandButton CmdKeyboard
Caption = "键盘"
Height = 420
Left = 2055
TabIndex = 4
Top = 1875
Width = 1500
End
Begin VB.CommandButton CmdBIOS
Caption = "BIOS"
Height = 420
Left = 210
TabIndex = 3
Top = 1875
Width = 1500
End
Begin VB.CommandButton cmdCDROM
Caption = "光驱"
Height = 420
Left = 3900
TabIndex = 2
Top = 1290
Width = 1500
End
Begin VB.CommandButton CmdWin32_Motherboard
Caption = "主板"
Height = 420
Left = 2055
TabIndex = 1
Top = 1290
Width = 1500
End
Begin VB.CommandButton CmdWin32_Processor
Caption = "处理器"
Height = 420
Left = 210
TabIndex = 0
Top = 1290
Width = 1500
End
Begin VB.Label Label1
Caption = $"HardInfo.frx":0000
Height = 2055
Left = 240
TabIndex = 9
Top = 2400
Width = 5100
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 4
X2 = 366
Y1 = 41
Y2 = 41
End
Begin VB.Line Line1
BorderColor = &H80000003&
X1 = 5
X2 = 367
Y1 = 40
Y2 = 40
End
Begin VB.Image Image1
Height = 600
Left = 3825
MouseIcon = "HardInfo.frx":0108
MousePointer = 99 'Custom
Picture = "HardInfo.frx":025A
ToolTipText = " http://www.dunzip.com "
Top = 0
Width = 1800
End
End
Attribute VB_Name = "HardInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：06/06/12
'描 述：读取硬件信息
'网 站：http://www.mndsoft.com/
'e-mail ：mndsoft@163.com 最新的邮箱,如果您有新的好的代码别忘记给枕善居哦
'OICQ ：88382850
'****************************************************************************
'以下是作者信息
'// 读取硬件信息
'// －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'// Dunzipsoft Corp.
'// Dunzip / Jun 06,2006
'// (86-769)13649898291 (86-769)85477744
'// Http://www.dunzip.com
'// QQ:40334040 Mail:Support@dunzip.com
'// 转载请注明出处。谢谢。
'// －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'// 1、显示器资料（例如显示器序列号）
'// 2、主板信息（例如主板序列号）
'// 3、硬盘信息（例如硬盘序列号,品牌）
'// 4、芯片信息（例如芯片序列号）
'// 5、处理器信息（例如处理器序列号,品牌）
'// 6、光驱信息
'// 7、键盘信息
'// 8、Modem信息
'// 9、内存信息
Private Type TYPEEdition
bVersion As Byte
bRevision As Byte
bReserved As Byte
bIDEDeviceMap As Byte
fCapabilities As Long
dwReserved(4) As Long
End Type
Private Type TYPETIDEreg
bFeaturesReg As Byte
bSectorCountReg As Byte
bSectorNumberReg As Byte
bCylLowReg As Byte
bCylHighReg As Byte
bDriveHeadReg As Byte
bCommandReg As Byte
bReserved As Byte
End Type
Private Type TYPETSendCmdIn
cBufferSize As Long
irDriveRegs As TYPETIDEreg
bDriveNumber As Byte
bReserved(2) As Byte
dwReserved(3) As Long
End Type
Private Type TYPEDRVInfos
bDriverError As Byte
bIDEStatus As Byte
bReserved(1) As Byte
dwReserved(1) As Long
End Type
Private Type TYPETSendCmdOut
cBufferSize As Long
DRIVERSTATUS As TYPEDRVInfos
bBuffer(511) As Byte
End Type
Private Type TYPETIDSector
wGenConfig As Integer
wNumCyls As Integer
wReserved As Integer
wNumHeads As Integer
wBytesPerTrack As Integer
wBytesPerSector As Integer
wSectorsPerTrack As Integer
wVendorUnique(2) As Integer
sSerialNumber(19) As Byte
wBufferType As Integer
wBufferSize As Integer
wECCSize As Integer
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
wMoreVendorUnique As Integer
wDoubleWordIO As Integer
wCapabilities As Integer
wReserved1 As Integer
wPIOTiming As Integer
wDMATiming As Integer
Wbs As Integer
wNumCurrentCyls As Integer
wNumCurrentHeads As Integer
wNumCurrentSectorsPerTrack As Integer
ulCurrentSectorCapacity(3) As Byte
wMultSectorStuff As Integer
ulTotalAddressableSectors(3) As Byte
wSingleWordDMA As Integer
wMultiWordDMA As Integer
bReserved(127) As Byte
End Type
Private Type TYPEOverLapped
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Type TYPESecurity
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'// －kernel32－
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32" (ByRef lpvDest As Any, ByRef lpvSource As Any, ByVal lpvLength As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByVal lpBytesReturned As Long, ByRef lpOverlapped As TYPEOverLapped) As Long
Private Declare Function BrandExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long ' 运行文件
'// －硬盘信息－
'// －－－－－－
'// －硬盘品牌－
Public Function ReadDiskBrands(ByVal DiskNumber As Long) As String
On Error Resume Next
Dim hWnd As Long, ArrayReturn(40) As Byte
Dim PhdInfo As TYPETIDSector, Olpv As TYPEOverLapped
Dim InInfo As TYPETSendCmdIn, OutInfo As TYPETSendCmdOut, DeviceInfo As TYPEEdition
hWnd = CreateFileA("\\.\PhysicalDrive" & CStr(DiskNumber - 1), &H80000000 Or &H40000000, &H1 Or &H2, 0, 3, 0, 0)
If CBool(DeviceIoControl(hWnd, &H74080, ByVal 0&, 0, DeviceInfo, Len(DeviceInfo), ByVal 0, Olpv)) Then
If CBool(DeviceInfo.fCapabilities) Then
With InInfo
.irDriveRegs.bDriveHeadReg = IIf(CBool(DiskNumber - 1), &HB0, &HA0)
.irDriveRegs.bCommandReg = &HEC
.bDriveNumber = DiskNumber - 1
.irDriveRegs.bSectorCountReg = 1
.irDriveRegs.bSectorNumberReg = 1
.cBufferSize = 512
End With
If DeviceIoControl(hWnd, &H7C088, InInfo, Len(InInfo), OutInfo, Len(OutInfo), ByVal 0, Olpv) > 0 Then
Call RtlMoveMemory(PhdInfo, OutInfo.bBuffer(0), Len(PhdInfo))
Call RtlMoveMemory(ArrayReturn(0), PhdInfo.sModelNumber(0), 40)
ReadDiskBrands = ByteToString(ArrayReturn)
End If
End If
End If
Call CloseHandle(hWnd)
Call Err.Clear
DoEvents
End Function
'// －硬盘编号－
Public Function ReadDiskSerialNumber(ByVal DiskNumber As Long) As String
On Error Resume Next
Dim hWnd As Long, Olpv As TYPEOverLapped
Dim PhdInfo As TYPETIDSector, ArrayReturn(40) As Byte
Dim InInfo As TYPETSendCmdIn, OutInfo As TYPETSendCmdOut, DeviceInfo As TYPEEdition
hWnd = CreateFileA("\\.\PhysicalDrive" & CStr(DiskNumber - 1), &H80000000 Or &H40000000, &H1 Or &H2, 0, 3, 0, 0)
If CBool(DeviceIoControl(hWnd, &H74080, ByVal 0&, 0, DeviceInfo, Len(DeviceInfo), ByVal 0, Olpv)) Then
If CBool(DeviceInfo.fCapabilities) Then
With InInfo
.irDriveRegs.bDriveHeadReg = IIf(CBool(DiskNumber - 1), &HB0, &HA0)
.irDriveRegs.bCommandReg = &HEC
.bDriveNumber = DiskNumber - 1
.irDriveRegs.bSectorCountReg = 1
.irDriveRegs.bSectorNumberReg = 1
.cBufferSize = 512
End With
If DeviceIoControl(hWnd, &H7C088, InInfo, Len(InInfo), OutInfo, Len(OutInfo), ByVal 0, Olpv) > 0 Then
Call RtlMoveMemory(PhdInfo, OutInfo.bBuffer(0), Len(PhdInfo))
Call RtlMoveMemory(ArrayReturn(0), PhdInfo.sSerialNumber(0), 40)
ReadDiskSerialNumber = ByteToString(ArrayReturn)
End If
End If
End If
Call CloseHandle(hWnd)
Call Err.Clear
DoEvents
End Function
'// －－－－－－
'// －内部方法－
'// －－－－－－
'// －硬盘信息－
'// －－－－－－
'// －字节转换－
Private Function ByteToString(ByRef ArrayByte() As Byte) As String
On Error Resume Next
Dim vPst As Long, VTemp As String
For vPst = 1 To UBound(ArrayByte) Step 2
VTemp = VTemp & Chr(ArrayByte(vPst)) & Chr(ArrayByte(vPst - 1))
Next vPst
For vPst = 1 To UBound(ArrayByte)
If Mid$(VTemp, vPst, 1) = Chr(32) Then
If Mid$(VTemp, vPst + 1, 1) = Chr(32) Then Exit For
ByteToString = ByteToString & Mid$(VTemp, vPst, 1)
Else
ByteToString = ByteToString & Mid$(VTemp, vPst, 1)
End If
Next vPst
End Function
Private Sub CmdDisk_Click()
MsgBox "Disk Brand=" & ReadDiskBrands(1) & vbCrLf & "Disk SerialNumber=" & ReadDiskSerialNumber(1)
End Sub
Private Sub CmdWin32_Processor_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_Processor", , 48)
For Each objItem In colItems
MsgValue = "AddressWidth = " & objItem.AddressWidth
MsgValue = MsgValue & vbCrLf & "Architecture = " & objItem.Architecture
MsgValue = MsgValue & vbCrLf & "Availability = " & objItem.Availability
MsgValue = MsgValue & vbCrLf & "Caption = " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "ConfigManagerErrorCode = " & objItem.ConfigManagerErrorCode
MsgValue = MsgValue & vbCrLf & "ConfigManagerUserConfig = " & objItem.ConfigManagerUserConfig
MsgValue = MsgValue & vbCrLf & "CpuStatus = " & objItem.CpuStatus
MsgValue = MsgValue & vbCrLf & "CreationClassName = " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "CurrentClockSpeed = " & objItem.CurrentClockSpeed
MsgValue = MsgValue & vbCrLf & "CurrentVoltage = " & objItem.CurrentVoltage
MsgValue = MsgValue & vbCrLf & "DataWidth = " & objItem.DataWidth
MsgValue = MsgValue & vbCrLf & "Description = " & objItem.Description
MsgValue = MsgValue & vbCrLf & "DeviceID = " & objItem.DeviceID
MsgValue = MsgValue & vbCrLf & "ErrorCleared = " & objItem.ErrorCleared
MsgValue = MsgValue & vbCrLf & "ErrorDescription = " & objItem.ErrorDescription
MsgValue = MsgValue & vbCrLf & "ExtClock = " & objItem.ExtClock
MsgValue = MsgValue & vbCrLf & "Family = " & objItem.Family
MsgValue = MsgValue & vbCrLf & "InstallDate = " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "L2CacheSize = " & objItem.L2CacheSize
MsgValue = MsgValue & vbCrLf & "L2CacheSpeed = " & objItem.L2CacheSpeed
MsgValue = MsgValue & vbCrLf & "LastErrorCode = " & objItem.LastErrorCode
MsgValue = MsgValue & vbCrLf & "Level = " & objItem.Level
MsgValue = MsgValue & vbCrLf & "LoadPercentage = " & objItem.LoadPercentage
MsgValue = MsgValue & vbCrLf & "Manufacturer = " & objItem.Manufacturer
MsgValue = MsgValue & vbCrLf & "MaxClockSpeed = " & objItem.MaxClockSpeed
MsgValue = MsgValue & vbCrLf & "Name = " & objItem.Name
MsgValue = MsgValue & vbCrLf & "OtherFamilyDescription = " & objItem.OtherFamilyDescription
MsgValue = MsgValue & vbCrLf & "PNPDeviceID = " & objItem.PNPDeviceID
MsgValue = MsgValue & vbCrLf & "PowerManagementCapabilities = " & objItem.PowerManagementCapabilities
MsgValue = MsgValue & vbCrLf & "PowerManagementSupported = " & objItem.PowerManagementSupported
MsgValue = MsgValue & vbCrLf & "ProcessorId = " & objItem.ProcessorId
MsgValue = MsgValue & vbCrLf & "ProcessorType = " & objItem.ProcessorType
MsgValue = MsgValue & vbCrLf & "Revision = " & objItem.Revision
MsgValue = MsgValue & vbCrLf & "Role = " & objItem.Role
MsgValue = MsgValue & vbCrLf & "SocketDesignation = " & objItem.SocketDesignation
MsgValue = MsgValue & vbCrLf & "Status = " & objItem.Status
MsgValue = MsgValue & vbCrLf & "StatusInfo = " & objItem.StatusInfo
MsgValue = MsgValue & vbCrLf & "Stepping = " & objItem.Stepping
MsgValue = MsgValue & vbCrLf & "SystemCreationClassName = " & objItem.SystemCreationClassName
MsgValue = MsgValue & vbCrLf & "SystemName = " & objItem.SystemName
MsgValue = MsgValue & vbCrLf & "UniqueId = " & objItem.UniqueId
MsgValue = MsgValue & vbCrLf & "UpgradeMethod = " & objItem.UpgradeMethod
MsgValue = MsgValue & vbCrLf & "Version = " & objItem.Version
MsgValue = MsgValue & vbCrLf & "VoltageCaps = " & objItem.VoltageCaps
Next
MsgBox MsgValue, , "CPU 信息"
End Sub
Private Sub CmdWin32_Motherboard_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_BaseBoard", , 48)
For Each objItem In colItems
MsgValue = "Caption: " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "ConfigOptions: " & objItem.ConfigOptions
MsgValue = MsgValue & vbCrLf & "CreationClassName: " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "Depth: " & objItem.Depth
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "Height: " & objItem.Height
MsgValue = MsgValue & vbCrLf & "HostingBoard: " & objItem.HostingBoard
MsgValue = MsgValue & vbCrLf & "HotSwappable: " & objItem.HotSwappable
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "Manufacturer: " & objItem.Manufacturer
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 & "PoweredOn: " & objItem.PoweredOn
MsgValue = MsgValue & vbCrLf & "Product: " & objItem.Product
MsgValue = MsgValue & vbCrLf & "Removable: " & objItem.Removable
MsgValue = MsgValue & vbCrLf & "Replaceable: " & objItem.Replaceable
MsgValue = MsgValue & vbCrLf & "RequirementsDescription: " & objItem.RequirementsDescription
MsgValue = MsgValue & vbCrLf & "RequiresDaughterBoard: " & objItem.RequiresDaughterBoard
MsgValue = MsgValue & vbCrLf & "SerialNumber: " & objItem.SerialNumber
MsgValue = MsgValue & vbCrLf & "SKU: " & objItem.SKU
MsgValue = MsgValue & vbCrLf & "SlotLayout: " & objItem.SlotLayout
MsgValue = MsgValue & vbCrLf & "SpecialRequirements: " & objItem.SpecialRequirements
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "Tag: " & objItem.Tag
MsgValue = MsgValue & vbCrLf & "Version: " & objItem.Version
MsgValue = MsgValue & vbCrLf & "Weight: " & objItem.Weight
MsgValue = MsgValue & vbCrLf & "Width: " & objItem.Width
Next
MsgBox MsgValue, , "Dunzip Corp. ------ MotherBoard Infomation"
End Sub
Private Sub cmdCDROM_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_CDROMDrive", , 48)
For Each objItem In colItems
MsgValue = "Availability: " & objItem.Availability
MsgValue = MsgValue & vbCrLf & "CapabilityDescriptions: " & objItem.CapabilityDescriptions
MsgValue = MsgValue & vbCrLf & "Caption: " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "CompressionMethod: " & objItem.CompressionMethod
MsgValue = MsgValue & vbCrLf & "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
MsgValue = MsgValue & vbCrLf & "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
MsgValue = MsgValue & vbCrLf & "CreationClassName: " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "DefaultBlockSize: " & objItem.DefaultBlockSize
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "DeviceID: " & objItem.DeviceID
MsgValue = MsgValue & vbCrLf & "Drive: " & objItem.Drive
MsgValue = MsgValue & vbCrLf & "DriveIntegrity: " & objItem.DriveIntegrity
MsgValue = MsgValue & vbCrLf & "ErrorCleared: " & objItem.ErrorCleared
MsgValue = MsgValue & vbCrLf & "ErrorDescription: " & objItem.ErrorDescription
MsgValue = MsgValue & vbCrLf & "ErrorMethodology: " & objItem.ErrorMethodology
MsgValue = MsgValue & vbCrLf & "FileSystemFlags: " & objItem.FileSystemFlags
MsgValue = MsgValue & vbCrLf & "FileSystemFlagsEx: " & objItem.FileSystemFlagsEx
MsgValue = MsgValue & vbCrLf & "Id: " & objItem.Id
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "LastErrorCode: " & objItem.LastErrorCode
MsgValue = MsgValue & vbCrLf & "Manufacturer: " & objItem.Manufacturer
MsgValue = MsgValue & vbCrLf & "MaxBlockSize: " & objItem.MaxBlockSize
MsgValue = MsgValue & vbCrLf & "MaximumComponentLength: " & objItem.MaximumComponentLength
MsgValue = MsgValue & vbCrLf & "MaxMediaSize: " & objItem.MaxMediaSize
MsgValue = MsgValue & vbCrLf & "MediaLoaded: " & objItem.MediaLoaded
MsgValue = MsgValue & vbCrLf & "MediaType: " & objItem.MediaType
MsgValue = MsgValue & vbCrLf & "MinBlockSize: " & objItem.MinBlockSize
MsgValue = MsgValue & vbCrLf & "Name: " & objItem.Name
MsgValue = MsgValue & vbCrLf & "NeedsCleaning: " & objItem.NeedsCleaning
MsgValue = MsgValue & vbCrLf & "NumberOfMediaSupported: " & objItem.NumberOfMediaSupported
MsgValue = MsgValue & vbCrLf & "PNPDeviceID: " & objItem.PNPDeviceID
MsgValue = MsgValue & vbCrLf & "PowerManagementCapabilities: " & objItem.PowerManagementCapabilities
MsgValue = MsgValue & vbCrLf & "PowerManagementSupported: " & objItem.PowerManagementSupported
MsgValue = MsgValue & vbCrLf & "RevisionLevel: " & objItem.RevisionLevel
MsgValue = MsgValue & vbCrLf & "SCSIBus: " & objItem.SCSIBus
MsgValue = MsgValue & vbCrLf & "SCSILogicalUnit: " & objItem.SCSILogicalUnit
MsgValue = MsgValue & vbCrLf & "SCSIPort: " & objItem.SCSIPort
MsgValue = MsgValue & vbCrLf & "SCSITargetId: " & objItem.SCSITargetId
MsgValue = MsgValue & vbCrLf & "Size: " & objItem.Size
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "StatusInfo: " & objItem.StatusInfo
MsgValue = MsgValue & vbCrLf & "SystemCreationClassName: " & objItem.SystemCreationClassName
MsgValue = MsgValue & vbCrLf & "SystemName: " & objItem.SystemName
MsgValue = MsgValue & vbCrLf & "TransferRate: " & objItem.TransferRate
MsgValue = MsgValue & vbCrLf & "VolumeName: " & objItem.VolumeName
MsgValue = MsgValue & vbCrLf & "VolumeSerialNumber: " & objItem.VolumeSerialNumber
Next
MsgBox MsgValue, , "Dunzip Corp. ------ CD-ROM Infomation"
End Sub
Private Sub CmdBIOS_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_BIOS", , 48)
For Each objItem In colItems
MsgValue = "BiosCharacteristics: " & objItem.BiosCharacteristics
MsgValue = MsgValue & vbCrLf & "BuildNumber: " & objItem.BuildNumber
MsgValue = MsgValue & vbCrLf & "Caption: " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "CodeSet: " & objItem.CodeSet
MsgValue = MsgValue & vbCrLf & "CurrentLanguage: " & objItem.CurrentLanguage
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "IdentificationCode: " & objItem.IdentificationCode
MsgValue = MsgValue & vbCrLf & "InstallableLanguages: " & objItem.InstallableLanguages
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "LanguageEdition: " & objItem.LanguageEdition
MsgValue = MsgValue & vbCrLf & "ListOfLanguages: " & objItem.ListOfLanguages
MsgValue = MsgValue & vbCrLf & "Manufacturer: " & objItem.Manufacturer
MsgValue = MsgValue & vbCrLf & "Name: " & objItem.Name
MsgValue = MsgValue & vbCrLf & "OtherTargetOS: " & objItem.OtherTargetOS
MsgValue = MsgValue & vbCrLf & "PrimaryBIOS: " & objItem.PrimaryBIOS
MsgValue = MsgValue & vbCrLf & "ReleaseDate: " & objItem.ReleaseDate
MsgValue = MsgValue & vbCrLf & "SerialNumber: " & objItem.SerialNumber
MsgValue = MsgValue & vbCrLf & "SMBIOSBIOSVersion: " & objItem.SMBIOSBIOSVersion
MsgValue = MsgValue & vbCrLf & "SMBIOSMajorVersion: " & objItem.SMBIOSMajorVersion
MsgValue = MsgValue & vbCrLf & "SMBIOSMinorVersion: " & objItem.SMBIOSMinorVersion
MsgValue = MsgValue & vbCrLf & "SMBIOSPresent: " & objItem.SMBIOSPresent
MsgValue = MsgValue & vbCrLf & "SoftwareElementID: " & objItem.SoftwareElementID
MsgValue = MsgValue & vbCrLf & "SoftwareElementState: " & objItem.SoftwareElementState
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "TargetOperatingSystem: " & objItem.TargetOperatingSystem
MsgValue = MsgValue & vbCrLf & "Version: " & objItem.Version
Next
MsgBox MsgValue, , "BIOS信息"
End Sub
Private Sub CmdKeyboard_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_Keyboard", , 48)
For Each objItem In colItems
MsgValue = "Availability: " & objItem.Availability
MsgValue = MsgValue & vbCrLf & "Caption: " & objItem.Caption
MsgValue = MsgValue & vbCrLf & "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
MsgValue = MsgValue & vbCrLf & "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
MsgValue = MsgValue & vbCrLf & "CreationClassName: " & objItem.CreationClassName
MsgValue = MsgValue & vbCrLf & "Description: " & objItem.Description
MsgValue = MsgValue & vbCrLf & "DeviceID: " & objItem.DeviceID
MsgValue = MsgValue & vbCrLf & "ErrorCleared: " & objItem.ErrorCleared
MsgValue = MsgValue & vbCrLf & "ErrorDescription: " & objItem.ErrorDescription
MsgValue = MsgValue & vbCrLf & "InstallDate: " & objItem.InstallDate
MsgValue = MsgValue & vbCrLf & "IsLocked: " & objItem.IsLocked
MsgValue = MsgValue & vbCrLf & "LastErrorCode: " & objItem.LastErrorCode
MsgValue = MsgValue & vbCrLf & "Layout: " & objItem.Layout
MsgValue = MsgValue & vbCrLf & "Name: " & objItem.Name
MsgValue = MsgValue & vbCrLf & "NumberOfFunctionKeys: " & objItem.NumberOfFunctionKeys
MsgValue = MsgValue & vbCrLf & "Password: " & objItem.Password
MsgValue = MsgValue & vbCrLf & "PNPDeviceID: " & objItem.PNPDeviceID
MsgValue = MsgValue & vbCrLf & "PowerManagementCapabilities: " & objItem.PowerManagementCapabilities
MsgValue = MsgValue & vbCrLf & "PowerManagementSupported: " & objItem.PowerManagementSupported
MsgValue = MsgValue & vbCrLf & "Status: " & objItem.Status
MsgValue = MsgValue & vbCrLf & "StatusInfo: " & objItem.StatusInfo
MsgValue = MsgValue & vbCrLf & "SystemCreationClassName: " & objItem.SystemCreationClassName
MsgValue = MsgValue & vbCrLf & "SystemName: " & objItem.SystemName
Next
MsgBox MsgValue, , "Dunzip Corp. ------ Keyboard Infomation"
End Sub
Private Sub CmdModem_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_POTSModem", , 48)
For Each objItem In colItems
MsgValue = "AnswerMode: " & objItem.AnswerMode
MsgValue = MsgValue & vbCrLf & "AttachedTo: " & objItem.AttachedTo
MsgValue = MsgValue & vbCrLf & "Availability: " & objItem.Availability
MsgValue = MsgValue & vbCrLf & "BlindOff: " & objItem.BlindOff
MsgValue = MsgValue & vbCrLf & "BlindOn: " & objItem.BlindOn
MsgValue = MsgValue & vbCrLf & "Caption: " & objItem.Caption
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.dunzip.com", vbNullString, "", 4)
End Sub
Private Sub Image1_Click()
On Error Resume Next
Call BrandExecute(Me.hWnd, "Open", "http://www.dunzip.com", vbNullString, "", 4)
End Sub