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