'*************************************************************
'This Gets a list of all servers in the domain and restarts a
'named service for each then produces an html report and mails it.
'It uses NetView.exe a utility that when put in the system32
'folder allows for the discrete selection of computers from
'the network, such as all servers only.
'By Byron P. Dye 07/28/2010

Option Explicit
Dim strPutersArray, strPutersPlusArray
Dim objWMIService, objServiceList
Dim intItem

Const strService = "'W32Time'"
Const strReportFileName = "RestartReport.html"
Const strOldReportFileName = "RestartReport_old.html"
Const intSleep = 2000

FileCleanUp

strPutersArray = ServersList

ReDim strPutersPlusArray(UBound(strPutersArray),2)

For intItem = 0 To UBound(strPutersArray)

	strPutersPlusArray(intItem,0) = Trim(Mid(strPutersArray(intItem),3,12))
	
	WScript.Echo("*" & strPutersPlusArray(intItem,0) & "*")
	
	If strPutersPlusArray(intItem,0) <> "" Then 
		GetWMI(strPutersPlusArray(intItem,0))
		
		If TypeName(objWMIService) <> "Empty" Then
			GetServices
			StopService
			If strPutersPlusArray(intItem,2) <> "Stop " & Mid(strService,2,len(strService)-2) & " service timed out" Then
				StartService
			End If
		End If
		objWMIService = Empty
	End If
Next

CreateHTML

EMail

'Subs and Functions**************************************************************************************
Sub GetWMI(strComputer)
	On Error Resume Next
	
	WScript.Echo("Getting WMI for " & strComputer & "...")
	
	Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	If Err <> 0 Then
		ErrorHandler
		strPutersPlusArray(intItem,1) = "NA"
	End If

End Sub


Sub GetServices
	On Error Resume Next
	
	WScript.Echo("Getting services...")
		
	Set objServiceList = objWMIService.ExecQuery ("Select * from Win32_Service Where Name =" & strService & " ")
	If Err <> 0 Then
		ErrorHandler
	End If
	
End Sub


Function GetServiceState(strService)
	Dim strState
	Dim objServiceListTemp, objServiceTemp

	Set objServiceListTemp = objWMIService.ExecQuery ("Select * from Win32_Service Where Name =" & strService & " ")
		For Each objServiceTemp In objServiceListTemp
			strState = objServiceTemp.State
		Next

	GetServiceState = strState

End Function

Function GetComputerName
	dim strName
	Dim objServiceListTemp, objServiceTemp

	Set objServiceListTemp = objWMIService.ExecQuery ("Select * from Win32_Service Where Name =" & strService & " ")

		For Each objServiceTemp In objServiceListTemp
			strName = objServiceTemp.Path_.Server
		Next

	GetComputerName = strName

End Function

Sub StopService
	On Error Resume Next
	Dim strNewStopState
	Dim objService
	Dim lngStartTime
	
	For Each objService In objServiceList

		WScript.Echo("Stopping " & objService.Name & " service on " & GetComputerName & "...")
		If Err <> 0 Then ErrorHandler
		objService.StopService()
		lngStartTime = Timer()

		Do Until strNewStopState = "Stopped" Or Timer() > lngStartTime + 10
			strNewStopState = GetServiceState(strService)
			WScript.Sleep intSleep
		Loop
		wScript.Echo("End State:" & strNewStopState)
		If strNewStopState = "Stopped" Then
			WScript.Echo("Service " & objService.Name & " stopped on " & GetComputerName & " successfully.")
			strPutersPlusArray(intItem,2) = "Service stopped successfully."
		Else
			WScript.Echo("Stop " & objService.Name & " service timed out")
			Err.Raise 50000,,"Stop " & objService.Name & " service timed out"
			ErrorHandler
		End If
		strPutersPlusArray(intItem,1) = strNewStopState
	Next
	
End Sub


Sub StartService
	On Error Resume Next
	Dim strNewStartState
	Dim lngStartTime
	Dim objService

	
	For Each objService In objServiceList

	WScript.Echo("Starting " & objService.Name & " service on " & GetComputerName & "...")
		objService.StartService()
		lngStartTime = Timer()

		Do Until strNewStartState = "Running" Or Timer() > lngStartTime + 10
			strNewStartState = GetServiceState(strService)
			WScript.Sleep intSleep
		Loop
		If strNewStartState = "Running" Then
			WScript.Echo("Service " & objService.Name & " started on "& GetComputerName &" successfully.")
			strPutersPlusArray(intItem,2) = "Service restarted successfully."
		Else
			WScript.Echo("Start " & objService.Name & " service timed out")
			Err.Raise 50001,,"Start " & objService.Name & " service timed out"
			ErrorHandler
		End If
		strPutersPlusArray(intItem,1) = strNewStartState
	Next

End Sub


Function Domain
	Dim objNetwork

	Set objNetwork = WScript.CreateObject("WScript.Network")

	Domain = objNetwork.UserDomain
	
End Function


Function ServersList
	Dim strOutput, strDomain
	Dim objExecute, objShell

	WScript.Echo("Getting servers...")

	strDomain = Domain

	Set objShell = CreateObject("WScript.Shell")

	'Get List of servers
	Set objExecute = objShell.Exec ("cmd /c netview /nts /pdc /bdc /b /domain:" & strDomain & "")
	strOutput = objExecute.StdOut.ReadAll

	ServersList = Split(strOutput,vbCrLf)
	
End Function


Sub ErrorHandler
	
	Select Case Err.Number
		Case -2147217405
			Err.Description = "Access denied"
		Case -2147217406
			Err.Description = "Service not found"
	End Select
	
	WScript.Echo(Err.Number & " " & Err.Description)
	strPutersPlusArray(intItem,2) = trim(strPutersPlusArray(intItem,2) & Err.Description)
	Err.Clear

		
End Sub


Sub CreateHTML
	Dim intRemoved, intDays
	Dim objHTMLFile, objFSO
	Dim strDomain
	
	WScript.Echo("Creating HTML file...")
	
	strDomain = Domain
	
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If objFSO.FileExists(strReportFileName) Then Set objHTMLFile = objFSO.OpenTextFile(strReportFileName,2)	
		
    objHTMLFile.Write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"" ""http://www.w3.org/TR/html4/strict.dtd""><html><head><STYLE type=""text/css"">BODY{font-size:10pt;font-family:Arial;}H3{font-size:12pt;font-family:Arial;}TH{font-family:Arial;font-size:12pt;}TD{font-family:Arial;font-size:12pt;}</STYLE><Title>" & strService & " Service Restart Report</Title></head><body><H3><br>" & strService & " Service Restart Report</H3><Table rules=none cellspacing=0 frame=void><TR><TH style=""text-align:left; width:160px; border-bottom:#080808 ridge 1px"">Server</TH><TH style=""text-align:left; width:160px; border-bottom:#080808 ridge 1px"">Service State</TH><TH style=""text-align:left; width:200px; border-bottom:#080808 ridge 1px"">Detail</TH></TR>"
    
    intRemoved = -1
    
    For intItem = 0 To UBound(strPutersPlusArray)
        If strPutersPlusArray(intItem,0) <> "" Then
            objHTMLFile.Write "<Table><TR><TD style=""width:160px"">" & strPutersPlusArray(intItem,0) & "</TD><TD style=""width:160px; color:" & GetColor & """>" & strPutersPlusArray(intItem,1) & "</TD><TD style=""width:auto"">" & strPutersPlusArray(intItem,2) & "</TD>"
        Else
            intRemoved = intRemoved + 1
        End If
    Next
    
    objHTMLFile.Write "</Table><p>Total number of systems: <B>" & UBound(strPutersPlusArray)-intRemoved & "</B><br><br></p>This page was last updated " & Date & " " & Time & "</body></html>" & vbCrLf
    
    objHTMLFile.Close
    
End Sub


Sub FileCleanUp
	Dim objFSO, objReportFile
	
	WScript.Echo("File cleanup...")

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	'Deletes the old file and renames the current file to the old filename, then creates a new empty file.
	If objFSO.FileExists(strOldReportFileName) Then objFSO.DeleteFile strOldReportFileName

	If objFSO.FileExists(strReportFileName) Then
		Set objReportFile = objFSO.GetFile(strReportFileName)
		objReportFile.Name = strOldReportFileName
	End If

	Set objReportFile = objFSO.CreateTextFile(strReportFileName,2,True)
	objReportFile.Close

End Sub

Function GetColor

	If strPutersPlusArray(intItem,1) = "Running" Then
		GetColor = "#009900"
	Else
		GetColor = "#000000"
	End If

End Function

Sub Email
	Dim objEmail

	WScript.Echo("Emailing...")
	
	Set objEmail = CreateObject("CDO.Message")

    objEmail.From = "Restart_Notifications"
    objEmail.To = "info@example.com"
    objEmail.Subject = strService & " Service Restart Report" 
    objEmail.Textbody = strService & " Service Restart Report"
    objEmail.AddAttachment "C:\" & strReportFileName
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.example.com" 
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    
    objEmail.Send
    
End Sub