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