Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '# -------------------------------------------------------------------
- '# SystemInfoReporter Version 0.05
- '# Copyright (C) 2010
- '# Script Authors: Rob Sanders
- '# Last edit: Sept 20, 2010
- '#
- '# Collect Computer information and write the data to a csv file
- '# Developed for the Hospital Computer re-deployment project
- '#
- '# Changes Sept 20, 2010:
- '# Added Dual Monitor info gathering Code by: Michael Baird
- '# Removed and modified some of the WMI data being collected
- '# Removed the user input for file locations
- '# hard coded the file locations
- '#
- '# Changes March 22, 2010:
- '# Added user input variables for file locations
- '# Added error handling to validate user input
- '# Added error handling to check if source file exists
- '# -------------------------------------------------------------------
- ' Start the script here
- Call GetInfo
- Sub GetInfo
- 'Constants for FileSystemObject
- Const FOR_READING = 1
- Const FOR_WRITING = 2
- Const FOR_APPENDING = 8
- strInputFile = InputBox("Enter the Path and Filename for the file with the list of Computer Names")
- strSaveFile = InputBox("Enter the Save location for the Data file")
- 'strInputFile = "\\nas1\users\Sander\My Documents\Scripts\CompList.txt"
- 'strSaveFile = "\\nas1\users\Sander\My Documents\Scripts\results"
- strFileOutput = strSaveFile & "\" & "Computer_SystemInfo.csv"
- If strInputFile = "" Or strFileOutput = "" Then
- WScript.Echo "No paths were entered"
- WScript.Echo "The program has ended"
- WScript.Quit
- End If
- ' Create a Script Runtime FileSystemObject.
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- If Not objFSO.FileExists(strInputFile) Then
- WScript.Echo "The Path or File for " & strInputFile & " does not exist." & vbCrLf & "Re-Run the program and try again"
- WScript.Echo "The program has ended"
- WScript.Quit
- Else
- If Not objFSO.FolderExists(strSaveFile) Then
- WScript.Echo "The Path " & strSaveFile & " does not exist."
- WScript.Echo "The program has ended"
- WScript.Quit
- Else
- ' Check to see if the output file exists, If so, open it for writing or appending.
- ' If not, create if and open it for writing.
- If objFSO.FileExists(strFileOutput) Then
- Set objOutputFile = objFSO.OpenTextFile(strFileOutput, FOR_APPENDING)
- Else
- Set objOutputFile = objFSO.CreateTextFile(strFileOutput)
- End If
- ' Write header for File. Current date and header, and LINE space
- objOutPutFile.WriteLine "PC/Server System WMI Information" & _
- vbCrLf & "Author: Rob Sanders" & vbCrLf & "Information collected on: " & Now & vbCrLf & vbCrLf & String(30, "-") & vbCrLf
- ' Creates headers in File
- objOutputFile.Writeline "Computer Name, Model, Manufacturer, RAM (MB) ,Serial No., ,Monitor Serial 1,Monitor Model 1,Monitor Serial 2,Monitor Model 2,Monitor Serial 3,Monitor Model 3"
- ' Import our computer list file into a Dictionary
- Set objDictionary = CreateObject("Scripting.Dictionary")
- Set objFile = objFSO.OpenTextFile (strInputFile, FOR_READING)
- i = 0
- Do Until objFile.AtEndOfStream
- strNextLine = objFile.ReadLine
- If strNextLine <> "" Then
- objDictionary.Add i, strNextLine
- End If
- i = i + 1
- Loop
- objFile.Close
- 'Ping remote computer to see if it is turned on before trying to collect the information.
- 'If inaccessible, display error message.
- For Each strComputer In objDictionary.Items
- Set objShell = CreateObject("WScript.Shell")
- Set objScriptExec = objShell.Exec("ping -n 1 -w 1000 " & strComputer)
- strPingResults = LCase(objScriptExec.StdOut.ReadAll)
- If InStr(strPingResults, "reply from") Then
- 'Calls the computer, start of pull and writes info into document
- Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
- 'Computer name, Manufacturer, Model, RAM converts the RAM value to MB's
- Set colSettings = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
- For Each objComputer In colsettings
- objOutputFile.Write objComputer.Name &"," & objComputer.Model & "," & objComputer.Manufacturer & "," & round((objComputer.TotalPhysicalMemory / 1024)/1024,0)
- Next
- 'Get the Serial Number
- Set colItems = objWMIService.ExecQuery ("Select * from Win32_BIOS",,48)
- For Each objItem In colItems
- objOutputFile.Write "," & objItem.SerialNumber
- Next
- ' Now get all the Monitor Info
- 'gstrOutput = gstrOutput & GetMonitorInfo() & vbNewLine
- 'WScript.Echo gstrOutput
- objOutputFile.Write ", ," & GetMonitorInfo() & vbNewLine
- Else
- 'WScript.Echo strComputer & " not found..."
- objOutputFile.Write "*** " & strComputer & " *** NOT Found" & vbCrLf
- Err.Clear
- End If
- Next
- WScript.Echo "All Finished, go have a look..." & vbCrLf & "At - " & strFileOutput
- End If
- End If
- End Sub
- '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)
- ' Version 1.0
- ' Amended by Krystian Karia
- ' Written by Michael Baird
- ' Amended for the GetInfo Main Script. To
- ' put monitor details at the end of the results
- ' of the current results from GetInfo.
- 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_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
- ' Custom output for VendorInfo Script
- tmpOutput=tmpOutput & tmpResult(0) & ","
- tmpOutput=tmpOutput & tmpResult(4) & ","
- 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))
- 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()
- 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="~{{<ERROR>}}~"
- 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()
- strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
- tmpreturn=objReg.GetMultiStringValue(Hive, strKeyPath, RegValueName, RegValue)
- if tmpreturn=0 then
- RegGetMultiStringValue=RegValue
- else
- RegGetMultiStringValue="~{{<ERROR>}}~"
- 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()
- strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
- tmpreturn=objReg.GetBinaryValue(Hive, strKeyPath, RegValueName, RegValue)
- if tmpreturn=0 then
- RegGetBinaryValue=RegValue
- else
- RegGetBinaryValue="~{{<ERROR>}}~"
- end if
- End Function
- 'simple function to provide a wmi registry provider
- 'to all the other registry functions (regenumkeys, reggetstringvalue, etc...)
- Function GetWMIRegProvider()
- strComputer = "."
- Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
- End Function
- '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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement