Solved

Need help with VBS script

Posted on 2009-05-13
6
1,085 Views
Last Modified: 2013-11-06
i have been tasked with getting all information about the devices in our network. Everything from pc to switches. Now I know that i will not be able to pull all the information, but I belive I can atleast get the computer and monitor information.

I have found this script, which does part of what I want, but the output is not working correctly, and I do not need all the information that it shows. When I run the script and put in my list of computers, it only shows the output of the first machine in the list.

I'm wondering if anybody could edit this script, and change the output to the following format. This need to pull the computer infromation and monitor information. If there is a way to get the printer information that would be nice too.

COMPUTER NAME        SERIAL#                MODEL                        MANUFACTURER            
' Global Variable for output

	Dim gstrOutput

	Dim gstrComputer

	Dim garrComputers

 

' Start the script here - Get computer(s)

	Call GetComputers

 

' Loop each computer in the array and populate the file

' NOTE: If a computer has already been done and is In

' the file, it wont be added again, thus avoiding duplicates

 

		For i = 0 to Ubound(garrComputers)

			If garrComputers(i) = "" Then

				' end of array if blank

				EndScript

			End If

			

			gstrComputer = garrComputers(i)

 

			Call VendorInfo			

		

		Next ' i

 

 

 

 

Sub GetComputers()

' Version 1.0

' Writen by Krystian Karia

' Dated 25/03/2009

 

' Asks for the file location of a list

' of computers.  If none is given then

' we ask for a single computer anme or

' a comma seperated list (CSV) instead

 

' Catch errors ourselves

	On Error Resume Next

 

' Declare Variables

	Dim fso, wshShell, oFile

	Dim sFileLocation, strOutput

	Dim arrComputers

	Dim strResults

	Dim i

	

	Const ForReading = 1

	

' Create Objects and open file for reading

	Set fso = CreateObject("Scripting.FileSystemObject")

	Set wshShell = CreateObject("WScript.Shell")

 

 

' Ask for the filename that contains a list of computers per line

	sFileLocation = InputBox("Enter the full path to the file " _

		& "that copntains a list of computers per line. or enter " _ 

		& "either a single computer name or a comma seperated list " _

		& "of computers", "ComputerList File Location")

 

' FILE LOCATION GIVEN

	If InStr(sFileLocation, ":") > 0 Then

 

		Set oFile = fso.OpenTextFile(sFileLocation, ForReading, False)

			If Err.Number <> 0 Then

				ShowProgress "Error reading File " & sfileLocation

				EndScript

			End If

		

	' Read the whole contents of the File

		Do While oFile.AtEndOfStream <> True

			strResults = oFile.ReadAll

			

			garrComputers = Split(strResults, vbNewLine)

		Loop

		

	' Close the file

		oFile.Close

		

	' Release the object from memory

		Set oFile = Nothing

 

' CANCEL PRESSED

 	ElseIf sFileLocation = "" Then

 		ShowProgress "Cancelled"

 		EndScript

 

' SINGLE OR CSV LIST

	Else

		If InStr(sFileLocation, ",") > 0 Then 

			garrComputers = Split(sFileLocation, ",")

		Else

			garrComputers = Split(sFileLocation & ",", ",")

		End If 

	End If 

 

End Sub ' GetComputers

 

 

 

 Sub VendorInfo

' Version 3.0

' Created by Krystian Karia

' Dated 16/12/2008

 

' Amended script to get info from remote

' computer as well as the local computer

' Can also get  a list of computers from

' a text file. If no file specified Then

' a single  computer will  be  asked For

 

' Version 2.0

' Amended to include output for Monitors

' which uses Scripts  from Michael Baird

 

' Version 1.0

' Script  that can  be used  in a GPO to 

' Get  Info  about  the computer  it  is 

' running on and put  it into a CSV file

' on a network  share. It checks  if any

' duplicates are  found and if not, will

' create  the  file if  not alrady there

' and   write  to it,  or it  will  just 

' append to the file if its already been

' created.

 

 

	Dim fso, objWMIService, objItem, oFile, oDuplicateCheck

	Dim sFileLocation, strHeader, strIDNumber

	Dim strResults, strDuplicateLine

	Dim colItems

	

	Const wbemFlagReturnImmediately = &h10

	Const wbemFlagForwardOnly = &h20

	Const ForReading = 1

	Const ForWriting = 2

	Const ForAppending = 8

 

' Initialize the variables	

	sFileLocation = "C:\KKVendor.csv"	' Put your filename and network share here i.e. \\server\share\filename.csv

	strHeader = strHeader & "UserName,ComputerName,Domain,IP Address,ID No.,Name,Vendor,Version,Date,"

	strHeader = strHeader & "Monitor Serial 1,Monitor Model 1,Monitor Serial 2,Monitor Model 2,Monitor Serial 3,Monitor Model 3" & vbNewLine 

	

'	gstrComputer = "."

 

' Create the objects

	Set fso = CreateObject("Scripting.FileSystemObject")

	Set objWMIService = GetObject("winmgmts:\\" & gstrComputer & "\root\cimv2")

 

	

' Get Username & Computer & Domain

	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _

		wbemFlagReturnImmediately + wbemFlagForwardOnly)

		

		For Each objItem In colItems

			gstrOutput = gstrOutput & objItem.UserName & ","

			gstrOutput = gstrOutput & objItem.Name & ","

			gstrOutput = gstrOutput & objItem.Domain & "," 

		Next

 

 

'Get IP Address	

	Set colItems = objWMIService.ExecQuery _

		("Select IPAddress From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

		

		For Each objItem In colItems

			If objItem.IPaddress(0) <> "0.0.0.0" Then

				gstrOutput = gstrOutput & objItem.IPAddress(0) & ","

				Exit For	' We only want the first one it comes across

			End If

		Next

 

' Get ID No. Name, Vendor and Version

	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", "WQL", _

		wbemFlagReturnImmediately + wbemFlagForwardOnly)

		

		For Each objItem In colItems

			strIDNumber = objItem.IdentifyingNumber

			gstrOutput = gstrOutput & strIDNumber & ","

			gstrOutput = gstrOutput & objItem.Name & ","

			gstrOutput = gstrOutput & objItem.Vendor & ","

			gstrOutput = gstrOutput & objItem.Version & ","

			gstrOutput = gstrOutput & Date() & ","

		Next

 

' Now get all the Monitor Info

		gstrOutput = gstrOutput  & GetMonitorInfo() & vbNewLine
 

 

 

' Write Results To File

	If fso.FileExists(sFileLocation) = False Then

		' Create and write to file with header

		Set oFile = fso.OpenTextFile(sFileLocation, ForWriting, True)

	

			If Err.Number <> 0 Then

				' You could write to the event log here

				Exit Sub

			End If

		

		strResults = oFile.Write(strHeader & gstrOutput)

	Else

 

' Check if we already have this ID in the csv file

		Set oDuplicateCheck = fso.OpenTextFile(sFileLocation, ForReading, False)

			Do Until oDuplicateCheck.AtEndOfStream

				strDuplicateLine = oDuplicateCheck.ReadLine

	

				If InStr(strDuplicateLine, strIDNumber) > 0 Then

					' Duplicate found - close file and exit sub

					oDuplicateCheck.Close

					Exit Sub

				End If

			Loop

' No duplicates found - close file ready for later

		oDuplicateCheck.Close

 

		

		' File exists so append to it without header

		Set oFile = fso.OpenTextFile(sFileLocation, ForAppending, False)

 

			If Err.Number <> 0 Then

				' You could write to the event log here

				Exit Sub 

			End If

 

		strResults = oFile.Write(gstrOutput)

	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 VendorInfo  Main Script. To

' put monitor details at the end of the results

' of the current results from VendorInfo.

 

	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()

'gstrComputer = "."

Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & gstrComputer & "\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

 

 

Sub ShowProgress(sComment)

 

	WScript.Echo sComment

 

End Sub

 

 

Sub EndScript

 

	WScript.Quit

	

End Sub

Open in new window

0
Comment
Question by:Con366
  • 3
  • 2
6 Comments
 

Author Comment

by:Con366
ID: 24378914
Hmm no responses.

If someone could help me out with getting it to output all the computers, and not just the first one. I would be fine with that
0
 
LVL 70

Expert Comment

by:Chris Dent
ID: 24379240

Probably because it's such an enormous script :)

/me looks

Chris
0
 
LVL 22

Expert Comment

by:Adam Leinss
ID: 24379894
I loaded the script, put 2 PCs in a CSV file and I got results on both PCs...so I'm not sure why you only get one result?
And it would probably be easier to just delete a column in Excel which would take 30 seconds versus unwinding hundreds of lines of code to get the output you want.
The only problem see with this script is that it won't work on PCs turned off and it doesn't check for duplicates.
This might be better solution: http://www.spiceworks.com/
 
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 

Author Comment

by:Con366
ID: 24379973
I use spiceworks right now, but it doesn't pull the monitor model or serial. If it did i would be golden.
0
 

Author Comment

by:Con366
ID: 24380015
Thats werid because when I load the script and tell it to look at a txt file with my computer names, the script runs fine, but the output file only shows the first computer in the list.
0
 
LVL 22

Accepted Solution

by:
Adam Leinss earned 500 total points
ID: 24380861
It has to be in CSV format..if you put it in Excel and save as a CSV, that should work.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Can I legally transfer my OEM version of Windows to another PC?  (AKA - Can I put a new systemboard in my OEM PC?) Few of us are both IT and legal experts but we all have our own views of Microsoft's licensing rules and how they apply.  There are…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now