Table of Contents

usb.vbs

Author Richard Finegold
Compatibility Xymon or Big Brother
Requirements VBScript and BBWin on client
Download None
Last Update 2012-05-03

Description

This monitors what USB devices are plugged in, with a configuration file to alert if a USB device becomes unreachable. It does not check where (i.e. which hub/hub chain) a device is plugged in. Checked devices appear as normal text, unchecked devices are italicized small, hubs (if displayed at all) are italicized small gray struck-through.

Installation

Client side

Server side

(no server side changes needed)

Source

usb.vbs

Show Code ⇲

Hide Code ⇱

Const dbg=True
 
'The structure of this file is a number (quantity), a space, then the device Description or Information (match output).
'Use an empty file if you don't need to test anything (i.e. always green).
'Add a "#" to any line for comments.
Dim cfgfile : cfgfile = "..\etc\usb.cfg"
Const DISPLAYHUB = True
 
Function CMEC(u)
	'Frequent are 0=OK, 22=disabled, 24=not present.  http://msdn.microsoft.com/en-us/library/aa394353(VS.85).aspx
	Dim a : a = Array("Device is working properly." _
	, "Device is not configured correctly." _
	, "Windows cannot load the driver for this device." _
	, "Driver for this device might be corrupted, or the system may be low on memory or other resources." _
	, "Device is not working properly. One of its drivers or the registry might be corrupted." _
	, "Driver for the device requires a resource that Windows cannot manage." _
	, "Boot configuration for the device conflicts with other devices." _
	, "Cannot filter." _
	, "Driver loader for the device is missing." _
	, "Device is not working properly. The controlling firmware is incorrectly reporting the resources for the device." _
	, "Device cannot start." _
	, "Device failed." _
	, "Device cannot find enough free resources to use." _
	, "Windows cannot verify the device's resources." _
	, "Device cannot work properly until the computer is restarted." _
	, "Device is not working properly due to a possible re-enumeration problem." _
	, "Windows cannot identify all of the resources that the device uses." _
	, "Device is requesting an unknown resource type." _
	, "Device drivers must be reinstalled." _
	, "Failure using the VxD loader." _
	, "Registry might be corrupted." _
	, "System failure. If changing the device driver is ineffective, see the hardware documentation. Windows is removing the device." _
	, "Device is disabled." _
	, "System failure. If changing the device driver is ineffective, see the hardware documentation." _
	, "Device is not present, not working properly, or does not have all of its drivers installed." _
	, "Windows is still setting up the device." _
	, "Windows is still setting up the device." _
	, "Device does not have valid log configuration." _
	, "Device drivers are not installed." _
	, "Device is disabled. The device firmware did not provide the required resources." _
	, "Device is using an IRQ resource that another device is using." _
	, "Device is not working properly. Windows cannot load the required device drivers.")
	Dim n : n = u.ConfigManagerErrorCode	'Pass object for simplicity, but value is all we need
	CMEC = n & "=Undefined?!"
	if n <= UBound(a) then CMEC = n & "=" & a(n)
End Function
 
Dim color : color = "green"
 
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
 
Phase "Read configuration file"
If not FSO.FileExists(cfgfile) then   WScript.Quit 2	'ERROR_FILE_NOT_FOUND
If FSO.GetFile(cfgfile).Size > 0 Then
	With FSO.OpenTextFile(cfgfile, 1)
		cfgfile = Split(.ReadAll, vbCRLF)
		.Close
	End With
Else
	cfgfile = Array("")	'ReadAll gives an error for empty files. Workaround!
End If
 
Phase "Parse configuration file"
Dim needed : Set needed = CreateObject("Scripting.Dictionary")
Dim usb : for each usb in cfgfile
	if Instr(usb, "#") > 0 then usb = Trim(Left(usb, Instr(usb, "#") - 1))
	if len(usb) > 3 then
		if not IsNumeric(Left(usb, 1)) then
			WScript.Echo """" & usb & """ is not in the correct format!"
			WScript.Echo "First character must be a digit!"
			WScript.Quit 13 'ERROR_INVALID_DATA
		end if
		needed(Trim(Mid(usb, 3))) = CInt(Trim(Left(usb, 2)))
	end if
next
 
Phase "Create WMI Query"
Dim WMI : Set WMI = GetObject("winmgmts:\\.\root\CIMV2")
 
'Win32_USBDevice is short, but only seems to be available with SCCM installation.
'Win32_USBHub is almost as good, but it seems to exclude HID class devices, Bluetooth, etc.
'Both derive from Win32_PNPEntity, so go with that instead. Sorry!
 
Dim WMIQuery : WMIQuery = "SELECT * FROM Win32_PNPEntity WHERE DeviceID Like 'USB%'"
Dim col : Set col = WMI.ExecQuery(WMIQuery, "WQL", wbemFlagReturnImmediately)
 
Phase "Check " & col.Count & " devices"
Dim Summary, Table : Summary = "" : Table = ""
For Each usb In col
	If Right(usb.Name, 4) = " Hub" then
		Phase "Skip a WMI device: " & usb.Name
		If DISPLAYHUB Then   Table = Table & Replace(DeviceLine(usb) _
			, "<tr style=""", "<tr style=""text-decoration: line-through; color: gray; ")
	Else
		Phase "Check a WMI device: " & usb.Name
		Table = Table & DeviceLine(usb)
	End If
Next
 
Function DeviceLine(usb)
	'Although usb.Name tends to be useful, sometimes it's generic (e.g. "USB Human Interface Device").
	'So try to look up the LocationInformation in the registry. Mention it.
	'Beware of OS; http://social.microsoft.com/Forums/en/genuinevista/thread/daad2598-028e-4763-ac9b-4546e4deec5e
	Dim WSH : Set WSH = CreateObject("WScript.Shell")
	On Error Resume Next	'In case the value isn't there
	Dim s, nm : s = ""
	Const ENM = "HKLM\System\CurrentControlSet\Enum\"
	s = Trim(WSH.RegRead(ENM & usb.DeviceID & "\FriendlyName"))
	if "" = s then s = Trim(WSH.RegRead(ENM & usb.DeviceID & "\LocationInformation"))
	On Error Goto 0
 
	'Shorten the DeviceDesc/LocationInformation if it has a semicolon (Vista, Server 2008, Windows 7)
	If Instr(s, ";") > 1 then s = Trim(Mid(s, Instr(s, ";")+1))
	nm = Trim(usb.Name) : If Instr(nm, ";") > 1 then nm = Trim(Mid(nm, Instr(nm, ";")+1))
 
	'Make small and italic if configuration doesn't list as necessary
	dim dl : dl = "<tr style=""font-style: italic; font-size: smaller;"">"
	dim c : c = 0
	if needed.Exists(nm) then
		c = needed(nm)	'Needed count
		dl = "<tr>"
	end if
	if needed.Exists(s) then
		c = needed(s)		'Needed count
		dl = "<tr>"
	end if
	dl = dl & "<td>" & nm & "<td>" & s & "<td>" & usb.DeviceID & "<td>&"
	'We could also add Service. Useful?
	if usb.Status = "OK" then
		dl = dl & "green"
	elseif usb.Status = "Degraded" or usb.Status = "Pred Fail" then
		dl = dl & "yellow"
		if c > 0 then
			if color = "green" then color = "yellow"
			Summary = Summary & vbCRLF & "&yellow Needed device " & nm & " [" & s & "] is " & usb.Status
		end if
	else	
		dl = dl & "red"
		if c > 0 then
			color = "red"
			Summary = Summary & vbCRLF & "&red Needed device " & nm & " [" & s & "] is " & usb.Status
		end if
	end if
	dl = dl & " " & usb.Status & vbCRLF & "<td>" & CMEC(usb) & vbCRLF
	if c > 0 then
		c = c - 1
		if 0 = c then
			if needed.Exists(nm) then needed.Remove(nm) else needed.Remove(s)
		else
			if needed.Exists(nm) then needed(nm) = c else needed(s) = c
		end if
	end if
	DeviceLine = dl
End Function
 
Phase "Was anything found?"
'The first column is DeviceDesc/Caption/Name, the second column is LocationInformation.
If len(Table) > 0 then Table = "<table border=1>" & vbCRLF _
	& "<tr><th>Description<th>Information<th>Device ID (Enumerator\Device\Instance)<th>Status<th>Error" & vbCRLF _
	& Table & "</table>"
 
Phase "Was anything missing?"
if needed.Count > 0 then
	Quickie = "At least " & needed.Count & " USB devices needed but missing"
	Summary = Table & vbCRLF & Summary
	Summary = Summary & vbCRLF & "&red The following USB devices could not be found!"
	for each usb in needed.keys
		Summary = Summary & vbCRLF & " &clear Qty=" & needed(usb) & " : " & usb
	next
	color = "red"
else
	Summary = Table & vbCRLF & Summary
	Quickie = "All required USB devices present"
end if
 
Phase "Write status"
WriteStatus "usb", color, Quickie, Summary
WScript.Quit 0
 
'######################################################################
'Write out the status; depends on FSO and WSH
Sub WriteStatus(column, color, quickie, line)
'Why so long? Assume that client might collect file while writing, so make temp file and rename it.
'######################################################################
	Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
	Dim WSH : Set WSH = CreateObject("WScript.Shell")
	Const BBWinreg = "HKLM\SOFTWARE\BBWin\tmpPath"
	Const Questreg = "HKLM\SOFTWARE\Quest Software\BigBrother\bbnt\ExternalPath\"
	On error resume next
	'Assume that, if BBWin is installed, they're using it; if not then they're using Quest BB client.
	Dim colfile : colfile = WSH.RegRead(BBWinreg)
	If "" = colfile then colfile = WSH.RegRead(Questreg)
	If "" = colfile then Exit Sub			'Abort if nothing in the registry for location.
	colfile = colfile & "\" & column		'Add the column name to make it a real colfile.
	Dim tempfile : tempfile = colfile & ".$$$"	'Temporary file; use temporary name for safety!
	If FSO.FileExists(tempfile) Then WScript.Quit 183'Bail out if already there (i.e. previous stuck)
	On Error Resume Next
	With FSO.CreateTextFile(tempfile, True)
		if err then WScript.Quit err	'Bail out if unable to create file.
		.WriteLine color & " " _
			& WeekdayName(Weekday(Now),True) & " " _
			& Mid(Now,1,InStr(Now," ")-1) & " " & TimeValue(Now) & " [" _
			& WSH.Environment("Process")("COMPUTERNAME") _
			& "] " & quickie
		.Write line
		.Close
	End With
	'***********************************************************
	'Rename file so client will see it (taking care to remove any unprocessed file first)
	'***********************************************************
	if FSO.FileExists(colfile) then FSO.DeleteFile(colfile)
	FSO.MoveFile tempfile, colfile
End Sub
 
'######################################################################
'If the script gets stuck, we can use Process Explorer to examine its environment
'######################################################################
Sub Phase(n)
	if dbg then wscript.echo n
	CreateObject("WScript.Shell").Environment("Process")("P-" & WScript.ScriptName) = n
End Sub

Known Bugs and Issues

(none)

To Do

Credits

Changelog