16,471
社区成员
发帖
与我相关
我的任务
分享
strComputer = InputBox ("Enter Machine Name")
'Some notes on the general function....
'
'Monitors are stored in HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
'
'Unfortunately, not only monitors are stored here but Video Chipsets and maybe some other stuff
'is also here.
'
'Monitors in "HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\" are organized like this:
' HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID>\<PNP_ID>\
'Since not only monitors will be found under DISPLAY sub key you need to find out which
'devices are monitors.
'This can be deterimined by looking at the value "HardwareID" located
'at HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\<PNP_ID>\
'if the device is a monitor then the "HardwareID" value will contain the data "Monitor\<VESA_Monitor_ID>"
'
'The next difficulty is that all monitors are stored here not just the one curently plugged in.
'So, if you ever switched monitors the old one(s) will still be in the registry.
'You can tell which monitor(s) are active because they will have a sub-key named "Control"
'****************************************
'
'On with the code...
'
'DISPLAY_REGKEY sets the regkey where displays are found. Don't change except for debugging
'I only change it when I am looking at a .REG file that someone sent me saying that the
'code doesn't work.
Const DISPLAY_REGKEY="HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\"
'sets the debug outfile (use format like c:\debug.txt)
Const DEBUGFILE="NUL"
'if set to 1 then output debug info to DEBUGFILE (also writes debug to screen if running under cscript.exe)
Const DEBUGMODE=0
'The ForceCscript subroutine forces execution under CSCRIPT.EXE/Prevents execution
'under WSCRIPT.EXE -- useful when debugging
'ForceCscript
DebugOut "Execution Started " & cstr(now)
wscript.echo GetMonitorInfo() 'just write the output to screen
DebugOut "Execution Completed " & cstr(now)
'This is the main function. It calls everything else
'in the correct order.
Function GetMonitorInfo()
debugout "Getting all display devices"
arrAllDisplays=GetAllDisplayDevicesInReg()
debugout "Filtering display devices to monitors"
arrAllMonitors=GetAllMonitorsFromAllDisplays(arrAllDisplays)
debugout "Filtering monitors to active monitors"
arrActiveMonitors=GetActiveMonitorsFromAllMonitors(arrAllMonitors)
if ubound(arrActiveMonitors)=0 and arrActiveMonitors(0)="{ERROR}" then
debugout "No active monitors found"
strFormattedMonitorInfo="[Monitor_1]" & vbcrlf & "Monitor=Not Found" & vbcrlf & vbcrlf
else
debugout "Found active monitors"
debugout "Retrieving EDID for all active monitors"
arrActiveEDID=GetEDIDFromActiveMonitors(arrActiveMonitors)
debugout "Parsing EDID/Windows data"
arrParsedMonitorInfo=GetParsedMonitorInfo(arrActiveEDID,arrActiveMonitors)
debugout "Formatting parsed data"
strFormattedMonitorInfo=GetFormattedMonitorInfo(arrParsedMonitorInfo)
end if
debugout "Data retrieval completed"
GetMonitorInfo=strFormattedMonitorInfo
end function
'this function formats the parsed array for display
'this is where the final output is generated
'it is the one you will most likely want to
'customize to suit your needs
Function GetFormattedMonitorInfo(arrParsedMonitorInfo)
for tmpctr=0 to ubound(arrParsedMonitorInfo)
tmpResult=split(arrParsedMonitorInfo(tmpctr),"|||")
tmpOutput=tmpOutput & "[Monitor_" & cstr(tmpctr+1) & "]" & vbcrlf
tmpOutput=tmpOutput & "EDID_VESAManufacturerID=" & tmpResult(1) & vbcrlf
tmpOutput=tmpOutput & "EDID_SerialNumber=" & tmpResult(0) & vbcrlf
tmpOutput=tmpOutput & "EDID_ModelName=" & tmpResult(2) & vbcrlf
next
GetFormattedMonitorInfo=tmpOutput
End Function
'This function returns an array of all subkeys of the
'regkey defined by DISPLAY_REGKEY
'(typically this should be "HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY")
Function GetAllDisplayDevicesInReg()
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
arrtmpkeys=RegEnumKeys(DISPLAY_REGKEY)
if vartype(arrtmpkeys)<>8204 then
arrResult(0)="{ERROR}"
GetAllDisplayDevicesInReg=false
debugout "Display=Can't enum subkeys of display regkey"
else
for tmpctr=0 to ubound(arrtmpkeys)
arrtmpkeys2=RegEnumKeys(DISPLAY_REGKEY & arrtmpkeys(tmpctr))
for tmpctr2 = 0 to ubound(arrtmpkeys2)
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=DISPLAY_REGKEY & arrtmpkeys(tmpctr) & "\" & arrtmpkeys2(tmpctr2)
debugout "Display=" & arrResult(intArrResultIndex)
next
next
end if
GetAllDisplayDevicesInReg=arrResult
End Function
'This function is passed an array of regkeys as strings
'and returns an array containing only those that have a
'hardware id value appropriate to a monitor.
Function GetAllMonitorsFromAllDisplays(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
if IsDisplayDeviceAMonitor(arrRegKeys(tmpctr)) then
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=arrRegKeys(tmpctr)
debugout "Monitor=" & arrResult(intArrResultIndex)
end if
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "Monitor=Unable to locate any monitors"
end if
GetAllMonitorsFromAllDisplays=arrResult
End Function
'this function is passed a regsubkey as a string
'and determines if it is a monitor
'returns boolean
Function IsDisplayDeviceAMonitor(strDisplayRegKey)
arrtmpResult=RegGetMultiStringValue(strDisplayRegKey,"HardwareID")
strtmpResult="|||" & join(arrtmpResult,"|||") & "|||"
if instr(lcase(strtmpResult),"|||monitor\")=0 then
debugout "MonitorCheck='" & strDisplayRegKey & "'|||is not a monitor"
IsDisplayDeviceAMonitor=false
else
debugout "MonitorCheck='" & strDisplayRegKey & "'|||is a monitor"
IsDisplayDeviceAMonitor=true
end if
End Function
'This function is passed an array of regkeys as strings
'and returns an array containing only those that have a
'subkey named "Control"...establishing that they are current.
Function GetActiveMonitorsFromAllMonitors(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
if IsMonitorActive(arrRegKeys(tmpctr)) then
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=arrRegKeys(tmpctr)
debugout "ActiveMonitor=" & arrResult(intArrResultIndex)
end if
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "ActiveMonitor=Unable to locate any active monitors"
end if
GetActiveMonitorsFromAllMonitors=arrResult
End Function
'this function is passed a regsubkey as a string
'and determines if it is an active monitor
'returns boolean
Function IsMonitorActive(strMonitorRegKey)
arrtmpResult=RegEnumKeys(strMonitorRegKey)
strtmpResult="|||" & join(arrtmpResult,"|||") & "|||"
if instr(lcase(strtmpResult),"|||control|||")=0 then
debugout "ActiveMonitorCheck='" & strMonitorRegKey & "'|||is not active"
IsMonitorActive=false
else
debugout "ActiveMonitorCheck='" & strMonitorRegKey & "'|||is active"
IsMonitorActive=true
end if
End Function
'This function is passed an array of regkeys as strings
'and returns an array containing the corresponding contents
'of the EDID value (in string format) for the "Device Parameters"
'subkey of the specified key
Function GetEDIDFromActiveMonitors(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
strtmpResult=GetEDIDForMonitor(arrRegKeys(tmpctr))
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=strtmpResult
debugout "GETEDID=" & arrRegKeys(tmpctr) & "|||EDID,Yes"
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "EDID=Unable to retrieve any edid"
end if
GetEDIDFromActiveMonitors=arrResult
End Function
'given the regkey of a specific monitor
'this function returns the EDID info
'in string format
Function GetEDIDForMonitor(strMonitorRegKey)
arrtmpResult=RegGetBinaryValue(strMonitorRegKey & "\Device Parameters","EDID")
if vartype(arrtmpResult) <> 8204 then
debugout "GetEDID=No EDID Found|||" & strMonitorRegKey
GetEDIDForMonitor="{ERROR}"
else
for each bytevalue in arrtmpResult
strtmpResult=strtmpResult & chr(bytevalue)
next
debugout "GetEDID=EDID Found|||" & strMonitorRegKey
debugout "GetEDID_Result=" & GetHexFromString(strtmpResult)
GetEDIDForMonitor=strtmpResult
end if
End Function
'passed a given string this function
'returns comma seperated hex values
'for each byte
Function GetHexFromString(strText)
for tmpctr=1 to len(strText)
tmpresult=tmpresult & right( "0" & hex(asc(mid(strText,tmpctr,1))),2) & ","
next
GetHexFromString=left(tmpresult,len(tmpresult)-1)
End Function
'this function should be passed two arrays with the same
'number of elements. array 1 should contain the
'edid information that corresponds to the active monitor
'regkey found in the same element of array 2
'Why not use a 2D array or a dictionary object?.
'I guess I'm just lazy
Function GetParsedMonitorInfo(arrActiveEDID,arrActiveMonitors)
dim arrResult()
for tmpctr=0 to ubound(arrActiveEDID)
strSerial=GetSerialFromEDID(arrActiveEDID(tmpctr))
strMfg=GetMfgFromEDID(arrActiveEDID(tmpctr))
strModel=GetModelFromEDID(arrActiveEDID(tmpctr))
redim preserve arrResult(tmpctr)
arrResult(tmpctr)=arrResult(tmpctr) & strSerial & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strMfg & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strModel & "|||"
debugout arrResult(tmpctr)
next
GetParsedMonitorInfo=arrResult
End Function