Voor0ck Posted March 23, 2010 Share Posted March 23, 2010 Hi folks,With this code, i can know the PC serial number :;Fonction pour recuperer le serial numberFunc _Get_SN()Local $colItems = "" $colItems = $objWMIService.ExecQuery("Select * from Win32_BIOS") For $objItem in $colItems Local $item = $objItem.SerialNumber FileWriteLine($file1,"S/N du PC : " & $Item) NextEndFuncIs there any code like this, to find the computer screen serial number ?Thx. Link to comment Share on other sites More sharing options...
BoogY Posted March 23, 2010 Share Posted March 23, 2010 I have a script but in .vbs and i couldent convert it in to autoit.. But may be this can help you. expandcollapse popup'***************************************************************************** ' Monitor EDID Information v2.1' ' coded by Michael Baird ' modified by Maxime bouchard ' ' Creation : 20-September-2005 ' Modification : 16 january 2006 ' ' Add-on by Maxime Bouchard, Technologist In System Processed ' ' - Network Range Computer Scan ' - Generate Rapport in Plain text format ' - Generate Rapport in HTML format ' - Local scan ' - clear some useless code ' - user interface (popup dialog box) ' - add logo ' - time out management ' - time out error logged ' 'All code here in is copyleft 2006 'and is released under the terms of the GNU open source 'license agreement '****************************************************************************** ' START INFORMATION '****************************************************************************** 'If you are trying to customize the output for your specific needs 'check the function named "" 'It is probably all you need to change ' ' 'This is a complete re-write of the script I originally relased 17-June-2004 'It should function much more reliably and work better with multiple monitors 'The code has been modularized and streamlined for easier readability and debugging 'several bugs have been eliminated. 'There was really no excuse for the sheer ugliness of the original code. 'I will only say that I was figuring it out as I went along and I was really tired 'because SWMBO was out of town and I tend to pull all-nighters when she's not around 'to resue me from my PC and myself. ' 'Please give me credit if you use my code 'Please don't profit financially from my code (at least not ridiculously) ' ' 'this code is based on the EEDID spec found at http://www.vesa.org 'and by my hacking around in the windows registry 'the code was tested on WINXP,WIN2K and WIN2K3 'it should work on WINME and WIN98SE 'It should work with multiple monitors, but that hasn't been tested either. ' ' 'It should be noted that this code is not 100% reliable (what is?) 'I have witnessed occasions where for one reason or another windows 'can't or doesn't read the EDID info at boot (example would be someone 'booting with the monitor turned off) and so windows changes the active 'monitor to "Default_Monitor" 'Another reason for reliability problems is that there is no 'requirement in the EDID spec that a manufacture include the 'serial number in the EDID data AND only EDIDv1.2 and beyond 'have a requirement that the EDID contain a descriptive 'model name 'That being said, here goes.... ' ' 'Some notes on the general function.... ' 'Monitors are stored in HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\ ' 'Unfortunately, not only monitors are stored here 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\\\ '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\\ 'if the device is a monitor then the "HardwareID" value will contain the data "Monitor\" ' '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" '****************************************************************************** ' END INFORMATION - THE CODE START HERE '******************************************************************************* ' GLOBALE VARIABLE AND CONSTANTE - DON'T ERASE IT !!!!!!! '******************************************************************************* '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 '******************************************************************************* ' GLOBALE VARIABLE AND CONSTANTE - DON'T ERASE IT !!!!!!! ' by Maxime Bouchard - 11 january 2006 ' Do not erase - GLOBAL VARIBLE - DO NOT MODIFIE !!!!!!!!!!! 'used by GetMonitorInfo() and GetWMIRegProvider() '******************************************************************************* strGPN = "localhost" ' Name of computer GenererRapport = 0 ' toggle for rapport file = "C:\\Monitor" ' dorectory to stock rapport xpc = 0 ' number of PC to scan abort = 0 ' abort the process OutputFormat = ".txt" ' Output format genererHTML = 0 ' generate HTML File or TXT file Dim myArrays() ' Arrays list with PC computer name Const GENERATED_MAIN_LIST_NAME = "COMPUTERLIST.html" ' startup logo and licence logo = "************************************************************************" & VbCrLf & _ "Monitor EDID Information v2 coded by Michael Baird" & VbCrLf & _ "Modified by Maxime bouchard" & VbCrLf licence = "All code herein is copyleft 2006" & vbcrlf & _ "and is released under the terms of the GNU open source license agreement" & VbCrLf & _ "************************************************************************" '******************************************************************************* ' CALL OF FUNCTION HERE '******************************************************************************* 'The ForceCscript subroutine forces execution under CSCRIPT.EXE call ForceCScript ' start the main Sub ' modified by Maxime Bouchard - 11 january 2006 DebugOut "Execution Started " & cstr(now) WScript.Echo logo WScript.Echo licence call Start(RemoteLocalChoice()) DebugOut "Execution Completed " & cstr(now) '******************************************************************************* ' ALL FUNCTION AND SUB START HERE '******************************************************************************* '=================================================================== 'This is the start Sub ' ' by Maxime Bouchard ' 13 january 2006 - for a network scan loop support '=================================================================== Sub Start(myArrays) If abort = 0 Then Call RapportChoice If abort = 1 Then Wscript.Quit ' quit if user choose Cancel in rapportChoice 'WScript.Echo "Please Wait..." & VbCrLf On Error Resume Next ' On erreur or no reponse the GPN is skiped For Each strComputer In myArrays If strComputer <> lastComputer Then ' Duplicata are skipped If strComputer <> "" Then WScript.Echo "Please wait...trying to contact computer : " & strComputer wscript.echo GetMonitorInfo(strComputer) lastcomputer = strcomputer End if End If Next If genererrapport = 0 Then WScript.Echo "programme terminated" Pause() Else WScript.Echo "Generate the Rapport...Please Wait" MainRapport ' Generate a list of computer WScript.Echo "programme terminated" End If Else WScript.Echo "Abort by user !" End If End Sub '=================================================================== 'This is the Sub to chose if it is a Remote or local connection ' ' by Maxime Bouchard ' 13 january 2006 - for a network scan loop support '=================================================================== function RemoteLocalChoice Set WshNetwork = WScript.CreateObject("WScript.Network") strCname = WshNetwork.ComputerName 'catch local computer name strCname2 = "" ypc = 0 answer = MsgBox("Hi " & WshNetwork.UserName & VbCrLf & _ "Do you would like execute a remote scan ?" _ ,vbYesNo,"Serial Number for Monitor Scan") If answer = vbYes Then ' if remote answer2 = MsgBox("WARNING - this procedure can be VERY long if you" & _ "enter a large range of computer" & VbCrLf & _ "Do you would like start it ?",vbYesNo,"WARNING") If answer2 = vbYes Then ' if proceed strx = inputbox("How many computer do you would like scan ?","Number of computer","1") If strx = "" Then abort = 1 'abort xpc = CInt(strx) ReDim Preserve myArrays(xpc - 1) While ypc < xpc strcomputername = (inputbox("Enter a Computer name :" & VbCrLf & strCname2, ypc & _ " of " & xpc & " computers",strCname)) If cstr(strcomputername) <> "" Then strCname2 = strCname2 & ypc + 1 & ". " & strcomputername & VbCrLf myArrays(ypc) = strcomputername ypc = ypc + 1 Else abort = 1 'abort ypc = xpc ' for exit of the loop End if Wend Else ' abort abort = 1 End If Else ' if local ReDim myArrays(1) myArrays(0) = strCname End If RemoteLocalChoice=myArrays End Function '=================================================================== 'This is the Rapport Sub ' ' by Maxime Bouchard ' 13 january 2006 - for a network scan loop support '=================================================================== Sub Rapport(tmpOutput,strGPN) Dim fso, MyFile Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(file) = False Then fso.CreateFolder(File) End If Set MyFile= fso.CreateTextFile(File & "\\" & strGPN & OutputFormat,true) MyFile.Writeline(tmpOutput) MyFile.Close End Sub '=================================================================== 'This is the RapportChoice Sub ' ' by Maxime Bouchard ' 13 january 2006 - for a network scan loop support '=================================================================== Sub RapportChoice answer = MsgBox("do you would like generate log files ?",vbYesNo,"GENERATE LOG ?") if answer = vbYes Then genererRapport = 1 answer = MsgBox("generate it in HTML or TXT Format ?" & VbCrLf & _ "YES = HTML" & VbCrLf & "NO = TXT",vbYesNo,"HTML or TXT ?") If answer = vbYes Then genererHTML = 1 OutputFormat = ".html" End If file = InputBox("Enter a directory to stock log files","Which Directory ?",file) If file = "" Then abort = 1 'abort End If End Sub '=================================================================== 'This is the main function. It calls everything else 'in the correct order. ' ' modified by Maxime Bouchard ' 11 january 2006 - for a network scan loop support '=================================================================== Function GetMonitorInfo(strComputer) ' an Array to stock GPN Name 'On Error Resume Next ' On erreur or no reponse the GPN is skiped 'For Each strComputer In myArrays 'used by GetWMIRegProvider() strGPN = cstr(strComputer) 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 'Next 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 ' 'modified by Maxime Bouchard ' 13 january 2006 - add txt rapport Function ' 14 january 2006 - add HTML rapport function '=================================================================== Function GetFormattedMonitorInfo(arrParsedMonitorInfo) Dim tmpallout Dim pcArrays() ' For Console and TXT FORMAT tmpOutput=tmpOutput & "********************************" & VbCrLf tmpOutput=tmpOutput & "Computer : " & strGPN & " in date of :" & cstr(Date) & " " & CStr(time) & VbCrLf tmpOutput=tmpOutput & "********************************" & VbCrLf ' FOR HTML RAPPORT strHTML = strHTML & "<html>" & VbCrLf strHTML = strHTML & "<head>" & VbCrLf strHTML = strHTML & "<title>" & "Computer: " & strGPN & " in date of :"& cstr(Date) & " " & CStr(time) & "</title>" & VbCrLf strHTML = strHTML & "</head>" & VbCrLf strHTML = strHTML & "<body>" & VbCrLf strHTML = strHTML & "<p><font size='5'>Computer: " & strGPN & " in date of :" & cstr(Date) & " " & CStr(time) & "</font></p>" & VbCrLf For tmpctr=0 To ubound(arrParsedMonitorInfo) tmpResult=split(arrParsedMonitorInfo(tmpctr),"|||") ' FOR HTML RAPPORT strHTML = strHTML & "<p><font size='5'>[ Monitor_" & cstr(tmpctr+1) & "]</font></p>" & VbCrLf strHTML = strHTML & "<table border='1' width='44%' id='table1'>" strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_VESAManufacturerID</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(1) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_DeviceID</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(3) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_ManufactureDate</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(2) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_SerialNumber :</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(0) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_ModelName :</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(4) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>EDID_Version :</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(5) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>Windows_VESAID :</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(6) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "<tr>" & VbCrLf strHTML = strHTML & "<td width='199'>Windows_PNPID :</td>" & VbCrLf strHTML = strHTML & "<td>" & tmpResult(7) & "</td>" & VbCrLf strHTML = strHTML & "</tr>" & VbCrLf strHTML = strHTML & "</table>" & VbCrLf strHTML = strHTML & "</body>" & VbCrLf strHTML = strHTML & "</html>" & VbCrLf ' For Console and TXT FORMAT tmpOutput=tmpOutput & "[ Monitor_" & cstr(tmpctr+1) & " ]" & VbCrLf & VbCrLf tmpOutput=tmpOutput & "EDID_VESAManufacturerID : " & tmpResult(1) & VbCrLf tmpOutput=tmpOutput & "EDID_DeviceID : " & tmpResult(3) & VbCrLf tmpOutput=tmpOutput & "EDID_ManufactureDate : " & tmpResult(2) & VbCrLf tmpOutput=tmpOutput & "EDID_SerialNumber : " & tmpResult(0) & VbCrLf tmpOutput=tmpOutput & "EDID_ModelName : " & tmpResult(4) & VbCrLf tmpOutput=tmpOutput & "EDID_Version : " & tmpResult(5) & VbCrLf tmpOutput=tmpOutput & "Windows_VESAID : " & tmpResult(6) & VbCrLf tmpOutput=tmpOutput & "Windows_PNPID : " & tmpResult(7) & VbCrLf & VbCrLf Next ' For Console and TXT FORMAT tmpOutput=tmpOutput & "****** END INFO ON " & strGPN & " ******" & VbCrLf & VbCrLf ' Call for rapport generation If GenererRapport = 1 Then If genererHTML = 0 Then Rapport tmpOutput,strGPN ' PLAIN TEXT Else Rapport strHTML,strGPN ' HTML FORMAT End If End If GetFormattedMonitorInfo=tmpOutput End Function '=================================================================== 'This is the sub to generate HTML list of computer scanned and open it ' ' by Maxime Bouchard ' 14 january 2006 '=================================================================== Sub MainRapport Dim fso, MyFile dim lastComputer ' create MainRapport Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(file) = False Then fso.CreateFolder(File) End If Set MyFile= fso.CreateTextFile(File & "\\" & GENERATED_MAIN_LIST_NAME,true) MyFile.Writeline("<html>") MyFile.Writeline("<head>") MyFile.WriteLine("<meta http-equiv='Content-Type' content='text/html; charset=windows-1252'>") MyFile.WriteLine("<title>HTMLRapport</title>") MyFile.WriteLine("</head>") MyFile.WriteLine("<body>") MyFile.WriteLine("<p><font size='5'>The Last Computer Scanned in date of :" & Date & "</font></p>") For Each strComputer In myArrays If strComputer <> lastComputer Then MyFile.WriteLine("<p><a href='file:///" & file & "/" & strComputer & Outputformat & "'> Computer : " & strComputer & "</a></p>") End If lastComputer = strComputer Next MyFile.WriteLine("</body>") MyFile.WriteLine("</html>") MyFile.Close ' execute Rapport If (MsgBox("Do you would like open the rapport ?",vbYesNo,"Open Rapport ?") = vbYes) Then WScript.Echo File & "\\" & GENERATED_MAIN_LIST_NAME ' set Wshshell= WScript.createobject("wscript.shell") retcode = Wshshell.run (File & "\\" & GENERATED_MAIN_LIST_NAME, 1, TRUE) Else WScript.Echo File & "\\" & GENERATED_MAIN_LIST_NAME Pause() End If End Sub '=================================================================== '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)) strMfgDate=GetMfgDateFromEDID(arrActiveEDID(tmpctr)) strDev=GetDevFromEDID(arrActiveEDID(tmpctr)) strModel=GetModelFromEDID(arrActiveEDID(tmpctr)) strEDIDVer=GetEDIDVerFromEDID(arrActiveEDID(tmpctr)) strWinVesaID=GetWinVESAIDFromRegKey(arrActiveMonitors(tmpctr)) strWinPNPID=GetWinPNPFromRegKey(arrActiveMonitors(tmpctr)) redim preserve arrResult(tmpctr) arrResult(tmpctr)=arrResult(tmpctr) & strSerial & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strMfg & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strMfgDate & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strDev & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strModel & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strEDIDVer & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strWinVesaID & "|||" arrResult(tmpctr)=arrResult(tmpctr) & strWinPNPID debugout arrResult(tmpctr) next GetParsedMonitorInfo=arrResult End Function '=================================================================== 'this is a simple string function to break the VESA monitor ID 'from the registry key '=================================================================== Function GetWinVESAIDFromRegKey(strRegKey) if strRegKey="{ERROR}" then GetWinVESAIDFromRegKey="Bad Registry Info" exit Function end if strtmpResult=right(strRegKey,len(strRegkey)-len(DISPLAY_REGKEY)) strtmpResult=left(strtmpResult,instr(strtmpResult,"\")-1) GetWinVESAIDFromRegKey=strtmpResult End Function '=================================================================== 'this is a simple string function to break windows PNP device id 'from the registry key '=================================================================== Function GetWinPNPFromRegKey(strRegKey) if strRegKey="{ERROR}" then GetWinPNPFromRegKey="Bad Registry Info" exit function end if strtmpResult=right(strRegKey,len(strRegkey)-len(DISPLAY_REGKEY)) strtmpResult=right(strtmpResult,len(strtmpResult)-instr(strtmpResult,"\")) GetWinPNPFromRegKey=strtmpResult End Function '=================================================================== 'utilizes the GetDescriptorBlockFromEDID function 'to retrieve the serial number block 'from the EDID data '=================================================================== Function GetSerialFromEDID(strEDID) 'a serial number descriptor will start with &H00 00 00 ff strTag=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff) GetSerialFromEDID=GetDescriptorBlockFromEDID(strEDID,strTag) End Function '=================================================================== 'utilizes the GetDescriptorBlockFromEDID function 'to retrieve the model description block 'from the EDID data '=================================================================== Function GetModelFromEDID(strEDID) 'a model number descriptor will start with &H00 00 00 fc strTag=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc) GetModelFromEDID=GetDescriptorBlockFromEDID(strEDID,strTag) End Function '=================================================================== 'This function parses a string containing EDID data 'and returns the information contained in one of the '4 custom "descriptor blocks" providing the data in the 'block is tagged wit a certain prefix 'if no descriptor is tagged with the specified prefix then 'function returns "Not Present in EDID" 'otherwise it returns the data found in the descriptor 'trimmed of its prefix tag and also trimmed of 'leading NULLs (chr(0)) and trailing linefeeds (chr(10)) '=================================================================== Function GetDescriptorBlockFromEDID(strEDID,strTag) if strEDID="{ERROR}" then GetDescriptorBlockFromEDID="Bad EDID" exit Function End If 'There are 4 descriptor blocks in edid at offset locations '&H36 &H48 &H5a and &H6c each block is 18 bytes long 'the model and serial numbers are stored in the vesa descriptor 'blocks in the edid. dim arrDescriptorBlock(3) arrDescriptorBlock(0)=mid(strEDID,&H36+1,18) arrDescriptorBlock(1)=mid(strEDID,&H48+1,18) arrDescriptorBlock(2)=mid(strEDID,&H5a+1,18) arrDescriptorBlock(3)=mid(strEDID,&H6c+1,18) if instr(arrDescriptorBlock(0),strTag)>0 then strFoundBlock=arrDescriptorBlock(0) elseif instr(arrDescriptorBlock(1),strTag)>0 then strFoundBlock=arrDescriptorBlock(1) elseif instr(arrDescriptorBlock(2),strTag)>0 then strFoundBlock=arrDescriptorBlock(2) elseif instr(arrDescriptorBlock(3),strTag)>0 then strFoundBlock=arrDescriptorBlock(3) else GetDescriptorBlockFromEDID="Not Present in EDID" exit function end if strResult=right(strFoundBlock,14) 'the data in the descriptor block will either fill the 'block completely or be terminated with a linefeed (&h0a) if instr(strResult,chr(&H0a))>0 then strResult=trim(left(strResult,instr(strResult,chr(&H0a))-1)) else strResult=trim(strResult) end if 'although it is not part of the edid spec (as far as i can tell) it seems as though the 'information in the descriptor will frequently be preceeded by &H00, this 'compensates for that if left(strResult,1)=chr(0) then strResult=right(strResult,len(strResult)-1) GetDescriptorBlockFromEDID=strResult End Function '=================================================================== 'This function parses a string containing EDID data 'and returns the VESA manufacturer ID as a string 'the manufacturer ID is a 3 character identifier 'assigned to device manufacturers by VESA 'I guess that means you're not allowed to make an EDID 'compliant monitor unless you belong to VESA. '=================================================================== Function GetMfgFromEDID(strEDID) if strEDID="{ERROR}" then GetMfgFromEDID="Bad EDID" exit function end If 'the mfg id is 2 bytes starting at EDID offset &H08 'the id is three characters long. using 5 bits to represent 'each character. the bits are used so that 1=A 2=B etc.. ' 'get the data tmpEDIDMfg=mid(strEDID,&H08+1,2) 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 'now shift the bits 'shift the 64 bit to the 16 bit if (Byte1 and 64) > 0 then Char1=Char1+16 'shift the 32 bit to the 8 bit if (Byte1 and 32) > 0 then Char1=Char1+8 'etc.... 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 'the 2nd character uses the 2 bit and the 1 bit of the 1st byte if (Byte1 and 2) > 0 then Char2=Char2+16 if (Byte1 and 1) > 0 then Char2=Char2+8 'and the 128,64 and 32 bits of the 2nd byte 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 'the bits for the 3rd character don't need shifting 'we can use them as they are 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) tmpmfg=chr(Char1+64) & chr(Char2+64) & chr(Char3+64) GetMfgFromEDID=tmpmfg End Function '=================================================================== 'This function parses a string containing EDID data 'and returns the manufacture date in mm/yyyy format '=================================================================== Function GetMfgDateFromEDID(strEDID) if strEDID="{ERROR}" then GetMfgDateFromEDID="Bad EDID" exit function end if 'the week of manufacture is stored at EDID offset &H10 tmpmfgweek=asc(mid(strEDID,&H10+1,1)) 'the year of manufacture is stored at EDID offset &H11 'and is the current year -1990 tmpmfgyear=(asc(mid(strEDID,&H11+1,1)))+1990 'store it in month/year format tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear GetMfgDateFromEDID=tmpmdt End Function '=================================================================== 'This function parses a string containing EDID data 'and returns the device ID as a string '=================================================================== Function GetDevFromEDID(strEDID) if strEDID="{ERROR}" then GetDevFromEDID="Bad EDID" exit function end if 'the device id is 2bytes starting at EDID offset &H0a 'the bytes are in reverse order. 'this code is not text. it is just a 2 byte code assigned 'by the manufacturer. they should be unique to a model tmpEDIDDev1=hex(asc(mid(strEDID,&H0a+1,1))) tmpEDIDDev2=hex(asc(mid(strEDID,&H0b+1,1))) if len(tmpEDIDDev1)=1 then tmpEDIDDev1="0" & tmpEDIDDev1 if len(tmpEDIDDev2)=1 then tmpEDIDDev2="0" & tmpEDIDDev2 tmpdev=tmpEDIDDev2 & tmpEDIDDev1 GetDevFromEDID=tmpdev End Function '=================================================================== 'This function parses a string containing EDID data 'and returns the EDID version number as a string 'I should probably do this first and then not return any other data 'if the edid version exceeds 1.3 since most if this code probably 'won't work right if they change the spec drastically enough (which they probably 'won't do for backward compatability reasons thus negating my need to check and 'making this comment somewhat redundant) '=================================================================== Function GetEDIDVerFromEDID(strEDID) if strEDID="{ERROR}" then GetEDIDVerFromEDID="Bad EDID" exit function end if 'the version is at EDID offset &H12 tmpEDIDMajorVer=asc(mid(strEDID,&H12+1,1)) 'the revision level is at EDID offset &H13 tmpEDIDRev=asc(mid(strEDID,&H13+1,1)) tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev) GetEDIDVerFromEDID=tmpver End Function '=================================================================== 'simple function to provide an 'easier interface to the wmi registry functions '=================================================================== Function RegEnumKeys(RegKey) hive=SetHive(RegKey) set objReg=GetWMIRegProvider(strGPN) strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\")) objReg.EnumKey Hive, strKeyPath, arrSubKeys RegEnumKeys=arrSubKeys End Function '=================================================================== 'simple function to provide an 'easier interface to the wmi registry functions '=================================================================== Function RegGetStringValue(RegKey,RegValueName) hive=SetHive(RegKey) set objReg=GetWMIRegProvider() strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\")) tmpreturn=objReg.GetStringValue(Hive, strKeyPath, RegValueName, RegValue) if tmpreturn=0 then RegGetStringValue=RegValue else RegGetStringValue="~{{}}~" end if End Function '=================================================================== 'simple function to provide an 'easier interface to the wmi registry functions '=================================================================== Function RegGetMultiStringValue(RegKey,RegValueName) hive=SetHive(RegKey) set objReg=GetWMIRegProvider(strGPN) strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\")) tmpreturn=objReg.GetMultiStringValue(Hive, strKeyPath, RegValueName, RegValue) if tmpreturn=0 then RegGetMultiStringValue=RegValue else RegGetMultiStringValue="~{{}}~" end if End Function '=================================================================== 'simple function to provide an 'easier interface to the wmi registry functions '=================================================================== Function RegGetBinaryValue(RegKey,RegValueName) hive=SetHive(RegKey) set objReg=GetWMIRegProvider(strGPN) strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\")) tmpreturn=objReg.GetBinaryValue(Hive, strKeyPath, RegValueName, RegValue) if tmpreturn=0 then RegGetBinaryValue=RegValue else RegGetBinaryValue="~{{}}~" end if End Function '=================================================================== 'simple function to provide a wmi registry provider 'to all the other registry functions (regenumkeys, reggetstringvalue, etc...) ' ' modified by Maxime Bouchard ' 16 january 2006 - Error log support '=================================================================== Function GetWMIRegProvider(strGPN) strComputer = strGPN If strcomputer <> "" Then On Error Resume Next Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _ "\root\default:StdRegProv") If Err <> 0 Then Wscript.Echo "Error : " & Err.Number & ": The connection to computer named " & _ strComputer & " : FAILED !" & VbCrLf If GenererRapport = 1 Then ErrorLog strComputer End If End If End Function '=================================================================== 'sub create an error log file for report ' ' by Maxime Bouchard ' 16 janvier 2006 '=================================================================== sub ErrorLog(strComputer) Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(file) = False Then fso.CreateFolder(File) End If Set MyFile= fso.CreateTextFile(File & "\\" & strComputer & outputformat,true) MyFile.Writeline(date & " " & Time & " ERROR - THE CONNECTION TO " & _ strComputer & " : FAILED ! ") MyFile.Close End Sub '=================================================================== 'function to parse the specified hive 'from the registry functions above 'to all the other registry functions (regenumkeys, reggetstringvalue, etc...) '=================================================================== Function SetHive(RegKey) HKEY_CLASSES_ROOT=&H80000000 HKEY_CURRENT_USER=&H80000001 HKEY_CURRENT_CONFIG=&H80000005 HKEY_LOCAL_MACHINE=&H80000002 HKEY_USERS=&H80000003 strHive=left(RegKey,instr(RegKey,"\")) if strHive="HKCR\" or strHive="HKR\" then SetHive=HKEY_CLASSES_ROOT if strHive="HKCU\" then SetHive=HKEY_CURRENT_USER if strHive="HKCC\" then SetHive=HKEY_CURRENT_CONFIG if strHive="HKLM\" then SetHive=HKEY_LOCAL_MACHINE if strHive="HKU\" then SetHive=HKEY_USERS End Function '=================================================================== 'this sub forces execution under cscript 'it can be useful for debugging if your machine's 'default script engine is set to wscript '=================================================================== Sub ForceCScript strCurrScriptHost=lcase(right(wscript.fullname,len(wscript.fullname)-len(wscript.path)-1)) if strCurrScriptHost<>"cscript.exe" then set objFSO=CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("WScript.Shell") Set objArgs = WScript.Arguments strExecCmdLine=wscript.path & "\cscript.exe //nologo " & objfso.getfile(wscript.scriptfullname).shortpath For argctr = 0 to objArgs.Count - 1 strExecArg=objArgs(argctr) if instr(strExecArg," ")>0 then strExecArg=chr(34) & strExecArg & chr(34) strExecAllArgs=strExecAllArgs & " " & strExecArg Next objShell.run strExecCmdLine & strExecAllArgs,1,false set objFSO = nothing Set objShell = nothing Set objArgs = nothing wscript.quit end if End Sub '=================================================================== 'allows for a pause at the end of execution 'currently used only for debugging '=================================================================== Sub Pause set objStdin=wscript.stdin set objStdout=wscript.stdout objStdout.write "Press ENTER to continue..." strtmp=objStdin.readline end Sub '=================================================================== 'if debugmode=1 the writes dubug info to the specified 'file and if running under cscript also writes it to screen. '=================================================================== Sub DebugOut(strDebugInfo) if DEBUGMODE=0 then exit sub strCurrScriptHost=lcase(right(wscript.fullname,len(wscript.fullname)-len(wscript.path)-1)) if strCurrScriptHost="cscript.exe" then wscript.echo "Debug: " & strDebugInfo AppendFileMode=8 set objDebugFSO=CreateObject("Scripting.FileSystemObject") set objDebugStream=objDebugFSO.OpenTextFile(DEBUGFILE,AppendFileMode,True,False) objDebugStream.writeline strDebugInfo objDebugStream.Close set objDebugStream=Nothing set objDebugFSO=Nothing End Sub Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now