(view source code of dispedid.vbs as plain text)
'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
page last modified: 2024-04-16; loaded in 0.0113 seconds