Option Explicit

'-------------------------------------------------------------------------
' ConfickerCheck.vbs
'
' Beschreibung
' 
' Skript zur Suche nach Systemen mit Conficker-Problemen.
'
' Es ersetzt weder SMS noch ein Patchmanagement aber erlaubt einen schnellem
' Überblick und ist natürlich erweiterbar
'
' Achtung: Firewalls auf Servern und PCs können den Zugriff per WMI über Netzwerk verhinden
' Dann ist es denkbar, das Script beim Hochfahren als Richtlinie zu starten und die Daten zu berichten
'
' Laufzeitfehler werde nicht abgefangen und beenden das Skript.
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
'
' (c)2005 Net at Work Netzwerksysteme GmbH
'
' Version 1.0  20. Mrz 2009
'	Erste Version mit einfacher Suche nach "gestoppten" Diensten
' Version 2.0  24.Sep 2009
'	Erweiterung für Suche nach registry NETSVCS
'	Erweiterung für Suche nach Datei KB958644
' Version 2.1  24.Sep 2009
'	Kritische Dienste als eigene Spalten mit uppercase, wenn gestartet
' Version 2.2  24.Sep 2009
'	Korrektur Doku mit AD-Pfad
'	Logfile mit Datum
' Version 2.3  25. Sep 2009
'	Erweiterung um Ausgabe der AT-Tasks
'-------------------------------------------------------------------------
' Pfad und Dateiname der Log-Datei

Dim computerliste ' Array für die Computer
Dim count, total
Dim objWMIService
Dim objItem, colItems
Dim ExecQuery
	
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

dim objDebug
set objdebug = new DebugWriter 
objDebug.target = "file:2 console:7" ' errorlogging  0=only output, 1=Error 2=Warning 3=information  5++ =debug
objDebug.outFile = "confickercheck.log"
objDebug.start

call ForceCScript  ' must be rund with CSCRIPT
objDebug.writeln "confickercheck: gestartet", 0

' ------------------ Einlesen der Computerliste aus einer Datei oder dem Active Directory
if wscript.Arguments.named("AD") <> "" then
	objDebug.writeln "Loading Computer Objects from AD:" & wscript.Arguments.named("AD"), 0
	computerliste = getcomputersfromAD(wscript.Arguments.named("AD"))
ElseIf wscript.Arguments.named("FILE") <> "" then
	objDebug.writeln "Loading Computer Objects from FILE:" & wscript.Arguments.named("FILE") , 0
	computerliste = getcomputersfromFile(wscript.Arguments.named("FILE"))
ElseIf wscript.Arguments.named("PC")<> "" then
	objDebug.writeln "Single Computer Mode:" & wscript.Arguments.named("PC"), 0
	Redim computerliste (0)
	computerliste(0) = wscript.Arguments.named("PC")
Else
	objDebug.writeln "confickercheck: Bitte Parameter angeben", 0
	objDebug.writeln "confickercheck: Beispiel", 0
	objDebug.writeln "confickercheck: ", 0
	objDebug.writeln "confickercheck: Alle Systeme einer Domain holen. DC selbst ermitteln", 0
	objDebug.writeln "confickercheck:    CSCRIPT confickercheck /AD:""dc=netatwork,dc=de""", 0
	objDebug.writeln "confickercheck: ", 0
	objDebug.writeln "confickercheck: Alle Systeme einer Domain holen. DC explizit angegeben", 0
	objDebug.writeln "confickercheck:    CSCRIPT confickercheck /AD:""ou=server,dc=netatwork,dc=de""", 0
	objDebug.writeln "confickercheck: ", 0
	objDebug.writeln "confickercheck: Nur angegebenen Computer inventarisieren", 0
	objDebug.writeln "confickercheck:    CSCRIPT confickercheck /PC:computername", 0
	objDebug.writeln "confickercheck: ", 0
	wscript.quit(1)
End if

dim strlogfilename 
strlogfilename = Date() & "-" & Time() 

dim csvfile
set csvfile = new clsCSVWriter
csvfile.OpenFile "confickerresult-" & strlogfilename & ".txt",csvfile.Overwrite	' Overwrite
csvfile.Delimiter = ";"
'~ csvfile.Quote = "'"
csvfile.AddHeader "server" 
csvfile.AddHeader "wmistatus" : 
csvfile.AddHeader "wscsvc"
csvfile.AddHeader "lanmanserver"
csvfile.AddHeader "wuaUserv"
csvfile.AddHeader "bits"
csvfile.AddHeader "ersvc"
csvfile.AddHeader "servicestatus" 
csvfile.AddHeader "KB958644" 
csvfile.AddHeader "conficker"
csvfile.AddHeader "mstask"
csvfile.Writeheader ""
total = 0


dim csvtaskfile
set csvtaskfile= new clsCSVWriter
csvtaskfile.OpenFile "mstask-" & strlogfilename & ".txt",csvtaskfile.Overwrite	' Overwrite
csvtaskfile.Delimiter = ";"
csvtaskfile.AddHeader "server" 
csvtaskfile.AddHeader "Command"
csvtaskfile.AddHeader "DaysOfMonth"
csvtaskfile.AddHeader "DaysOfWeek"
csvtaskfile.AddHeader "Description"
csvtaskfile.AddHeader "ElapsedTime"
csvtaskfile.AddHeader "InstallDate"
csvtaskfile.AddHeader "InteractWithDesktop"
csvtaskfile.AddHeader "JobId"
csvtaskfile.AddHeader "JobStatus"
csvtaskfile.AddHeader "Name"
csvtaskfile.AddHeader "Notify"
csvtaskfile.AddHeader "Owner"
csvtaskfile.AddHeader "Priority"
csvtaskfile.AddHeader "RunRepeatedly"
csvtaskfile.AddHeader "StartTime"
csvtaskfile.AddHeader "Status"
csvtaskfile.AddHeader "TimeSubmitted"
csvtaskfile.AddHeader "UntilTime"
csvtaskfile.Writeheader ""
total = 0

For count = 0 To uBound(computerliste)   ' Verarbeite jeden Computer.
	total = total + 1
	objDebug.writeln "Processing:" & total & "/" & uBound(computerliste)+1 &":" & computerliste(count) ,3
	csvfile.StartLine
	csvfile.AddField "server",computerliste(count)

	If wmiping(computerliste(count)) = False Then
		objDebug.writeln "confickercheck:    NoPing", 2
		csvfile.AddField "wmistatus","noping"
	Else
		on error resume next
		Set objWMIService = GetObject("winmgmts://" & computerliste(count)& "\root\CIMV2")
		if err.number <> 0 then
			err.clear
			on error goto 0
			objDebug.writeln "confickercheck:    WMIFailure", 2
			csvfile.AddField "wmistatus","WMIerror"
		else 
			on error goto 0
			objDebug.writeln "confickercheck:  WMIOK: Collecting Data", 5
			csvfile.AddField "wmistatus","WMIOK"
			
			objDebug.writeln "confickercheck:  Collecting WMI Win32_Service", 5
			Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Service")
			dim strsvcstopped 
			strsvcstopped  = ""
			For Each objItem In colItems
				if (instr(",wscsvc,lanmanserver,wuaUserv,bits,ersvc,wersvc,WinDefend",LCase(objItem.Name)) > 0) then
					objDebug.writeln "   Service:" & LCase(objItem.Name) & objItem.Started  & objItem.StartMode, 0
					if objItem.Started  then
						csvfile.AddField LCase(objItem.Name),ucase(objItem.StartMode)
					else
						csvfile.AddField LCase(objItem.Name),lcase(objItem.StartMode)
					end if
				end if
			Next		
			if strsvcstopped  = "" then
				csvfile.AddField "servicestatus","OK"
			else
				csvfile.AddField "servicestatus",strsvcstopped  
			end if

			objDebug.writeln "confickercheck:  Checking netsvcs-Service", 5
			dim colListOfServices , objFile 
			Set colListOfServices = objWMIService.ExecQuery ("Select * from Win32_Service Where Name = 'netsvcs'")
			For Each objItem in colListOfServices
				csvfile.AddField "conficker","netsvcs found"
			Next

			objDebug.writeln "confickercheck:  Checking Hotfix KB958644", 5
			dim colQuickFixes , objQuickFix 
			Set colQuickFixes = objWMIService.ExecQuery ("Select * from Win32_QuickFixEngineering")
			For Each objQuickFix in colQuickFixes
				objDebug.writeln "confickercheck: Hot Fix ID: " & objQuickFix.HotFixID, 5
				if objQuickFix.HotFixID = "KB958644" then csvfile.AddField "KB958644","installed"
			Next 
			
						
			objDebug.writeln "confickercheck:  Checking AT-Tasks", 5
			dim colListOfTasks, intjobcount
			Set colListOfTasks = objWMIService.ExecQuery ("Select * from Win32_ScheduledJob")
			intjobcount = 0
			For Each objItem in colListOfTasks
				intjobcount = intjobcount +1
				objDebug.writeln "confickercheck: AT-Tasks: " & objItem.Command, 5
				csvtaskfile.AddField "server" ,computerliste(count)
				csvtaskfile.AddField "Command", objitem.Command
				csvtaskfile.AddField "DaysOfMonth", objitem.DaysOfMonth
				csvtaskfile.AddField "DaysOfWeek", objitem.DaysOfWeek
				csvtaskfile.AddField "Description", objitem.Description
				csvtaskfile.AddField "ElapsedTime", objitem.ElapsedTime
				csvtaskfile.AddField "InstallDate", objitem.InstallDate
				csvtaskfile.AddField "InteractWithDesktop", objitem.InteractWithDesktop
				csvtaskfile.AddField "JobId", objitem.JobId
				csvtaskfile.AddField "JobStatus", objitem.JobStatus
				csvtaskfile.AddField "Name", objitem.Name
				csvtaskfile.AddField "Notify", objitem.Notify
				csvtaskfile.AddField "Owner", objitem.Owner
				csvtaskfile.AddField "Priority", objitem.Priority
				csvtaskfile.AddField "RunRepeatedly", objitem.RunRepeatedly
				csvtaskfile.AddField "StartTime", objitem.StartTime
				csvtaskfile.AddField "Status", objitem.Status
				csvtaskfile.AddField "TimeSubmitted", objitem.TimeSubmitted
				csvtaskfile.AddField "UntilTime", objitem.UntilTime
				csvtaskfile.Writeline	'Zeile rausschreiben
			next
			csvfile.AddField "mstask",intjobcount
				
		End If 
	End If
	csvfile.Writeline	'Zeile rausschreiben
Next

objDebug.writeln "Total objects checked:" & total, 0
objDebug.writeln "confickercheck: beendet", 0
WScript.quit(0)


Function getcomputersfromAD (ADDomain)   ' Liest die Computer aus dem Active Directory
	Const ADS_SCOPE_SUBTREE = 2
	Dim objCommand             ' 
	Dim objConnection          ' 
	Dim objRecordSet           ' 
	Dim arr_computers()
	Dim count
	objDebug.writeln "confickercheck:  Searching AD Container "& ADDomain, 5
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection
	objCommand.CommandText = "Select Name from 'LDAP://"& ADDomain &"' where objectClass='computer'"
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Timeout") = 30 
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
	objCommand.Properties("Cache Results") = False 
	objDebug.writeln "confickercheck:  Start ADO Query", 5
	Set objRecordSet = objCommand.Execute
	objRecordSet.MoveFirst
	count = 0
	
	Do until objRecordSet.EOF
		Redim Preserve arr_computers (count)
		arr_computers(count) = LCase(objRecordSet.Fields("Name").Value)
		objDebug.writeln "confickercheck:  Add Computer "& arr_computers(count) &" to list", 5
		count = count +1  
		objRecordSet.MoveNext
	Loop	
	getcomputersfromAD = arr_computers
End Function


Function wmiping(strComputer)
	Dim PingResults, Pingresult
	Set PingResults = GetObject("winmgmts://localhost/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" + strComputer + "'")
	For Each PingResult In PingResults
		If PingResult.StatusCode = 0 Then
			wmiping = True
		Else
			wmiping = False
		End If
	Next
End Function


' ==================================================  Auxilary procedures and classes ==========================


class debugwriter
	' Generic Class für writing debugging information and handling runtime errors
	' By default al Level 1 Messaegs are logged to the Console
	' Version 29. Mar 2006

	private objIE, file, fs, debugfilename, status, strline
	private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole

	private Sub Class_Initialize
		status = "active" : strline = "" : debugfilename = ""
		debuglevelIE = 0
		debuglevelfile = 0
		debugleveleventlog = 0
		debuglevelConsole = 1
	End Sub

	private Sub Class_Terminate()
		if isobject(OBJIE) then
			objie.document.write "</table></body></html>"
		end if
		if debugfilename <> "" then
			file.Close
		end if
	End Sub

	public sub start
		status = "active"
	end sub
	
	public sub pause
		status = "pause"
	end sub

	public property let outfile(wert)
		if debugfilename <> "" then    'Close existing debug file
			file.close : file = nothing : fs = nothing
		end if

		debugfilename = wert    ' open debug file
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set file = fs.OpenTextFile(makefilename(debugfilename), 8, True)
	end property

	public property let setie (wert)  : set objIE = wert  : objie.visible = true  end property

	public property let target (wert)
		dim arrTemp, intcount
		arrTemp = split(wert," ")  ' spit by space
		for intcount = 0 to ubound(arrTemp)
			select case lcase(split(arrtemp(intcount),":")(0))
				case "ie" 		debuglevelIE = cint(right(arrtemp(intcount),1))
				case "file" 	debuglevelfile = cint(right(arrtemp(intcount),1))
				case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1))
				case "console" 	debuglevelConsole = cint(right(arrtemp(intcount),1))
			end select
		next
	end property

	sub write(strMessage)
		strline = strline & strMessage
	end sub

	Sub writeln(strMessage, intseverity)
	'Fügt einen Eintrag in die Log-Datei ein
		dim blnerror

		strMessage = strline & strMessage  ' add existing Output Messages
		strline = ""

		if err <> 0 then  ' Sonderbehandlung als "ErrorHandler"
			blnerror = true
			strmessage= "RUNTIME ERROR  :" & strMessage & vbcrlf & _
						"ERR.Number     :" & err.number & vbcrlf & _
						"ERR.Description:" & err.Description & vbcrlf & _
						"ERR.Source     :" & err.source & vbcrlf & _
						"ERR.HelpFile   :" & err.HelpFile & vbcrlf & _
						"ERR.HelpContext:" & err.HelpContext & vbcrlf
			err.clear
		else
			blnerror = false
		end if

		if ((status = "active")  or blnerror) then

		if (debuglevelfile > 0) and ((debuglevelfile >= intseverity) or blnerror) and (debugfilename <> "") then
                file.Write(Now & ",")
                Select Case intseverity
                    Case 0  file.Write("Out0")
                    Case 1  file.Write("Err1")
                    Case 2  file.Write("Wrn2")
                    Case 3  file.Write("Inf3")
                    Case Else file.Write("Dbg"&intseverity)
                End Select
                file.WriteLine("," & Convert2Text(strMessage))
		strline = ""
            end if

		if (debugleveleventlog > 0) and ((debugleveleventlog >=intSeverity) or blnerror) then
                dim objWSHShell
		Set objWSHShell = Wscript.CreateObject("Wscript.Shell")
                Select Case intseverity
			Case 0  objWSHShell.LogEvent 0, strMessage '           		Const EVENT_SUCCESS = 0
			Case 1  objWSHShell.LogEvent 1, strMessage '           		const EVENT_ERROR = 1
			Case 2  objWSHShell.LogEvent 2, strMessage '           		Const EVENT_WARNING = 2
			Case else  objWSHShell.LogEvent 4, strMessage '           	Const EVENT_INFO = 4
                End Select
			end if

			if (debuglevelconsole > 0) and ((debuglevelconsole >=intSeverity) or blnerror) then
				Select Case intseverity
					Case 0  wscript.echo now() & ",OUT0:" & strMessage
					Case 1  wscript.echo now() & ",ERR1:" & strMessage
					Case 2  wscript.echo now() & ",WRN2:" & strMessage
					Case 3  wscript.echo now() & ",INF3:" & strMessage
					Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage
				End Select
			end if

           if (debuglevelie > 0) and ((debuglevelie >= intSeverity) or blnerror) then
           		dim strieline
      			if  not isobject(objIE) then
      				Set objIE = CreateObject("InternetExplorer.Application")
           		    objIE.navigate("about:blank")
					objIE.visible = true
					Do While objIE.Busy
				    	WScript.Sleep 50
					Loop
					objIE.document.write "<html><head><title>DebugWriter Output</title></head><body>"
					objIE.document.write "<div class=“table-responsive“><table  border=""1"" width=""100%""><tr><th>Time</th><th>intseverity</th><th>Description</th></tr>"
				end if
           		strieline = "<tr><td>" & now () & "</td>"
                Select Case intseverity
                    Case 0  strieline = strieLine & "<td bgcolor=""#00FF00"">Out0</td>"
                    Case 1  strieline = strieLine & "<td bgcolor=""#FF0000"">Err1</td>"
                    Case 2  strieline = strieLine & "<td bgcolor=""#FFFF00"">Wrn2</td>"
                    Case 3  strieline = strieLine & "<td>Inf3</td>"
                    Case Else strieline = strieLine & "<td>Dbg"&intseverity&"</td>"
                End Select
                strieline = strieline & "<td>" & strmessage & "</td></tr>"
				objIE.document.write cstr(strieline)
           end if

           '~ if (instr(DebugTarget,"mom") <>0) or blnerror then
				'~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage
           '~ end if

		end if  ' if status = active
		strline = ""
   	End Sub


	private function makefilename(wert)
		' Converts all invalid characters to valid file names
		wert = replace(wert,"\","-")
		wert = replace(wert,"/","-")
		wert = replace(wert,":","-")
		wert = replace(wert,"*","-")
		wert = replace(wert,"?","-")
		wert = replace(wert,"<","-")
		wert = replace(wert,"|","-")
		wert = replace(wert,"""","-")
		makefilename = wert
	end function

	private function Convert2Text(wert) 	' Converts non printable characters to "X" , so that Textfile is working
		dim loopcount, tempwert, inttest
		tempwert=""
		for loopcount = 1 to len(wert)   ' replace all unprintable characters  maybe easier and faster with RegEx
			tempwert = tempwert & chr(ascb(mid(wert,loopcount,1)))
		next
		Convert2Text = tempwert
	end function

end class


sub ForceCScript
    If InStr(1,WScript.FullName,"cscript",vbTextCompare) = 0 Then   ' Prüfung ob mit CSCRIPT gestartet wurde
        wscript.echo "Bitte mit CSCRIPT aufrufen"
        wscript.quit (255)
	end if
end sub



class clsCSVWriter
	' Class to write generic CSVFiles
	' Version 1.0 Initial Version
	' Version 1.1  WriteHeader + Prefix, WriteRawLine
	' Version 1.2  Add "Exists"-Methode  und Fehler in "Append"-Methode
	' Version 1.3  header bei Append nicht überschreiben
	' Last Modified: 17. Feb 09
	' Pending: Quotataion of '"'-Character in Data !!
	
	private csvfilename, csvfs, csvfile, chrDelimiter, chrQuote, strline, filemode
	private dictLine

	private Sub Class_Initialize
		chrDelimiter =";" : chrQuote = """" : csvfilename = ""
		set dictLine = createobject("scripting.dictionary")
		filemode = 2  'Overwrite
	End Sub	
	
	public property let Delimiter (wert)
	' Konfigure the delimiter. Default is ";"
		chrDelimiter =wert
	end property

	public property let Quote(wert)
	' Konfigure the sting enquoting. Default is "
		chrQuote = wert
	end property

	public property get Overwrite
	' Contant für Filemode
		Overwrite = 2
	end property

	public property get Append
	' Contant für Filemode
		Append = 8
	end property

	public property get Exist(strFile)
		Set csvfs = CreateObject("Scripting.FileSystemObject")
		if csvfs.FileExists(strFile) then
			Exist = true
		else
			Exist = False
		end if
	end property

	sub OpenFile(wert,intFileMode)
	' Open and start a new CSV-File
		if csvfilename <> "" then    'Close existing debug file
			csvfile.close : csvfile = nothing : csvfs = nothing
		end if

		csvfilename = wert    ' open debug file
		Set csvfs = CreateObject("Scripting.FileSystemObject")
		Set csvfile = csvfs.OpenTextFile(makefilename(csvfilename), intFileMode, True)
		filemode = intFileMode
	end sub

	sub AddHeader(strvalue)
	' Add a new column to the csv dataset
		if dictLine.exists(strvalue) then 
			objDebug.writeln "CSVWriter: duplicate Header definition:" & strValue, 1
		else
			dictLine.add strvalue, empty
		end if
	end sub	

	Sub WriteHeader(strPrefix)
	' Write the current Header Definition to the file. optional with a prefix 
	' Prefix can be used to fake IISLogs with "# Field: "
		dim key, strline 
		strline = ""
		if filemode <> 8 then 
			for each key in dictLine.keys
				if strline <> "" then 
					strline = strline & chrDelimiter 
				end if 
				strline = strline & chrQuote & cstr(key) & chrQuote
			next
			csvfile.WriteLine(strPrefix & strline)
		end if
	End Sub

	sub AddField(strfieldname,strvalue)
	' add a valuue together with the field name
		if dictLine.exists(strfieldname) then 
			dictLine.item(strfieldname) = strvalue
		else
			objDebug.writeln "CSVWriter: Field not declared:" & strFieldname, 1
		end if
	end sub
	
	Sub WriteLine
	' Write the current filled fields to the disk and starte a new line
		dim key, strline 
		strline = ""
		for each key in dictLine.keys
			if strline <> "" then 
				strline = strline & chrDelimiter 
			end if 
			strline = strline & chrQuote & dictLine(key) & chrQuote
			dictLine.item(key) = empty
		next
		csvfile.WriteLine(strline)
   	End Sub

	Sub WriteRawLine(strLine)
	' Write line without any formatting etc. Ideal für comments and other custom output
		csvfile.WriteLine(strline)
   	End Sub
	
	sub StartLine
	' Start a new line. Remove all existing data of the current line
		dim key, strline 
		strline = ""
		for each key in dictLine.keys
			dictLine.item(key) = empty
		next
   	End Sub

	private function makefilename(wert)
		' Converts all invalid characters to valid file names
		wert = replace(wert,"\","-")
		wert = replace(wert,"/","-")
		wert = replace(wert,":","-")
		wert = replace(wert,"*","-")
		wert = replace(wert,"?","-")
		wert = replace(wert,"<","-")
		wert = replace(wert,"|","-")
		wert = replace(wert,"""","-")
		makefilename = wert
	end function


end class