Option Explicit
const LSMONEXE="C:\Program Files\BBWin\ext\lsmon.exe"
Dim TimerStart : TimerStart = Timer
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
const dbg=False
Phase 1
WSH.Run "cmd.exe /c echo . | """ & LSMONEXE & """ > lsmon.txt", 0, 1
Phase 2
With FSO.OpenTextFile("lsmon.txt", 1)
Dim a : a = .ReadLine : a = Split(.ReadAll, vbCRLF)
.Close
End With
Phase 3
'These are filtering from the first part (overall license characteristics).
'Note that 8.x and 7.2 have a space in front of each line, 7.0 does not.
Dim i : for each i in Array("License type", " License Version" _
, " Able to issue", " commuter licenses", "Additive/exclusive" _
, " Application-server locking", "App-server locking" _
, "Held licenses", "Soft limit on users" _
, "License start", "Sharing limit")
a = Filter(a, i, False)
next
for each i in Array(" locking code", " Local request")
a = Filter(a, i, False)
next
Phase 4
'These are filtering from the details (each user token)
for each i in Array("Reserved tokens", "Reserved Tokens", "Available reserv" _
, "X display name", ": DefaultGrp")
a = Filter(a, i, False)
next
Phase 5
'This strips the last line
for each i in Array("Press Enter", "Hit Enter to continue")
a = Filter(a, i, False)
next
Phase 6
'These change the output on a 7.0 lsmon.exe from combined lines to pure NCV
'And compensate for 7.2's tab
for i = 0 to UBound(a) - 1
Dim n : n = Instr(a(i), "Feature version")
If n > 5 Then
a(i) = Left(a(i), n - 3) & vbCRLF & Mid(a(i), n)
a(i) = Replace(a(i), vbTab & ":", vbTab & " :")
End If
n = Instr(a(i), "Available unreserved")
If n > 5 Then
a(i) = Left(a(i), n - 3) & vbCRLF & Mid(a(i), n)
a(i) = Replace(a(i), vbTab & ":", vbTab & " :")
End If
n = Instr(a(i), "Feature name " & vbTab & vbTab)
if n = 2 then
a(i) = Replace(a(i), " :", ":")
end if
next
Phase 7
'This concatenates the output, putting an <HR> between each feature
'Note that 8.x outputs "Feature name" at top, 7.x outputs "Commuter License Allowed"
a = Replace(Join(a, vbCRLF), vbCRLF & " ", vbCRLF) 'Strip space at 8.x's line beginning
a = Replace(a, vbCRLF & vbCRLF & "Feature name " _
, vbCRLF & "<hr>" & vbCRLF & vbCRLF & "Feature name ")
a = Replace(a, vbCRLF & vbCRLF & "Commuter License Allowed " _
, vbCRLF & "<hr>" & vbCRLF & vbCRLF & "Commuter License Allowed ")
WriteStatus "lsmon", "green", "lsmon", a
'######################################################################
'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 : 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 "Status1"
On Error Resume Next
With FSO.CreateTextFile(tmpfn, True)
if err then WScript.Quit err 'Bail out if unable to create file.
if Len(line) > LEAKYMAX and src = "bbwin" then _
.Write "status " & WSH.RegRead(HKLMSoft & "\BBWin\hostname") & "." & column & " "
.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
.Write ")</small></center>"
.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 8kB
'***********************************************************
Phase "Status2"
on error goto 0
'wscript.echo len(line)
if Len(line) > 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"
Dim x : for each x in XML.SelectNodes("//configuration/bbwin/setting[@name='bbdisplay']")
WSH.Run "..\bin\bbwincmd.exe " & x.Attributes.GetNamedItem("value").Value _
& " 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 n
CreateObject("WScript.Shell").Environment("Process")("P-" & WScript.ScriptName) = n
End Sub