hardinfo.frm

get system information

                .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