Print Spooler Self Healing 2.0

by

I was driven to write this script for a client that was using Novell’s iPrint. iPrint was causing some threads to hang, ending the spoolsv.exe process, and therefore stopping the Print Spooler service. Those of you that are using such poor printing solutions would no doubt have clocked up a considerable number of headaches. The good news is that this script will provide you with some much deserved pain relief. Let’s call it the “Asprin for iPrint”. I’ll have to register a trade mark for that one 😉

So why is this script so good? Glad you asked!

It monitors the spoolsv.exe process. If the process ends, it then checks to see if the service has cleanly stopped with an “Exit Code” of 0. If it hasn’t, it will clean out the spooler folder and then restart the Spooler service, including any dependants that are not running, such as the “Citrix Print Manager” service. The cool thing is that it time stamps the events, writes messages to the Event Logs, and sends e-mail alerts. Very cool for monitoring a problematic printing environment.

The script does a whole lot more, specifically around iPrint, and can really be adapted for any printing solution. The important thing is that it quickly and neatly restarts the Spooler service, preventing any user interruptions what so ever.

I’m currently running the script from the good old “autoexnt” Resouce Kit tool, so it runs at Startup as the System account. But you could also run it as a Startup Script from a Group Policy Object.

It is executed by the Autoexnt.bat using the following line…

start cscript //nologo "%SystemRoot%\System32\MonitorProcess.vbs" spoolsv.exe spooler

It’s worth mentioning here that I use the FREE w3 JMail COM Object from Dimac to send SMTP messages from within VBScripts. And as such, you will see how I create an instance of the jmail.message object set objJMail = CreateOBject(“JMail.Message”) and then specify the sender, recipient, subject, body and mail server. Therefore, this script will fail as is if you do not install JMail, or at least place a copy of the jmail.dll on the server and register it. Alternatively, you can comment out any calls to the SendMail subroutine.

MonitorProcess.vbs

' The purpose of this script is to monitor the spoolsv.exe process. If it ends, restart the Spooler service.
' I have tried to make this as generic as possible so that it can be used to monitor other processes and
' services.

' This was specifically written for a client who had implemented Novell's iPrint into their Citrix XenApp 4.5
' environment. iPrint was causing a lot of grief when adding printer objects by ending the spoolsv.exe process.

' Version 1.0
' Written by Jeremy@jhouseconsulting.com on 14th July 2008.

Option Explicit

Dim objArgs, strProcess, strFile, strService, j, k, blnFirstRun, strComputer
Dim objWMIService, colProcesses, blnDebugger, intDebugRuns

strComputer = "."
Set objArgs = WScript.Arguments

' Check to make sure we received arguments.
if objArgs.Count = 0 Then
  WScript.Echo "USAGE: cscript //nologo ''MonitorProcess.vbs'' ''<process>'' ''<service>''" & VbCr & VbCr & _
               "Where 'process' is the process you wish to monitor, and 'service' is the" & VbCr & _
               "short name of the service that needs to be restarted." & VbCr & VbCr & _
               "For Example:"  & VbCr & _
               "cscript //nologo MonitorProcess.vbs spoolsv.exe spooler"
  WScript.Quit(0)
End If

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

' Check to make sure the script is not already running, as only one copy of this script should be running at
' any time.
Set colProcesses = objWMIService.ExecQuery _
  ("SELECT commandline FROM Win32_Process WHERE commandline LIKE '%" & wscript.scriptname & "%'")
If colProcesses.Count > 1 Then
  Set objArgs = Nothing
  Set objWMIService = Nothing
  Set colProcesses = Nothing
  wscript.quit(0)
End If

blnFirstRun = True

' Setting this value to True will trigger the user mode debugger.
blnDebugger = True

' This value represents the number of times the debugger should run.
intDebugRuns = 5

Do Until j = 999
' Note how we never increment j. Therefore, it takes on the default value of 0, and never increments, meaning
' that this will loop forever.
  strProcess = objArgs(0)
  strFile = objArgs(0) & " monitoring.txt"

  if objArgs.Count > 1 Then
    strService = objArgs(1)
  End If

  If blnFirstRun Then
    wscript.echo Now() & vbTab & "The script has initiated."
  End If

  Call MonitorProcess(strProcess,strService,strFile,blnFirstRun,blnDebugger)
  blnFirstRun = False

  If K = intDebugRuns-1 Then
    blnDebugger = False
  End If
  k = k + 1
Loop

Set objArgs = Nothing
Set objWMIService = Nothing
Set colProcesses = Nothing

WScript.Quit(0)

Sub MonitorProcess(strProcess,strService,strFile,blnFirstRun,blnDebugger)

' This subroutine will monitor the process.

  Dim objWMIService, colProcesses, objProcess, strTimeStamp, strMessage
  Dim strComputer, strProcessPath, process, i, objFSO, intExitCode, strServiceMessage

  Const HKEY_LOCAL_MACHINE = &H80000002

  strComputer = "."

  Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  Set objFSO = CreateObject("Scripting.FileSystemObject") 

' Check to see if the process is running.
  Set colProcesses = objWMIService.ExecQuery _
  ("SELECT * FROM Win32_Process WHERE Name = '" & strProcess & "'")
  If colProcesses.Count > 0 Then

  If blnDebugger Then
    Call RunDebugger(strProcess,blnFirstRun)
  End If

'   Get the path of the running process.
    for each process in colProcesses
      strProcessPath = Left(process.ExecutablePath, InstrRev(process.ExecutablePath, "\"))
'     wscript.echo strProcessPath
    Next
    strFile = strProcessPath & strFile

    If blnFirstRun Then
      If objFSO.FileExists(strFile) Then
        objFSO.DeleteFile(strFile), True
      End If
    End If

'   Wait for the process to end.
    Set colProcesses = objWMIService.ExecNotificationQuery _
      ("Select * From __InstanceDeletionEvent " _
              & "Within 1 Where TargetInstance ISA 'Win32_Process'")

    Do Until i = 999
'   Note how we never increment i. Therefore, it takes on the default value of 0,
'   and never increments, meaning that this will loop forever until the process ends.
    Set objProcess = colProcesses.NextEvent
      If lcase(objProcess.TargetInstance.Name) = lcase(strProcess) Then
        Exit Do
      End If
    Loop

    intExitCode=ServiceExitCode(strService)
    If intExitCode <> 0 Then
      strTimeStamp="on " & Date() & " at " & Time()
      strMessage="Process: " & strProcess & VbCr & "Status: Ended" & VbCr & "Timestamp: " & strTimeStamp
      wscript.echo Now() & vbTab & "Process has ended."
    Else
      wscript.echo Now() & vbTab & "Process has ended because the service was cleanly stopped."
    End If

  Else
      strTimeStamp="on " & Date() & " at " & Time()
      strMessage="Process: " & strProcess & VbCr & "Status: Not running" & VbCr & "Timestamp: " & strTimeStamp
      wscript.echo Now() & vbTab & "Process not running."
      Call WaitForProcessToStart(strProcess)
  End If
  If intExitCode <> 0 Then
    Call WriteToEventLog(strMessage)
    wscript.echo Now() & vbTab & "Message written to event log."
    Call WriteToLogFile(strFile,strMessage)
    wscript.echo Now() & vbTab & "Message written to log file."
    Call SendMail("Process",strMessage)
    wscript.echo Now() & vbTab & "E-mail alert sent."
    If strService <> "" Then
      Call RestartService(strService,strFile)
    End If
  End If

  set objWMIService = Nothing
  Set objFSO = Nothing
  Set colProcesses = Nothing

End Sub

Function ServiceExitCode(strService)

' This function gets the exit code for the service and passes it back as a return value so that we know if the
' service has cleanly stopped.

  Dim strComputer, objWMIService, colListOfServices, objService
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colListOfServices = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name='" & strService & "'")
  For Each objService in colListOfServices
    ServiceExitCode=objService.ExitCode
  Next
  Set objWMIService = Nothing
  Set colListOfServices = Nothing
End Function

Sub WaitForProcessToStart(strProcess)

' This subroutine waits for the process to start

  Dim strComputer, objWMIService, colMonitoredProcesses, l, objLatestProcess, strTimeStamp, strMessage
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colMonitoredProcesses = objWMIService. _
    ExecNotificationQuery("select * from __instancecreationevent " _
        & " within 1 where TargetInstance isa 'Win32_Process'")
  Do Until l = 999
    Set objLatestProcess = colMonitoredProcesses.NextEvent
    If lcase(objLatestProcess.TargetInstance.Name) = lcase(strProcess) Then
      strTimeStamp="on " & Date() & " at " & Time()
      strMessage="Process: " & strProcess & VbCr & "Status: Started" & VbCr & "Timestamp: " & strTimeStamp
      wscript.echo Now() & vbTab & "Process started."
      Exit Do
    End If
  Loop
  Set objWMIService = Nothing
  Set colMonitoredProcesses = Nothing
  Set objLatestProcess = Nothing
End Sub

Sub RestartService(strService,strFile)

' This subroutine will restart the service if it has terminated abnormally, and will
' attempt to start any other stopped services that have this service set as a dependency.

  Dim strComputer, objWMIService, objItem, objService, colListOfServices, return, strTimeStamp
  Dim strMessage, objServiceList, objDependService
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  Set colListOfServices = objWMIService.ExecQuery _
  ("Select * from Win32_Service Where Name ='" & strService & "'")
  If colListOfServices.count > 0 Then
    For Each objService in colListOfServices
      If (lcase(objService.State)="stopped") AND (objService.ExitCode<>0) Then
'       As an example, when the spoolsv.exe process ends, the exit code for the spooler
'       service is 1067, which means that the process terminated unexpectedly.
        wscript.echo Now() & vbTab & "The Service has stopped with an exit code of " & objService.ExitCode & "."
      Else
        return=objService.StopService()
        If return=0 Then
          wscript.echo Now() & vbTab & "Service successfully stopped."
          strTimeStamp="on " & Date() & " at " & Time()
          strMessage="Service: " & objService.Name & VbCr & "Status: Stopped" & VbCr & "Timestamp: " & strTimeStamp
          Call WriteToEventLog(strMessage)
          wscript.echo Now() & vbTab & "Message written to event log."
          Call WriteToLogFile(strFile,strMessage)
          wscript.echo Now() & vbTab & "Message written to log file."
          Call SendMail("Service",strMessage)
          wscript.echo Now() & vbTab & "E-mail alert sent."
        End If
      End If

      Select Case LCase(strService)
        Case "spooler"
          Call CleanOutSpoolerFolder()
          Call CheckforiPrint()
      End Select

      return=objService.StartService()
      If return=0 Then
        wscript.echo Now() & vbTab & "The " & objService.Name & " service successfully started."
      End If
      strTimeStamp="on " & Date() & " at " & Time()
      strMessage="Service: " & objService.Name & VbCr & "Status: Started" & VbCr & "Timestamp: " & strTimeStamp
      Call WriteToEventLog(strMessage)
      wscript.echo Now() & vbTab & "Message written to event log."
      Call WriteToLogFile(strFile,strMessage)
      wscript.echo Now() & vbTab & "Message written to log file."
      Call SendMail("Service",strMessage)
      wscript.echo Now() & vbTab & "E-mail alert sent."

'     Start dependent services
      Set objServiceList = objWMIService.ExecQuery("Associators of " _
                 & "{Win32_Service.Name='" & strService & "'} Where " _
                 & "AssocClass=Win32_DependentService " & "Role=Antecedent" )
      For Each objDependService In objServiceList
        If objDependService.State = "Stopped" Then
          return=objDependService.StartService()
          If return=0 Then
            wscript.echo Now() & vbTab & "The " & objDependService.Name & " service successfully started."
          End If
          strTimeStamp="on " & Date() & " at " & Time()
          strMessage="Service: " & objDependService.Name & VbCr & "Status: Started" & VbCr & "Timestamp: " & strTimeStamp
          Call WriteToEventLog(strMessage)
          wscript.echo Now() & vbTab & "Message written to event log."
          Call WriteToLogFile(strFile,strMessage)
          wscript.echo Now() & vbTab & "Message written to log file."
          Call SendMail("Service",strMessage)
          wscript.echo Now() & vbTab & "E-mail alert sent."
        End If
      Next

    Next
  Else
    strTimeStamp="on " & Date() & " at " & Time()
    strMessage="Service: " & strService & VbCr & "Status: Not found" & VbCr & "Timestamp: " & strTimeStamp
    Call WriteToEventLog(strMessage)
    wscript.echo Now() & vbTab & "Message written to event log."
    Call WriteToLogFile(strFile,strMessage)
    wscript.echo Now() & vbTab & "Message written to log file."
    wscript.quit 0
  End If
  Set objWMIService  = Nothing
  Set colListOfServices = Nothing
  Set objServiceList = Nothing
End Sub

Sub WriteToEventLog(strMessage)

' This subroutine will write an alert to the event logs.

  Dim WshShell
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.LogEvent 2, strMessage
  Set WshShell = Nothing
End Sub

Sub WriteToLogFile(strFile,strMessage)

' This subroutine will write the entries to a text file

  Dim objFSO, objFile
  Const ForAppending = 8
  Set objFSO = CreateObject("scripting.filesystemobject")
  Set objFile = objFSO.OpenTextFile(strFile,ForAppending,True,0)
  strMessage = Replace(strMessage,VbCr,vbCrLf) & vbCrLf
  objFile.WriteLine strMessage
  objFile.Close
  Set objFile = Nothing
End Sub

Sub SendMail(strServiceorProcess,strMessage)

' This subroutine will send off an e-mail alert using the JMail COM Object from www.Dimac.net

  Dim WshNetwork, sComputerName, strSMTPServer, strReceipent1, strSubject, strBody
  Dim objJMail

  Set WshNetwork = WScript.CreateObject("WScript.Network")
  sComputerName = WshNetwork.ComputerName

  strSMTPServer = "smtp.mydomain.com"
  strReceipent1 = "CitrixAlerts@mydomain.com"
  strSubject = "A " & strServiceorProcess & " has changed state on " & sComputerName & "."

  strBody = Replace(strMessage,VbCr,vbCrLf)

  set objJMail = CreateOBject("JMail.Message")

  objJMail.From = "server.alerts@mydomain.com"
  objJMail.FromName = "Server Alerts"

  objJMail.AddRecipient strReceipent1
  objJMail.Subject = strSubject
  objJMail.Body = strBody

  objJMail.Send(strSMTPServer)

  Set WshNetwork = Nothing
  set objJMail = Nothing
End Sub

Sub CleanOutSpoolerFolder()

' This subroutine will clean put the Spooler folder.

  Dim oReg, strComputer, objFSO, strKeyPath, strValueName, strValue, objFolder, Subfolder

  Const HKEY_LOCAL_MACHINE = &H80000002
  StrComputer="."

  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
  strComputer & "\root\default:StdRegProv")
  Set objFSO = CreateObject("Scripting.FileSystemObject") 

  strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Printers"
  strValueName = "DefaultSpoolDirectory"
  oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
  Wscript.Echo Now() & vbTab & "The spooler folder is: " & strValue

  objFSO.DeleteFile(strValue & "\*.*"), True
  Set objFolder = objFSO.GetFolder(strValue)
  For Each Subfolder in objFolder.SubFolders
    objFSO.DeleteFolder Subfolder.Path, True
  Next
  Wscript.Echo Now() & vbTab & "Deleted the contents of the spooler folder."                   

  Set objFolder = Nothing
  Set oReg = Nothing
  Set objFSO = Nothing
End Sub

Sub CheckforiPrint()

' This subroutine checks for the existence of iPrint.
' If it's installed it checks to see if Trace is enabled.
' If Trace is enabled it checks for the Trace file.
' If the Trace file exists, it renames it before restarting the Spooler service.
' NOTE that iPrint should be doing this, but I found that it was unreliable. It
' was perhaps a timing issue!

  Dim oReg, strComputer, objFSO, strKeyPath, strValueName, dwValue
  Dim WshShell, sRegValue, sRegKey, strSystemDrive

  Const HKEY_LOCAL_MACHINE = &H80000002
  StrComputer="."

  Set WshShell = CreateObject("WScript.Shell")
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
  strComputer & "\root\default:StdRegProv")
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  strSystemDrive = WshShell.ExpandEnvironmentStrings("%SystemDrive%")

  sRegKey = "HKLM\SOFTWARE\Novell-iPrint"
  sRegValue = "HKLM\SOFTWARE\Novell-iPrint\Settings\TraceOn" 

  If RegKeyExists(sRegKey) Then
    Wscript.Echo Now() & vbTab & "iPrint is installed."
    If RegValueExists(sRegValue) Then
'     Check to see if Trace is enabled
      strKeyPath = "SOFTWARE\Novell-iPrint\Settings"
      strValueName = "TraceOn"
      oReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
      Select Case dwValue
        Case 0
          Wscript.Echo Now() & vbTab & "iPrint Trace is disabled."
        Case 1
          Wscript.Echo Now() & vbTab & "iPrint Trace is enabled."
'         Check for existance Trace file.
          If objFSO.FolderExists(strSystemDrive & "\NDPS") Then
            If objFSO.FileExists(strSystemDrive & "\NDPS\ippTrace.txt") Then
              Wscript.Echo Now() & vbTab & "An iPrint Trace File exists."
              If objFSO.FileExists(strSystemDrive & "\NDPS\ippTrace.previous.txt") Then
                objFSO.DeleteFile strSystemDrive & "\NDPS\ippTrace.previous.txt", 1
              End If
              objFSO.MoveFile strSystemDrive & "\NDPS\ippTrace.txt", strSystemDrive & "\NDPS\ippTrace.previous.txt"
              Wscript.Echo Now() & vbTab & "Renamed iPrint Trace file to " & strSystemDrive & "\NDPS\ippTrace.previous.txt"
            Else
              Wscript.Echo Now() & vbTab & "The iPrint Trace file is missing."
            End If
          End If
        Case Else
          Wscript.Echo Now() & vbTab & "iPrint Trace setting is invalid."
      End Select
    End If
  Else
    Wscript.Echo Now() & vbTab & "iPrint is not installed."
  End If
  Set WshShell = Nothing
  Set oReg = Nothing
  Set objFSO = Nothing
End Sub

Function RegKeyExists(ByVal sRegKey) 

' Returns True or False based on the existence of a registry key.

  Dim sDescription, oShell
  Set oShell = CreateObject("WScript.Shell")
  RegKeyExists = True
  sRegKey = Trim (sRegKey)
  If Not Right(sRegKey, 1) = "\" Then
    sRegKey = sRegKey & "\"
  End If
  On Error Resume Next
  oShell.RegRead "HKEYNotAKey\"
  sDescription = Replace(Err.Description, "HKEYNotAKey\", "")
  Err.Clear
  oShell.RegRead sRegKey
  RegKeyExists = sDescription <> Replace(Err.Description, sRegKey, "")
  On Error Goto 0
  Set oShell = Nothing
End Function

Function RegValueExists(sRegValue) 

' Returns True or False based of the existence of a registry value. 

  Dim oShell, RegReadReturn
  Set oShell = CreateObject("WScript.Shell")
  RegValueExists = True  ' init value
  On Error Resume Next
  RegReadReturn = oShell.RegRead(sRegValue)
  If Err.Number <> 0 Then
    RegValueExists = False
  End if
  On Error Goto 0
  Set oShell = Nothing
End Function 

Sub RunDebugger(strProcess,blnFirstRun)

' ADPlus is a vbscript included with the Debugging Tools for Windows. To enable the
' monitoring of a process and Wait for a crash, use the following command:
' ADPlus will only provide a user mode dump. Refer to KB article 286350 for further
' information.

  Dim WshShell, objFSO, strSystemDrive, strProgramFiles, strCommandLine
  Set WshShell = CreateObject("WScript.Shell")
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  strSystemDrive = WshShell.ExpandEnvironmentStrings("%SystemDrive%")
  strProgramFiles = WshShell.ExpandEnvironmentStrings("%ProgramFiles%")
  If objFSO.FileExists(strProgramFiles & "\Debugging Tools for Windows\adplus.vbs") Then
  If blnFirstRun Then
    If objFSO.FolderExists(strSystemDrive & "\" & strProcess & "_dumps\") Then
      objFSO.DeleteFolder strSystemDrive & "\" & strProcess & "_dumps", True
    End If
  End If
  If NOT objFSO.FolderExists(strSystemDrive & "\" & strProcess & "_dumps\") Then
      objFSO.CreateFolder(strSystemDrive & "\" & strProcess & "_dumps")
    End If
    strCommandLine = "cscript " & chr(34) & strProgramFiles & "\Debugging Tools for Windows\adplus.vbs" & chr(34) & " -quiet -crash -pn " & strProcess & " -o " & strSystemDrive & "\" & strProcess & "_dumps"
    WshShell.Run strCommandLine, 1, FALSE
    wscript.echo Now() & vbTab & "Running the debugger to monitor for a " & strProcess & " crash using the following command line..." & VbCrLf & strCommandLine
  End If
  Set WshShell = Nothing
  Set objFSO = Nothing
End Sub
Jeremy Saunders

Jeremy Saunders

Delivering customer success through tech: IT Infrastructure | Citrix | End User Computing | Platform Engineering | DevOps | Full Stack Developer | Technical Architect | Improvisor | Aspiring Comedian | Midlife Adventurer at J House Consulting
Jeremy Saunders is the Problem Terminator; the MacGyver of IT. Views and Intellectual Property (IP) published on this site belong to Jeremy. Please refer to the About page for more information about Jeremy.