monitors:listprn

listprn.vbs

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

Description

This lists TCP/IP-connected printers on a print server, their drivers (including versions), their pingability, print jobs, and port setups. The information gathered is quite lengthy, enough that I found a memory leak in BBWin 0.12.

Installation

Client side

  • Confirm that the client is actually being used as a print server. On Windows XP, one would check by opening Printers, File/Server Properties, and on the Ports tab, check that IP_* ports (typically described as “Standard TCP/IP Port”) are in use.
  • Copy listprn.vbs (below) to your BBWin's ext folder.
  • Customize the IPpattern and MYDOMAIN values to match your network's configuration.
  • Optionally try running it at the command line (cscript listprn.vbs), confirm it displays output and writes a listprn file.
  • Edit your BBWin's etc/bbwin.cfg file:
    • Add a line in the externals section:
      	<load value="cscript.exe ..\ext\listprn.vbs" />
    • If the externals agent was disabled in the bbwin section (e.g. commented out or deleted), enable:
              <load name="externals" value="externals.dll" />

Server side

Optionally add a composite script that makes a report of all printers. prntx.sh depends on prnt.sh; run something like the following: 

prnt.sh > $BBWWW/prnt.html; prntx.sh
prnt.sh

If the listing isn't long enough to warrant stand-alone versions of Combined/Print-Jobs/Ports, edit out the prnt-.html references at the top.

Show Code ⇲

Hide Code ⇱ 

COLUMN=prnt
LOGFILE=/tmp/$COLUMN.log1
 
#Filter out some totals
echo "<html><head><title>Printers</title>
<script src=\"menu/sorttable.js\"></script></head><body>
<ul><li><a href=\"#each\">Each Office</a> <small>"
for S in `$BB localhost "hobbitdboard test=$COLUMN" | sed 's/|.*//'`; do
        s=`echo $S | tr a-z A-Z`
        echo "| <a href=\"#$s\">$s</a>"
done
#NOTE: If the length of this isn't enough to warrant stand-alone pages
#NOTE: then remove the links to prnt-{combined|ports|jobs}.html and prnt-names.txt here
#NOTE: and don't bother using prntx.sh.
echo "</small>
  <li><a href=\"#combined\">Combined</a> | <a href=prnt-combined.html>(stand-alone)</a>
  <li><a href=\"#jobs\">Print Jobs</a> | <a href=prnt-jobs.html>(stand-alone)</a>
  <li><a href=\"#ports\">Ports</a> | <a href=prnt-ports.html>(stand-alone)</a>
  <li> | <a href=prnt-names.txt>Names</a>
</ul><hr>
 
<a name=each><h1>Each Office</h1></a>"
 
#The output of this is essentially identical to what one would get if `cat`-ing the $BBLOGS if
# "hobbitd_filestore --status" was launched.
for S in `$BB localhost "hobbitdboard test=$COLUMN" | sed 's/|.*//'`; do $BB localhost "hobbitdlog $S.$COLUMN" | tail -n +2; echo ""; done > $LOGFILE
 
#Get each list of printers, including first line of status
sed '
        /Printers list/,/\/table/!d
        /Printers list/s/\[\(.*\)\]/[<a name=\1>\1<\/a>]/
        s/^green/<p>green/
        s/^yellow/<p>yellow/
        s/^red/<p>red/
        s/&clear/<img src="gifs\/clear.gif">/g
        s/&green/<img src="gifs\/green.gif">/g
        s/^&yellow/<br><img src="gifs\/yellow.gif">/g
        s/&yellow/<img src="gifs\/yellow.gif">/g
        s/^&red/<br><img src="gifs\/red.gif">/g
        s/&red/<img src="gifs\/red.gif">/g
        #s/table border=1/table border=1 class=sortable/
        s/<th>MAC/<th class="sorttable_alpha">MAC/
        s/<th>Port/<th class="sorttable_alpha">Port/
' $LOGFILE
 
#Calculate some statistics
S=`awk ' /Printers list/ {
                shares += substr($9,2);
                MACs += $12;
                unassigned+=$14;
                ports+=$17;
                jobs+=$20
        } END {
                print "Totals: " shares " shares on " MACs " MACs, " unassigned " unassigned MACS; " ports " ports; " jobs " jobs"
        }' $LOGFILE`
 
#Get each list of printers, but rather than listing each separately, combine into one table
#S=`sed '/Printers list/,/\/table/!d;/<td>/!d' $LOGFILE | wc -l`
echo "<hr>
 
<a name=combined><h1>Combined</h1></a>
`echo $S | sed 's/\; [0-9]* jobs//'`
<table border=1 class=sortable><tr><th>Share<th class=\"sorttable_alpha\">Port<th>Res<th>Driver<th>Version<th>Processor<th>Capabilities<th>Status<th>Error<th>Ping<th>Comment"
sed '
        /Printers list/,/\/table/!d
        /<td>/!d
        s/&clear/<img src="gifs\/clear.gif">/g
        s/&green/<img src="gifs\/green.gif">/g
        s/&yellow/<img src="gifs\/yellow.gif">/g
        s/&red/<img src="gifs\/red.gif">/g
' $LOGFILE
echo "</table>"
 
#Get each list of print jobs, but rather than listing each separately, combine into one table
echo "<hr>
 
<a name=jobs><h1>Print Jobs</h1></a>
`echo $S | sed 's/.*ports./Total:/'`
<table border=1 class=sortable><tr><th>Status<th>Owner/<br>Notify<th>Total<br>Pages<th>Size<th>TimeSubmitted<th>Document<th>Description<br>(Printer,Job)<th>Host<br>PrintQueue<th>Ping<th>Notes"
sed '
        s/... DATA TRUNCATED .../... DATA TRUNCATED ...\
<\/table>/
        /TimeSubmitted/,/\/table/!d
        #Put a non-breaking space in the date/time stamp
        s/\([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\) \([0-9][0-9][0-9][0-9][0-9][0-9]\)-[0-9][0-9][0-9]/\1\&nbsp\;\2/
        /<td>/!d
        s/&green/<img src="gifs\/green.gif">/g
        s/&yellow/<img src="gifs\/yellow.gif">/g
        s/&red/<img src="gifs\/red.gif">/g
        s/&purple/<img src="gifs\/purple.gif">/g
        s/&clear/<img src="gifs\/clear.gif">/g
        s/ UNKNOWN/Unknown/
' $LOGFILE
echo "</table>"
 
#More statistics (for ports list)
S=`sed '
        s/... DATA TRUNCATED .../... DATA TRUNCATED ...\
<\/table>/
        /Port.LPR\,/,/\/table/!d
        /<td>/!d
        ' $LOGFILE | wc -l`
 
#Get each list of ports
echo "<hr>
 
 
<a name=ports><h1>Ports</h1></a>
Total: `echo $S` ports
<table border=1 class=sortable><tr><th>Reservation<th>Reservation Description<th>Address<th>Ping<th>MAC<th>TCP, Port|LPR, Name<th>SNMP<th>Driver"
sed '
        s/... DATA TRUNCATED .../... DATA TRUNCATED ...\
<\/table>/
        /Port.LPR\,/,/\/table/!d
        /<td>/!d
        s/&green/<img src="gifs\/green.gif">/g
        s/&yellow/<img src="gifs\/yellow.gif">/g
        s/&red/<img src="gifs\/red.gif">/
        s/public, 1/public\/1/
' $LOGFILE
echo "</table>"
echo "<p>As of `date`</p>"
echo "</body></html>"
prntx.sh

Customize as you like; at this company, we use a convention of city-department# with an optional -PS or -PCL, yours might be different and the prnt-names.txt counts by department might not be useful/desirable.

Show Code ⇲

Hide Code ⇱ 

echo "<html><head><title>Printers combined</title>
<script src=\"menu/sorttable.js\"></script></head><body>
 
<h1>Combined printers</h1>
`sed '/name=combined/,/name=jobs/!d;/a name=/d;/\<hr\>/d' < $BBHOME/www/prnt.html`
</body></html>" > $BBHOME/www/prnt-combined.html
 
echo "<html><head><title>Print jobs</title>
<script src=\"menu/sorttable.js\"></script></head><body>
 
<h1>Print jobs</h1>
`sed '/name=jobs/,/name=ports/!d;/a name=/d;/\<hr\>/d' < $BBHOME/www/prnt.html`
</body></html>" > $BBHOME/www/prnt-jobs.html
 
echo "<html><head><title>Printer ports</title>
<script src=\"menu/sorttable.js\"></script></head><body>
 
<h1>Printer ports</h1>
`sed '/name=ports/,/^\<p\>As of /!d;/a name=/d;/\<hr\>/d' < $BBHOME/www/prnt.html`
</body></html>" > $BBHOME/www/prnt-ports.html
 
echo "Counts of printer names (regardless of site)" > $BBHOME/www/prnt-names.txt
sed '1,6d;$d;s/^.tr..td.//;s/<td>.*//' $BBHOME/www/prnt-combined.html | tr A-Z a-z | sed '$d;/-ps$/d;/-pcl/d;/-universal/d;s/^[^-]*-//;s/-.*//' | sort | uniq -c >> $BBHOME/www/prnt-names.txt
echo "
Counts of printer base names" >> $BBHOME/www/prnt-names.txt
sed '1,6d;$d;s/^.tr..td.//;s/<td>.*//' $BBHOME/www/prnt-combined.html | tr A-Z a-z | sed '$d;/-ps$/d;/-pcl/d;/-universal/d;s/^[^-]*-//;s/-.*//;s/[0-9].*//' | sort | uniq -c >> $BBHOME/www/prnt-names.txt
echo "
 
Notes:
 * This excludes the following duplicate entries:
    *-PS names (e.g. 5 named COPIER1-PS would give 14 instead of 9 COPIER1)
    *-PCL* (usually PCL5 or PCL6, mostly at PDX)
    *-Universal (a duplicate using the HP Universal driver, all in ONT)
" >> $BBHOME/www/prnt-names.txt

Source

listprn.vbs

Show Code ⇲

Hide Code ⇱ 

Option Explicit
'List printers (for Xymon/Hobbit/Big Brother), by goldfndr
'Note: This script assumes that one uses Share names identical to Printer names. (WMIC Printer GET Name,Sharename)
'(If printer names have spaces, they will defy pinging, and the print jobs ping column will be less useful.)
'FIXME: Determine what voodoo allows LOCALSYSTEM to DHCP dump remotely (netsh.exe -c dhcp -r dhcpserv server dump)
 
Dim TimerStart : TimerStart = Timer
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
Dim WMI, wmiq, p : Set WMI = GetObject("winmgmts:\\.\root\cimv2")
'Dim me : me = WSH.Environment("Process")("COMPUTERNAME")
const ssfSYSTEM = 37
Dim SHA : Set SHA = CreateObject("Shell.Application")
Const dhcplog = "dhcp.txt"	'Not normally deleted, left for debugging purposes
 
const dbg=true
 
Dim subcolor, color : color = "green"
Const td = "<td>"	'change to vbTab as needed, for inter-field separator
Const th = "<th>"	'change to vbTab as needed, for inter-field separator
Const D = "<br>"	'Change to "; " as needed, for intra-field delimiter/separator (notes)
Const IPpattern = "\.205\.|\.1\d\.2\d\d$"	'A regexp valid for your printers' IP addrs, for DHCP
Const MYDOMAIN = ".example.com"
Const DHCPDescriptions = True
 
 
'***********************************************************
Phase "Determine DHCP server"
'Note: This check assumes that the DHCP server is in the DNS search path.
'Note: Duplication will result if there are multiple print servers within one DHCP subnet.
'Note: The user that this script runs under needs permissions to do remote netsh checks.
'Note: DNS Search Order should be either null (no DNS) or an array; null might be from a virtual adapter.
Dim dhcpserver : dhcpserver = ""
Set wmiq = WMIQuery("IPAddress, DHCPServer, DNSServerSearchOrder" _
	& "; Win32_NetworkAdapterConfiguration Where IPEnabled = True")
'***********************************************************
Dim t, f : For each p in wmiq
	For each t in p.IPAddress
		wscript.echo "IP Address=" & t
		'if t = p.DHCPServer then dhcpserver = "" : exit for
		'wscript.echo "VarType=" & VarType(p.DNSServerSearchOrder)
		If IsArray(p.DNSServerSearchOrder) then
			For each f in p.DNSServerSearchOrder
				wscript.echo "DNS Server=" & f
				if t = f then		'If this print server is a DNS server
					dhcpserver = ""	'then query is local, not remote
					exit for
				end if
				if "" = dhcpserver then dhcpserver = f
			Next
		End If
	Next
Next
wscript.echo "Determined DHCP server=""" & dhcpserver & """"
'wscript.quit
 
'***********************************************************
Phase "Dump DHCP " & dhcpserver
t = "netsh.exe -c dhcp server dump"
if "" <> dhcpserver then t = Replace(t, "-c dhcp", "-c dhcp -r " & dhcpserver)	'FIXME: Permissions?
WSH.Run "cmd.exe /c " & t & " 2>" & dhcplog & ".err | find ""reservedip"" | sort > " & dhcplog, 0, 1
Phase "Parse DHCP, gathering Ports (IP Addresses), MAC Addresses, and Reservations (Reserved Names)"
'***********************************************************
Dim ports : Set ports = CreateObject("Scripting.Dictionary")
Dim macs : Set macs = CreateObject("Scripting.Dictionary")
Dim reservations : Set reservations = CreateObject("Scripting.Dictionary")
Dim resdescriptions : Set resdescriptions = CreateObject("Scripting.Dictionary")
Dim tcpips : Set tcpips = CreateObject("Scripting.Dictionary")
Dim pingables : Set pingables = CreateObject("Scripting.Dictionary")
 
if FSO.GetFile(dhcplog).Size Then
	Set f = FSO.OpenTextFile(dhcplog, 1)
	Do
		Dim s : s = f.ReadLine
		t = Split(s)
		ports.Item(t(7)) = t(7)
		macs.Item(t(7)) = t(8)
		dim reservation : reservation = Mid(t(9), 2, len(t(9)) - 2)
		reservations.Item(t(7)) = reservation
		'strip off MYDOMAIN if present, case-insensitive search starting at 4th character
		if Instr(4, reservation, MYDOMAIN, 1) then
			reservations.Item(t(7)) = left(reservation, len(reservation) - len(MYDOMAIN))
		end if
		resdescriptions.Item(t(7)) = Split(s, """ """)(1)
	Loop until f.AtEndOfStream
	f.Close
End If
 
Dim ErrorStateTxt : ErrorStateTxt = Array("", "Other", "No Error", "Low Paper", "No Paper" _
	, "Low Toner", "No Toner", "Door Open", "Jammed", "Offline", "Service Requested", "Output Bin Full")
Dim ErrorStateVal : ErrorStateVal = Array(0, 1, 0, 1, 2, 1, 2, 2, 2, 2, 2, 2) '0=green, 1=yellow, 2=red
Dim PrinterStatusTxt : PrinterStatusTxt = Array("", "Other", "Unknown", "Idle", "Printing" _
	, "Warming Up", "Stopped printing", "Offline")
Dim colors : colors = Array("green", "yellow", "red")
 
 
Dim exps : Set exps = CreateObject("Scripting.Dictionary")	'Expansion for port
Dim drivers : Set drivers = CreateObject("Scripting.Dictionary")
Dim processors : Set processors = CreateObject("Scripting.Dictionary")
Dim datatypes : Set datatypes = CreateObject("Scripting.Dictionary")
Dim totals(3) : totals(0) = 0 : totals(1) = 0 : totals(2) = 0 : totals(3) = 0
Dim versions : Set versions = CreateObject("Scripting.Dictionary")
 
Dim LINE : LINE = ""
 
'***********************************************************
Phase "Evaluate the TCP/IP Ports"
WMI.Security_.Privileges.AddAsString "SeLoadDriverPrivilege"	'Required for SNMP/etc.
Set wmiq = WMIQuery("Win32_TCPIPPrinterPort")
'***********************************************************
For Each p in wmiq
	t = "<tr>" & td & reservations(p.HostAddress) & td & resdescriptions(p.HostAddress) _
		& td & p.HostAddress & td & "&" & pingable(p.HostAddress) _
		& td & MACs(p.HostAddress) & td
	Select Case p.Protocol
		Case 1: t = t & "Raw, "
			if p.PortNumber <> 9100 then _
				t = t & "<b>" & p.PortNumber & "</b>"  else t = t & "9100"
		Case 2: t = t & "LPR, " & p.Queue
			if p.ByteCount then t = t & " <i>(Counted)<i>"
		Case Else: t = t & "<i>Unknown</i> (" & p.Protocol & ")"
	End Select
	t = t & td
	if p.SNMPEnabled then t = t & p.SNMPCommunity & ", " & p.SNMPDevIndex
	wscript.echo t
	tcpips(p.HostAddress) = t
next
 
 
Phase "Determine ""Product Version"" and ""File Version"" column indexes"
dim productversion, fileversion
	Set f = SHA.NameSpace(ssfSYSTEM)
	For t = -1 to 50
		if "product version" = LCase(f.GetDetailsOf(Nothing, t)) then productversion = t
		if "file version" = LCase(f.GetDetailsOf(Nothing, t)) then fileversion = t
	Next
 
Function DriverVersion(p)
	'The logic in here is from analysis of HP and Canon drivers. YMMV.
	wscript.echo "Checking " & p.DriverPath
	Dim f, v : f = FSO.GetFileName(p.DriverPath)
	if UCase(f) <> "UNIDRV.DLL" and UCase(f) <> "PSCRIPT5.DLL" then
		v = ProductVer(p.DriverPath)
		'FIXME: Add version checking for Oce drivers that say "see ocewpdid.dll" (really!)
	else
		f = FSO.GetFileName(p.ConfigFile)
		if UCase(f) <> "UNIDRVUI.DLL" and UCase(f) <> "PS5UI.DLL" then
			v = ProductVer(p.ConfigFile)
			if len(v) >= 3 then v = v & " (" & Replace(LCase(f), ".dll", "") & ")"
		end if
		'Sometimes the ProductVer is unavailable, e.g. hpzpi4wm.dll@2007-02-13
		if UCase(f) = "UNIDRVUI.DLL" or UCase(f) = "PS5UI.DLL" or Len(v) < 3 then
			wscript.echo "Checking dependent files" & vbTab & p.Name & " " & p.SupportedPlatform
			v = DependentFilesVersion(p.DependentFiles)
			if len(v) < 3 then
				wscript.echo "Still no version, getting date of " & p.DataFile
				f = FSO.GetFile(p.DataFile).DateLastModified
				v = "[" & LCase(FSO.GetExtensionName(p.DataFile)) & "~" _
					& Year(f) & "-" & Right(0 & Month(f), 2) & "-" & Right(0 & Day(f), 2) & "]"
			end if
		end if
	end if
 
	f = Left(p.Name, Len(p.Name) - 2 - Len(p.SupportedPlatform) - Len(p.Version))
 
	'wscript.echo vbTab & v & vbTab & """" & f & """"
	DriverVersion = Array(v, f)
	'wscript.echo f & vbTab & versions(f)
End Function
 
 
Private Function DependentFilesVersion(df)	'Pass the array of dependent files; only called by DriverVersion
	'Prefer x*ui*.dll but settle for *ui*.dll, or *.dll; but at least capture the first filename
	Dim a, fn : a = Filter(df, ".dll", True, vbTextCompare)
	if UBound(a) >= 0 then
		fn = a(0)
		a = Filter(a, "ui", True, vbTextCompare)
		if UBound(a) >= 0 then
			fn = a(0)
			a = Filter(a, "\x", True, vbTextCompare)
			if UBound(a) >= 0 then
				fn = a(0)
			end if
		end if
	else
		DependentFilesVersion = ""
		Exit Function
	end if
 
	wscript.echo "Checking dependent file " & fn
	Dim v : v =  ProductVer(fn)
	if Instr(v, ",") > 0 then v = FileVer(fn)	'if commas in Product Version then use File Version
	if len(v) >= 3 then v = v & " [" & LCase(FSO.GetBaseName(fn)) & "]" 'credit/blame
	DependentFilesVersion = v
End Function
 
 
Function ProductVer(filename)
	Dim nmsp : Set nmsp = SHA.Namespace(FSO.GetParentFolderName(FSO.GetAbsolutePathName(filename)))
	Productver = nmsp.GetDetailsOf(nmsp.ParseName(FSO.GetFileName(filename)), productversion)
End Function
 
Function FileVer(filename)
	Dim nmsp : Set nmsp = SHA.Namespace(FSO.GetParentFolderName(FSO.GetAbsolutePathName(filename)))
	Filever = nmsp.GetDetailsOf(nmsp.ParseName(FSO.GetFileName(filename)), fileversion)
End Function
 
'***********************************************************
Set wmiq = WMIQuery("Name, ConfigFile, DataFile, DriverPath, DependentFiles, SupportedPlatform, Version" _
	& "; Win32_PrinterDriver")
Phase "Enumerate Printer drivers and determine their product versions"
'***********************************************************
For Each p in wmiq
	dim a : a = DriverVersion(p) : f = a(1)
	if versions.exists(f) then
		versions(f) = versions(f) & "<br>"
	else
		versions(f) = ""
	end if
	versions(f) = versions(f) & Mid(p.SupportedPlatform, InStrRev(p.SupportedPlatform, " ") + 1) & "=" & a(0)
Next
 
 
Function DontShout(drivername)	'These companies like to SHOUT their names, but their websites use lcase. Rude!
	DontShout = drivername
	Dim s : for each s in Split("Konica Minolta Ricoh Sharp")
		DontShout = Replace(DontShout, UCase(s), s)
	next
End Function
 
Function ShareStatus(ps, s)
	ShareStatus = PrinterStatusTxt(ps) & Replace(", " & s, ", Unknown", "")	'Don't list Status if Unknown
	ShareStatus = Replace(ShareStatus, "Other, ", "=>")		'Don't list PrinterStatus if Other
	if "<" = Left(td, 1) then ShareStatus = Replace(ShareStatus, "=>", "=&gt;")	'Use HTML if needed
End Function
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The WMI Query line is where servers sometimes get stuck.
'It is similar to the command:    wmic printer list brief
'One could check WMI goodness with:           wmic server
'Note: restarting Print Spooler service doesn't unstuck.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'***********************************************************
Set wmiq = WMIQuery("Win32_Printer")
Phase "Enumerate expansions for each known printer, and add its driver/processor/datatype by sharename"
'***********************************************************
For each p in wmiq
	Phase "Check printer port " & p.PortName
	totals(0) = totals(0) + 1
	'WScript.Echo p.DeviceID & vbTab & " MarkingTechnology: " & p.MarkingTechnology
	'if len(p.ShareName) then
		dim c : c = ""
		if not IsNull(p.CapabilityDescriptions) then
			'Collate: True if a printer has collating bins.
			'Color: True if a printer can print in color. (but see LaserJet note below)
			'Duplex: Indicates the type of duplex support a printer has.
			'(HP claims Color on 4M, 4 Plus, 5Si MX, 8000, 8100, 8150, 9050 as of Server 2003.)
			'(Oce clams Color on TDS400, TDS450, TDS600, TDS700 as of Server 2003.)
			'(Try it yourself: WMIC Printer GET CapabilityDescriptions,DriverName)
			'FIXME: add honesty override for manufacturers setting this on non-color devices?
			Phase "Check port " & p.PortName & " capabilities"
			for each t in p.CapabilityDescriptions
				'Never seen one that lacked "Copies", so filter that out
				if t <> "Copies" then  c = c & t & " "
			next
			c = Replace(Trim(c), " ", "|")
		end if
		dim port : port = p.PortName
		dim mac : mac = ""
		if "IP_" = Left(p.PortName, 3) then
			port = Mid(p.PortName, 4)	'Strip off the "IP_" if present
			if not ports.Exists(port) then ports(port) = port
			if macs.Exists(port) then
				mac = macs(port)
	'			macs.Remove(port)	'Possibly reused?
	'			reservations.Remove(port)
			end if
		end if
		dim ping : ping = pingable(port)
		Phase "Check printer's error state, complete expansion"
		subcolor = colors(ErrorStateVal(p.DetectedErrorState))
		dim res : res = p.HorizontalResolution
		if res <> p.VerticalResolution then res = res & "x" & p.VerticalResolution
		Dim errtxt : errtxt = ErrorStateTxt(p.DetectedErrorState)
		exps(port) = "<tr>" _
				& td & p.ShareName _
				& td & port _
				& td & res _
				& td & DontShout(p.DriverName) & td & versions(p.DriverName) _
				& td & p.PrintProcessor _
				& td & c _
				& td & ShareStatus(p.PrinterStatus, p.Status) _
				& td & "&" & subcolor & " " & errtxt _
				& td & "&" & ping _
				& td & p.Comment _
				& Replace(td, "<", "</") & vbCRLF & exps(port)
 
if dbg then wscript.echo port & vbTab & exps(port)
		if "green" = ping then
			if 9 = p.DetectedErrorState then	'Offline
				if p.Status = "Degraded" and 1 = p.PrinterStatus then 'Other
					LINE = LINE & "&red " & p.ShareName & " has Other/Degraded/Offline" _
					& ", hallmarks of Spooler service restart required." & vbCRLF
					color = "red"
				else
					LINE = LINE & "&red " & p.ShareName & " can be pinged at " & port _
					& " but claims " & errtxt & "; restart Spooler service?" & vbCRLF
					if color <> "red" then  color = "yellow"
				end if
			end if
		end if
		Phase "Add share " & p.ShareName & " to drivers list"
		drivers(p.ShareName) = p.DriverName
		Phase "Add share " & p.ShareName & " to processors list"
		processors(p.ShareName) = p.PrintProcessor
		Phase "Add share " & p.ShareName & " to datatypes list"
		datatypes(p.ShareName) = p.PrintJobDataType
		Phase "Finished with Adding share " & p.ShareName & " to lists"
	'end if
Next
 
 
'Oddly, if Win32_Printer isn't requeried, "SWbemObjectSet: Unspecified error"
Set wmiq = WMIQuery("Win32_Printer")
Phase "Remove MACs with corresponding printers from DHCP reservation list"
'WARNING: Script can sometimes hang right at this next line; next Phase line twice for debugging
For Each p in wmiq
	Phase "Check printer MAC"
	Phase "Check printer MAC " & p.PortName
	'if len(p.ShareName) then
		port = Mid(p.PortName, 4)	'Strip off the "IP_"
		if macs.Exists(port) then
			Phase "Check printer MAC for " & port
			totals(2) = totals(2) + 1
			macs.Remove(port)
			reservations.Remove(port)
		end if
	'end if
Next
 
 
'***********************************************************
Phase "List each printer share with its expansion"
'***********************************************************
if len(LINE) > 1 then LINE = LINE & vbCRLF
LINE = LINE & "<table id=shares border=1 cellpadding=3 class=sortable>" & vbCRLF _
	& "<tr>" &th& "Share" &th& "Port" &th& "Res" _
	&th& "Driver" &th& "Version" &th& "Processor" &th& "Capabilities"
'if Instr(th, "<") > 0 then LINE = LINE & "<th colspan=2>" else LINE = LINE & th
LINE = LINE & th
LINE = LINE & "Status" & th & "Error" & th & "Ping" & th & "Comment" & vbCRLF
for each p in ports.Keys
	'wscript.echo vbTab & p & vbTab & exps(p)
 
	if len(exps(p)) then LINE = LINE & exps(p)
next
LINE = LINE & vbCRLF & "</table>" & vbCRLF
 
 
'Some credit to http://blogs.msdn.com/b/ericlippert/archive/2004/12/03/274360.aspx
Function CULng(ByVal x)
  If x < 0 Then CULng = x + 2^32 Else CULng = x
End Function
 
 
 
'***********************************************************
Dim jobs : jobs = ""
Set wmiq = WMIQuery("Win32_PrintJob")
Phase "Enumerate Print jobs"
'***********************************************************
For Each p in wmiq
	totals(3) = totals(3) + 1
	Dim eltime : eltime = ""
	if not IsNull(p.ElapsedTime) then
		eltime = CLng(Left(p.ElapsedTime,14))
		if 0 = eltime then eltime=""
	end if
	Select case p.Status
		Case "Error":	subcolor = "yellow" : if color <> "red" then color = "yellow"
				LINE = "&yellow """ & p.Document & """ at " & p.Description & " has error." _
					 & vbCRLF & LINE
		Case "UNKNOWN":	subcolor = "clear"
		Case "Degraded":subcolor = "yellow"	'Usually paused jobs so don't propagate
		Case "OK":	subcolor = "green"
		Case Else:	subcolor = "clear" : if color = "green" then color = "clear"
			'Pred Fail,Starting,Stopping,Service,Stressed,NonRecover,No Contact,Lost Comm
	End Select
	jobs = jobs & "<tr>" & td & "&" & subcolor & " " & p.Status
	if p.Owner <> p.Notify then
		jobs = jobs &td& p.Owner &"/"& p.Notify
	else
		jobs = jobs &td& p.Owner
	end if
	'Some print jobs are over 2 GB, so make sure the size is an Unsigned Long.
	jobs = jobs &td& p.TotalPages &td& CULng(p.Size) &td& dt(p.TimeSubmitted) _
		&td& p.Document &td& p.Description &td& p.HostPrintQueue
	Dim k, pinged : pinged = "&clear" : for each k in exps.keys
		If Instr(exps(k), td & Split(p.Description, ",")(0) & td) > 0 then
			'wscript.echo p.Document & vbTab & k & vbTab
			pinged = "&" & pingable(k)
		End If
	next
	'Expansions won't be found if the printer name differs from the share name.
	if pinged = "&clear" then Phase "Unable to find expansion for " & p.Description
	jobs = jobs & td & pinged & " &" & pingable(Replace(p.HostPrintQueue, "\\", ""))
 
	Dim notes : notes = ""
	if p.PagesPrinted > 0 then notes = notes & D & "PagesPrinted=" & p.PagesPrinted
	if len(p.StartTime) > 0 then notes = notes & D & "StartTime=" & p.StartTime
	if len(eltime) > 0 then notes = notes & D & "ElapsedTime=" & eltime
	if len(p.UntilTime) <> 0 then notes = notes & D & "UntilTime=" & p.UntilTime
	if len(p.Parameters) > 0 then notes = notes & D & "Parameters=" & p.Parameters
	if p.Priority <> 1 then notes = notes & D & "Priority=" & p.Priority
	if len(p.JobStatus) > 0 then notes = notes & D & "JobStatus=""" & p.JobStatus & """"
	if p.StatusMask <> 0 then notes = notes & D & "StatusMask=" & p.StatusMask
	if len(p.InstallDate) <> 0 then notes = notes & D & "InstallDate=" & p.InstallDate
 
	'We have the expected processor/driver/datatype by share, so note it if it doesn't match
	dim sn : sn = left(p.Description, Instr(p.Description, ",") - 1)	'Share Name
	if p.PrintProcessor <> processors(sn) then notes = notes & D & "PrintProcessor=""" & p.PrintProcessor & """"
	if p.DriverName <> drivers(sn) then notes = notes & D & "Driver=""" & p.DriverName & """"
	if p.DataType <> datatypes(sn) then notes = notes & D & "DataType=""" & p.DataType & """"
 
	if len(notes) > 0 then notes = Mid(notes, 1+len(D))	'Remove initial delimiter
	jobs = jobs &td& notes & vbCRLF
Next
 
'***********************************************************
Phase "If there are any print jobs then add them to the report"
'***********************************************************
if len(jobs) > 0 then LINE = LINE & "<br></pre><table id=jobs border=1 cellpadding=3 class=sortable>" & vbCRLF _
		& "<tr>" & th & "Status" & th & "Owner/<br>Notify" _
		& th & "Total<br>Pages" & th & "Size" & th & "TimeSubmitted" _
		& th & "Document" & th & "Description<br>(Printer, Job)" & th & "Host<br>PrintQueue" _
		& th & "Ping" & th & "Notes" & vbCRLF & jobs & "</table><pre>"
 
 
 
'***********************************************************
Phase "Expand MACs without corresponding printers (e.g. digital senders) as unused"
'***********************************************************
Dim r : set r = New RegExp
r.Pattern = IPpattern
for each p in macs.Keys
	'set c = r.Execute(p) : wscript.echo vbTab & c.Count & vbTab & p
	if r.Execute(p).Count > 0 then
		'totals(1) = totals(1) + 1
		'exps(p) = "<tr>" & td & reservations(p) & td & resdescriptions(p) & td & macs(p) & td & p & td _
		'	& td & "<div align=right>(unused at " & WSH.Environment("Process")("COMPUTERNAME") & ")</div>" _
		'	& td & td & td & td & td & td & td & "&" & pingable(p) & " " & td & vbCRLF & exps(p)
		if 0 = len(tcpips(p)) then
			tcpips(p) = "<tr>" & td & reservations(p) & td & resdescriptions(p) _
				& td & p & td & "&" & pingable(p) & td & macs(p) & td _
				& divright("unused") & td
		end if
	else
		if ports.Exists(p) then  ports.Remove(p)
	end if
	if dbg then wscript.echo vbTab & p & vbTab & """" & exps(p) & """"
next
 
 
'***********************************************************
Phase "Output the ports/MACs list, including unassigned DHCP reservations"
'***********************************************************
LINE = LINE & vbCRLF & vbCRLF & "<table id=ports border=1 cellpadding=3 class=sortable>" & vbCRLF _
	& "<tr>" & th & "Reservation" & th & "Reservation Description" & th & "Address" & th & "Ping" & th & "MAC" _
		& th & "TCP, Port|LPR, Name" & th & "SNMP" & th & "Driver"
for each p in tcpips.Keys
	wscript.echo vbTab & p & vbTab & tcpips(p)
	if len(tcpips(p)) then
		LINE = LINE & vbCRLF & tcpips(p)
		if len(exps(p)) then
			LINE = LINE & td & Split(exps(p), td)(4)
		else
			LINE = LINE & td & divright("unused")
		end if
	end if
next
LINE = LINE & vbCRLF & "</table>" & vbCRLF
 
 
Function divright(s)
	divright = "<div align=right><i>(" & s & " on " & WSH.Environment("Process")("COMPUTERNAME") & ")</i></div>"
End Function
 
 
 
'***********************************************************
Phase "Actually output the report (" & len(LINE) & ")"
'***********************************************************
WriteStatus "prnt", color, "Printers list (" _
	& totals(0) & " shares on " & totals(2) & " MACs, " _
	 & totals(1) & " unassigned MACs; " & ports.Count & " ports total; " & totals(3) & " jobs)", LINE
'if dbg then wscript.echo LINE
 
Function dt(t)	'Colorize by age
	dt = ""
	if not IsNull(t) then
		Dim dtt : dtt = CLng(Left(t, 8))	'Date of submission
		Dim d : d = Now : d = 10000 * Year(d) + 100 * Month(d) + Day(d)
		Select Case d - dtt
			Case 0		: dt = "&green" 	'today
			Case 1		: dt = "&yellow"	'yesterday
			Case 2,3,4,5,6	: dt = "&red"   	'past week
			Case Else	: dt = "&purple"	'long ago
		End Select
		dt = dt & dtt & " " & Mid(t, 9, 6) & Right(t,4)
	end if
End Function
 
Function pingable(ip)
	if not IsNumeric(Left(ip, 1)) then
		pingable = "clear"	'Disable test if not an IP address
		Exit Function
	end if
	if pingables.Exists(ip) then
		Phase "Already tried to ping " & ip & ", " & pingables(ip)
		pingable = pingables(ip)
		exit function
	end if
	'pingable = "green" : exit function
	Phase "Try to ping " & ip
	'Dim WMI_ : Set WMI_ = GetObject("winmgmts:{impersonationLevel=impersonate}")
	'The following should be a WMI Get rather than a query, as only one response is usable
	Dim pings : Set pings = WMI.ExecQuery("select * from Win32_PingStatus where address = '" & ip & "'")
	Dim pi : for each pi in pings
		pingables(ip) = "green"
		if 0 <> pi.StatusCode then pingables(ip) = "red"
		pingable = pingables(ip)
		exit function
	next
End Function
 
'######################################################################
'Write out the status; depends on FSO and WSH; will use TimerStart if available for duration
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")
	Dim HKLMSoft : HKLMSoft="HKLM\SOFTWARE"
	if WSH.Environment("SYSTEM")("PROCESSOR_ARCHITECTURE") <> "x86" then HKLMSoft = HKLMSoft & "\Wow6432Node"
	Const LEAKYMAX = 8500, BBWinreg = "\BBWin\tmpPath"
	Const Questreg = "\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 colfn, src, leaky : colfn = "" : colfn = WSH.RegRead(HKLMSoft & BBWinreg) : src = "bbwin"
	If "" = colfn then : colfn = WSH.RegRead(HKLMSoft & Questreg) : src = "" : end if
	If "" = colfn then Exit Sub			'Abort if nothing in the registry for location.
	colfn = colfn & "\" & column			'Add the column name to make it a real colfile.
	Dim tmpfn : tmpfn = colfn & ".$$$"		'Temporary file; use temporary name for safety!
	If FSO.FileExists(tmpfn) Then WScript.Quit 183	'Bail out if already there (i.e. previous stuck)
	Phase "Create temporary file with status"
	With FSO.CreateTextFile(tmpfn, True)
		if err then WScript.Quit err	'Bail out if unable to create file.
		if Len(quickie) + Len(line) > LEAKYMAX and src = "bbwin" then
			leaky = True
			.Write "status " & WSH.RegRead(HKLMSoft & "\BBWin\hostname") & "." & column & " "
		end if
		.WriteLine color & " " & WeekdayName(Weekday(Now),True) & " " _
			& Mid(Now,1,InStr(Now," ")-1) & " " & TimeValue(Now) _
			& " [" & WSH.Environment("Process")("COMPUTERNAME") & "] " & quickie
		.WriteLine line
		.Write "<center><small>" & WScript.ScriptName & " (modified " & CDate(CLng( _
			FSO.GetFile(WScript.ScriptFullName).DateLastModified))
		if not IsNull(TimerStart) then .Write "; run time " & Timer - TimerStart & "s"	'midnight bug
		.Close
	End With
	With FSO.OpenTextFile(tmpfn, 8)
		.Write "; len ~" & FSO.GetFile(tmpfn).Size + 29 & ")</small></center>"	'assume 1-9kB
		.Close
	End With
	'***********************************************************
	'Rename file so client will see it (taking care to remove any unprocessed file first)
	'Or send directly with bbwincmd.exe if over LEAKYMAX and using bbwin
	'***********************************************************
	Phase "Rename temporary file for automatic send -OR- send directly"
	on error goto 0
'wscript.echo len(line)
	if leaky then	'if FSO.GetFile(tmpfn).Size > LEAKYMAX and src = "bbwin" then
		Dim XML : Set XML = CreateObject("Microsoft.XMLDOM")	'Requires MSIE 5 or later
		If XML.Load(WSH.RegRead(HKLMSoft & "\BBWin\etcPath") & "\bbwin.cfg") then
			Phase "Status2XML, len=" & FSO.GetFile(tmpfn).Size
			Dim x, s : for each x in XML.SelectNodes("//configuration/bbwin/setting[@name='bbdisplay']")
				s = x.Attributes.GetNamedItem("value").Value
				Phase "upload to " & s & " " & tmpfn
				WSH.Run "..\bin\bbwincmd.exe " & s & " uploadmessage """ & tmpfn & """", 1, True
			next
		Else
			WScript.Echo "Error parsing " & WSH.RegRead(HKLMSoft & "\BBWin\etcPath") & "\bbwin.cfg"
		End If
		FSO.DeleteFile tmpfn
	else
		if FSO.FileExists(colfn) then FSO.DeleteFile(colfn)
		FSO.MoveFile tmpfn, colfn
	end if
End Sub
 
'If the script gets stuck, we can use Process Explorer to examine its environment
Sub Phase(n)
	if dbg then wscript.echo vbTab & n
	CreateObject("WScript.Shell").Environment("Process")("P-" & WScript.ScriptName) = n & " (" & Now & ")"
End Sub
 
Function WMIQuery(ByVal s)
	Phase "WMI Query: " & s
	if Instr(s, ";") > 1 then s = Replace("Select " & s, ";", " from ") else s = "Select * from " & s
	Set WMIQuery = WMI.ExecQuery(s)	'This did have a ,,48 but I'm not sure it's worthwhile
	Phase "WMI Queried: " & s
End Function

Known Bugs and Issues

  • Figure out what credentials are required to remotely retrieve a DHCP server's reservation list.
  • Determine why a WMI query for Win32_Printer sometimes gets stuck.

To Do

  • Confirm that changing td/th to tabs actually does produce readable (non-HTML) output.
  • Figure out why the server sometimes claims a printer has gone offline when it hasn't, and won't come back online unless the Spooler service is restarted. This script will consider a printer in this situation (offline but pingable) as having a red status, with a need to restart the Print Spooler service likely.
  • Perhaps find more methods that printer driver creators use to embed the version numbers in their drivers.

Credits

(see source code)

Changelog

  • 2012-05-03
    • Initial release
  • monitors/listprn.txt
  • Last modified: 2012/05/04 08:28
  • by 127.0.0.1