'****************************************************************************'
'* Title:     PrinterAudit.vbs
'* Author(s): Richard Iglar (riglar@isbgroup.com)
'* Version:   2.0 (12/19/2007)
'* Website:   http://www.isbgroup.com
'* Usage:     cscript printeraudit.vbs /?
'****************************************************************************'
  On Error Resume Next
  MakeHostCscript

  Class UserJobs
    Public intUserJobs
    Public intPagesPrinted
    Public dateFirst
    Public dateLast
  End Class

  'Global Variables
  Dim strServer, strInputFile, colUsers
  Dim objFS, objWSH, objPrinterMaster, boolNoPing

  boolNoPing = False

  Set objWSH = Wscript.CreateObject("Wscript.Shell")
  Set objFS = CreateObject("Scripting.FileSystemObject")

  Call RegisterCom("PrintMaster.PrintMaster.1","prnadmin.dll")
  Set objPrinterMaster = CreateObject("PrintMaster.PrintMaster.1")

  Set colUsers = CreateObject("Scripting.Dictionary")
  colUsers.CompareMode = vbTextCompare

  'Parse out the command line
  Call ParseCommandLine

  If (strServer = "" And strInputFile = "") Then
    Wscript.Echo("No server name entered, aborting script.")
    Wscript.Quit(1)
  End If


  'If an individual print server is selected...
  If (strServer <> "") Then
    Call CheckServer(strServer)
  End If

  'If an input file is selected...
  If (strInputFile <> "") Then
    Err.Clear
    If (objFS.FileExists(strInputFile)) Then
      Set fileList = objFS.OpenTextFile(strInputFile,1)
      strServer = fileList.Readline
      Do While (fileList.AtEndOfStream <> True)
        If (Left(strServer,1) <> ";" And strServer <> "") Then
          Call CheckServer(strServer)
        End If
        strServer = fileList.ReadLine
      Loop
      fileIn.Close
    Else
      Wscript.Echo("Input file does not exist: " & strInputFile)
    End If
  End If

Wscript.Quit(0)


'****************************************************************************'
'* Functions & Subroutines                                                  *'
'****************************************************************************'

Sub CheckServer(strPrintServer)
  On Error Resume Next

  Set colPrinterUsers = CreateObject("Scripting.Dictionary")
  colPrinterUsers.CompareMode = vbTextCompare

  Wscript.Echo(vbCrLf & vbCrLf & "Target Server: " & strPrintServer & vbCrLf)

  strOutputFolder = "Output"
  If (Not objFS.FolderExists(strOutputFolder)) Then
    Set objFolder = objFS.CreateFolder(strOutputFolder)
  End If

  strEventLogFile = ".\Output\_" & strPrintServer & "_PrintEvents.txt"

  'If a current event log file exists; open it to get the last event so we only
  'capture new events.  The most recent print job is at the top.
  strLastRun = ""
  strEvents = ""
  If (objFS.FileExists(strEventLogFile)) Then
    Set fileIn = objFS.OpenTextFile(strEventLogFile,1)
    strEvents = fileIn.ReadAll
    fileIn.Close
    strLastRun = Left(strEvents,InStr(strEvents,vbTab)-1)
  End If

  'Dump the event log so we can scan print jobs.
  Wscript.Echo("Dumping printer events...")

  Err.Clear
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strPrintServer & "\root\cimv2")
  strWMIQuery = "SELECT LogFile,EventCode,Message,SourceName,TimeWritten,User FROM Win32_NTLogEvent WHERE Logfile='System' AND EventCode='10' AND SourceName='Print'"
  If (strLastRun <> "") Then
    strWMIQuery = strWMIQuery & " AND TimeWritten > '" & strLastRun & "'"
    Wscript.Echo("Last Saved Event = " & strLastRun)
  End If
  Set colRetrievedEvents = objWMIService.ExecQuery(strWMIQuery,,48)
  
  intEvents = 0
  Set fileOut = objFS.CreateTextFile(strEventLogFile,True)
  For Each objEvent in colRetrievedEvents
    intEvents = intEvents + 1
    Wscript.StdOut.Write(intEvents & Chr(13))
    fileOut.Write(objEvent.TimeWritten & vbTab & objEvent.User & vbTab & objEvent.Message)
  Next
  'Append the saved events to the file so we have a continous list.
  If (strEvents <> "") Then
  	fileOut.Write(strEvents)
  End If
  fileOut.Close

  Set fileIn = objFS.OpenTextFile(strEventLogFile,1)
  If (fileIn.AtEndOfStream) Then
    Wscript.Echo(vbCrLf & "Error: No printer events retrieved! Check access to source server." & vbCrLf)
    strEventLog = ""
    Exit Sub
  Else
    strEventLog = fileIn.ReadAll
  End If
  fileIn.Close

  'Log files
  strUsersOutputFile = "Output\" & strPrintServer & "_Users.csv"
  strPrinterOutputFile = "Output\" & strPrintServer & "_Printers.csv"
  Err.Clear
  Set fileOut = objFS.CreateTextFile(strPrinterOutputFile,True)
  If (Err.Number <> 0) Then
    Wscript.Echo("Error creating output file: " & strPrinterOutputFile)
    Wscript.Echo("Error 0x" & Err.Number & ": " & Err.Description)
    Exit Sub
  End If

  Wscript.Echo("Enumerating printers...")
  fileOut.WriteLine("Printer,ShareName,Comment,Location,Driver,Port,IP Address,Ping Test,EventLog Check,First Job,First UserID,Last Job,Last UserID,Jobs,Days,Jobs/Day,Pages")

  Err.Clear
  intPrinterCount = 0
  For Each objPrinter in objPrinterMaster.Printers("\\" & strPrintServer)
    If (Err.Number = 0) Then
      strIPAddress = ""
      strPingTest = ""
      strEventCheck = ""
      dateLast = ""
      strLastUser = ""
      dateFirst = ""
      strFirstUser = ""
      intJobs = 0
      intDays = 0
      intPages = 0
      dblJobsDay = 0.0

      'Get IP Address and ping server to see if it's alive.
      If (InStr(objPrinter.PortName,":") > 0) Then
        strIpAddress = Left(objPrinter.PortName,InStr(objPrinter.PortName,":")-1)
      ElseIf (InStr(objPrinter.PortName,"IP_") > 0) Then
        strIpAddress = Mid(objPrinter.PortName,4,30)
      Else
        strIPAddress = objPrinter.PortName
      End If

      If (InStr(strIPAddress,"LPT") Or InStr(strIpAddress,"COM")) Then
        strIPAddress = ""
      End If

      'Ping the printer
      If (boolNoPing) Then
        strPingTest = "Skipped"
      ElseIf (strIpAddress <> "") Then
        If (objWSH.Run("cmd /c ping " & strIpAddress & " | find /i "& """" & "TTL=" & """",0,True) = 0) Then
          strPingTest = "Success"
        Else
          strPingTest = "Failure"
        End If
      End If

      'Count the # of jobs using regular expressions
      strSearchPrinter = Replace(objPrinter.PrinterName,"\\","")
      strSearchPrinter = "\s" & Replace(Mid(strSearchPrinter,InStr(strSearchPrinter,"\")+1)," ","\s") & "\s"
      strSearchPrinter = Replace(strSearchPrinter,"(","\(")
      strSearchPrinter = Replace(strSearchPrinter,")","\)")
      'Wscript.Echo strSearchPrinter

      strPattern = "\d{14}\.\d{6}-\d{3}.*" & strSearchPrinter & ".*\n"
    
      Set objRegExp = New RegExp
      With objRegExp
        .Pattern = strPattern
        .Global = True
        .IgnoreCase = True
      End With
      intJobs = objRegExp.Execute(strEventLog).Count

      If (intJobs > 0) Then
        strEventCheck = "Success"
        'Generate a list of users that printed to each printer
        For Each objMatch in objRegExp.Execute(strEventLog)

          arrTokens = Split(objMatch,vbTab)

          dateFirst = WMIDateStringToDate(arrTokens(0))
          strFirstUser = arrTokens(1)

          intPagesPrinted = CInt(Mid(objMatch,InStr(objMatch,"pages printed: ")+15))
          intPages = intPages + intPagesPrinted

          If (dateLast = "") Then
            dateLast = dateFirst
            strLastUser = strFirstUser
          End If

          'Wscript.Echo(strUserID)
          strEntry = objPrinter.PrinterName & "," & strFirstUser
          If (colPrinterUsers.Exists(strEntry)) Then
            colPrinterUsers.Item(strEntry).intUserJobs = colPrinterUsers.Item(strEntry).intUserJobs + 1
            colPrinterUsers.Item(strEntry).intPagesPrinted = colPrinterUsers.Item(strEntry).intPagesPrinted + intPagesPrinted
            colPrinterUsers.Item(strEntry).dateFirst = dateFirst
          Else
            colPrinterUsers.Add strEntry, New UserJobs
            colPrinterUsers.Item(strEntry).intUserJobs = 1
            colPrinterUsers.Item(strEntry).intPagesPrinted = intPagesPrinted
            colPrinterUsers.Item(strEntry).dateFirst = dateFirst
            colPrinterUsers.Item(strEntry).dateLast = dateLast
          End If
        Next

        'Calculate average jobs/day for the printer
        intDays = FormatNumber(CDate(dateLast) - CDate(dateFirst),1,-1,0,0)
        If (intDays <= 1) Then intDays = 1 End If
        dblJobsDay = FormatNumber(intJobs/intDays,1,-1,0,0)
      Else
        dblJobsDay = FormatNumber(intJobs,1,-1,0,0)
        strEventCheck = "Failure"
      End If

      Wscript.Echo(objPrinter.PrinterName & " - " & intJobs & " jobs")
      fileOut.WriteLine(objPrinter.PrinterName & "," & objPrinter.ShareName & ",""" & Replace(objPrinter.Comment,VbCrLf," ") & """,""" & objPrinter.Location & """,""" & objPrinter.DriverName & """,""" & objPrinter.PortName & """,""" & strIpAddress & """," & strPingTest & "," & strEventCheck & "," & dateFirst & "," & strFirstUser & "," & dateLast & "," & strLastUser & "," & intJobs & "," & intDays & "," & dblJobsDay & "," & intPages)
    Else
      Wscript.Echo("Unable to list printers, error: 0x" & Hex(Err.Number) & ". " & Err.Description)
    End If
    Err.Clear
    intPrinterCount = intPrinterCount + 1
  Next
  fileOut.Close

  'Generate User Lists for all printers
  Set fileUser = objFS.CreateTextFile(strUsersOutputFile,True)
  If (Err.Number <> 0) Then
    Wscript.Echo("Error creating output file: " & strPrinterOutputFile)
    Wscript.Echo("Error 0x" & Err.Number & ": " & Err.Description)
    Exit Sub
  End If
  Wscript.StdOut.Write("Enumerating users")
  fileUser.WriteLine("Printer,User ID,First Job,Last Job,Jobs,Days,Jobs/Day,Pages,Full Name,Description")

  Dim arrKeys
  arrKeys = colPrinterUsers.Keys
  For i = 0 To colPrinterUsers.Count - 1
    'Wscript.Echo Mid(arrKeys(i),InStr(arrKeys(i),",")+1)
    intUserJobs = 0
    intUserDays = 0
    dblUserJobsDay = 0.0
    strFullNameDesc = ""

    'Optimized so that once a user is retrieved from the network, they don't need to be retrieved again.
    strUserName = Replace(Mid(arrKeys(i),InStr(arrKeys(i),",")+1),"\","/")
    If (colUsers.Exists(strUserName)) Then
      Wscript.StdOut.Write(":")
    Else
      Wscript.StdOut.Write(".")
      Err.Clear
      Set objUser = GetObject("WinNT://" & strUserName & ",user")
      If (Err.Number = 0) Then
        colUsers.Add strUserName, """" & objUser.FullName & """,""" & objUser.Description & """"
      Else
        colUsers.Add strUserName, ""
      End If
      Set objUser = Nothing
    End If
    strFullNameDesc = colUsers.Item(strUserName)

    With colPrinterUsers.Item(arrKeys(i))
      'Calculate average jobs/day
      intUserDays = FormatNumber(CDate(.dateLast) - CDate(.dateFirst),1,-1,0,0)
      If (intUserDays <= 1) Then intUserDays = 1 End If
      dblUserJobsDay = FormatNumber(.intUserJobs/intUserDays,1,-1,0,0)
      fileUser.WriteLine(arrKeys(i) & "," & .dateFirst & "," & .dateLast & "," & .intUserJobs & "," & intUserDays & "," & dblUserJobsDay & "," & .intPagesPrinted & "," & strFullNameDesc)
    End With
  Next
  fileUser.Close

  Wscript.Echo(vbCrLf & "Completed!" & vbCrLf & vbCrLf & _
               "Output is located in the file: " & strPrinterOutputFile & vbCrLf & _
               "User output is located in the file: " & strUsersOutputFile)
End Sub


'****************************************************************************'
'* Sub ParseCommandLine                                                   *'
'* Purpose: Parses the arguments from the command line.                     *'
'****************************************************************************'
Sub ParseCommandLine
  Dim intArgument
  Dim strArg, strArgs

  strHelp = vbCrLf & _
            "PrinterAudit.vbe - Printer Auditing Script" & vbCrLf & _
            "Author:  Richard Iglar (riglar@isbgroup.com)" & vbCrLf & _
            "Website: http://www.isbgroup.com" & vbCrLf & vbCrLf & _
             "Usage:" & vbCrLf & vbCrLf & _
             "cscript PrinterAudit.vbs [/s:server] [/i:inputfile] [/np] [/o]" & vbCrLf & vbCrLf & _
             "   /s:server        - Server to audit printers on." & vbCrLf & _
             "   /i:inputfile     - Use an input file that contains list of servers." & vbCrLf & _
             "   /np              - No Ping mode. Skip ping test for printers."  & vbCrLf

  If (Wscript.Arguments.Count = 0) Then
    Wscript.Echo(strHelp)
    Wscript.Quit(0)
  Else
    'Retrieve the command line and set appropriate variables
    intArgument = 0

    Do While (intArgument <= Wscript.Arguments.Count-1)
      'Get the argument
      strArg = Wscript.Arguments.Item(intArgument)
      strArgs = strArgs & strArg & " "
      intArgument = intArgument + 1
      Select Case Left(LCase(strArg),3)

        Case "/i:"
          strInputFile = UCase(Mid(strArg,4,255))
          If (strInputFile = "") Then
            Wscript.Echo("######################################################################")
            Wscript.Echo("ERROR: Input file can not be blank!")
            Wscript.Echo("######################################################################")
            Wscript.Quit(1)
          End If

        Case "/s:"
          strServer = UCase(Mid(strArg,4,255))
          If (strServer = "") Then
            Wscript.Echo("######################################################################")
            Wscript.Echo("ERROR: Server name can not be blank!")
            Wscript.Echo("######################################################################")
            Wscript.Quit(1)
          End If

        Case "/np"
          boolNoPing = True

        Case "/?"
          Wscript.Echo(strHelp)
          Wscript.Quit(0)

        Case Else
          Wscript.Echo("######################################################################")
          Wscript.Echo("ERROR: Invalid Argument: " & strArg)
          Wscript.Echo("######################################################################")
          Wscript.Quit(1)
      End Select
    Loop
  End If
End Sub


'****************************************************************************'
'* Sub RegisterCom                                                        *'
'* Purpose: Registers a COM object if it's not already registered.          *'
'****************************************************************************'
Sub RegisterCom(strObject,strDLL)
  Dim intI, objTemp, objWSH

  On Error Resume Next
  For intI = 1 to 2
    Err.Clear
    Set objTemp = CreateObject(strObject)
    If (Err.Number <> 0) Then
      Set objWSH = CreateObject("Wscript.Shell")
      nul = objWSH.Run("cmd /c copy " & strDLL & " %windir%\System32 & regsvr32 %windir%\System32\" & strDLL & " /s",0,true)
    End If
  Next
  If (Err.Number <> 0) then
    MsgBox "* ERROR: Could not register " & strDLL & "!",vbCritical,"ERROR!"
    Wscript.Quit
  End If
End Sub


'****************************************************************************'
'* Sub WMIDateStringToDate(dtmDate)                                         *'
'* Purpose: Takes a UTC Date/Time and converts to standard Date/Time        *'
'****************************************************************************'
Function WMIDateStringToDate(dtmDate)
  WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function


'****************************************************************************'
'* Sub MakeHostCscript                                                      *'
'* Purpose: Forces the script to run with CScript if it wasn't run by it.   *'
'****************************************************************************'
Sub MakeHostCscript()
  Dim intA, intB, intI, objWS, nul, objArgs, args

  intA = InStr(1,Wscript.FullName, ".exe", 1)
  intB = InStrRev(Wscript.FullName,"\",intA,1)

  If (intA > 0 And intB > 0) Then
    strCommand = Mid(Wscript.FullName,intB+1,intA-intB-1)
  End If

  If (strCommand <> "cscript" Or intA = 0 Or intB = 0) Then
    Set objWS = CreateObject("Wscript.Shell")
    Set objArgs = Wscript.Arguments
    For intI = 0 to objArgs.Count - 1
      args = args & " " & objArgs(intI)
    Next
    nul = objWS.Run("cmd.exe /k cscript.exe """ & Wscript.ScriptFullName &"""" & args, 1, True)
    Wscript.Quit
  End If
End Sub