'Option Explicit Dim blnControl Dim i, j, k Dim arrControl, arrKeys, arrRawEDID, arrSubKeys Dim objReg, wshShell Dim strComputer, strDeviceDesc, strMfg, strModel, strMsg, strKeyPath, strSerial, strSubKeyPath, strSubSubKeyPath 'Hive Constants Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_PERFORMANCE_DATA = &H80000004 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006 'RegFormat Constants Const REG_NONE = 0 Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3 Const REG_DWORD = 4 Const REG_DWORD_LITTLE_ENDIAN = 4 Const REG_DWORD_BIG_ENDIAN = 5 Const REG_LINK = 6 Const REG_MULTI_SZ = 7 Const REG_RESOURCE_LIST = 8 If WScript.Arguments.Count > 0 Then Syntax strComputer = "127.0.0.1" strMsg = "" Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" ) strKeyPath = "SYSTEM\CurrentControlSet\Enum\DISPLAY" objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrKeys If IsArray( arrKeys ) Then For i = 0 To UBound( arrKeys ) strSubKeyPath = strKeyPath & "\" & arrKeys( i ) objReg.EnumKey HKEY_LOCAL_MACHINE, strSubKeyPath, arrSubKeys If IsArray( arrSubKeys ) Then For j = 0 To UBound( arrSubKeys ) strSubSubKeyPath = strSubKeyPath & "\" & arrSubKeys( j ) objReg.EnumKey HKEY_LOCAL_MACHINE, strSubSubKeyPath, arrSub2 blnControl = False If IsArray( arrSub2 ) Then For k = 0 To UBound( arrSub2 ) If arrSub2(k) = "Control" Then blnControl = True Next End If If blnControl Then objReg.GetStringValue HKEY_LOCAL_MACHINE, strSubSubKeyPath, "Mfg", strMfg If IsNull( strMfg ) Then strMfg = "unknown" If InStr( strMfg, ";" ) Then strMfg = Mid( strMfg, InStr( strMfg, ";" ) + 1 ) objReg.GetStringValue HKEY_LOCAL_MACHINE, strSubSubKeyPath, "DeviceDesc", strDeviceDesc If InStr( strDeviceDesc, ";" ) Then strDeviceDesc = Mid( strDeviceDesc, InStr( strDeviceDesc, ";" ) + 1 ) objReg.GetBinaryValue HKEY_LOCAL_MACHINE, strSubSubKeyPath & "\Device Parameters", "BAD_EDID", arrBadEDID If Not IsArray( arrBadEDID ) Then objReg.GetBinaryValue HKEY_LOCAL_MACHINE, strSubSubKeyPath & "\Device Parameters", "EDID", arrRawEDID If IsArray( arrRawEDID ) Then Test 54 Test 72 Test 90 Test 108 End If strMsg = strMsg & vbCrLf _ & "Manufacturer = " & strMfg & vbCrLf _ & "Description = " & strDeviceDesc & vbCrLf _ & "Model (EDID) = " & strModel & vbCrLf _ & "Serial# (EDID) = " & strSerial & vbCrLf End If End If Next End If Next End If WScript.Echo strMsg Sub Test( ByVal myIndex ) Dim idx, arrTemp, arrTestModel, arrTestSerial, blnModel, blnSerial, strTemp arrTestModel = Split( "0 0 0 252" ) arrTestSerial = Split( "0 0 0 255" ) blnModel = True blnSerial = True For idx = 0 To 3 If CInt( arrTestModel( idx ) ) <> CInt( arrRawEDID( idx + myIndex ) ) Then blnModel = False If CInt( arrTestSerial( idx ) ) <> CInt( arrRawEDID( idx + myIndex ) ) Then blnSerial = False Next If blnModel Or blnSerial Then For idx = 4 To 17 Select Case arrRawEDID( myIndex + idx ) Case 0 strTemp = strTemp & " " Case 7 strTemp = strTemp & " " Case 10 strTemp = strTemp & " " Case 13 strTemp = strTemp & " " Case Else strTemp = strTemp & Chr( arrRawEDID( myIndex + idx ) ) End Select Next strTemp = Trim( strTemp ) ' The following lines are disabled because they truncate model names at the first space 'If InStr( strTemp, " " ) Then ' arrTemp = Split( strTemp, " " ) ' strTemp = arrTemp(0) 'End If If blnModel Then strModel = strTemp If blnSerial Then strSerial = strTemp End If End Sub Sub Syntax strMsg = vbCrLf _ & "DispEDID.vbs, Version 2.30" _ & vbCrLf _ & "Read and parse monitor EDID asset information from the registry" _ & vbCrLf & vbCrLf _ & "Usage: DISPEDID.VBS" _ & vbCrLf & vbCrLf _ & "Based on a script by Michael Baird (link no longer available)" _ & vbCrLf & vbCrLf _ & "(Re)written by Rob van der Woude" _ & vbCrLf _ & "http://www.robvanderwoude.com" WScript.Echo strMsg WScript.Quit 1 End Sub