asked on

Query AD for Event ID 6008

Need script which query AD for the 6008 for the list of server which will stored in notepad, the output should be place in another file in the below format.

---Computername--
6008 <time_date> <-------------- most recent first
6008 time_date
---Computername--
6008 <time_date> <-------------- most recent first
6008 time_date

have the script if this could be modifed for the requirement will be appreciated
Script is taken from the question(Thanks to Rob):
https://www.experts-exchange.com/questions/27018030/Query-AD-for-Event-ID-6008-for-Sub-OU-with-duration-of-30-Days.html

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Const EventID = 6008
DateToCheck = DateAdd("d", -30, Now)
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Dim objRoot:Set objRoot = GetObject("LDAP://RootDSE")
Dim objDomain:Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objOUs = GetObject(objDomain.adsPath)
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOutput:Set objOutput = objFso.CreateTextFile("6008Events.log")
EnumOUs(objDomain.ADsPath)

objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Sub EnumOUs(adspath)
    Dim objOUs, OU
    Set objOUs = GetObject(adspath)
    objOUs.Filter = Array("OrganizationalUnit")
    Call EnumUsers(objOUs.ADsPath)
    For Each OU In objOUs
        wscript.echo "Processing " & Replace(OU.Name, "OU=", "")
        objOutput.WriteLine Replace(Ucase(OU.Name), "OU=", "")
        Call EnumOUs(OU.ADsPath)
    Next
End Sub

Sub EnumUsers(adspath)
	Dim objServers:Set objServers = GetObject(adspath)
	objServers.Filter = Array("Computer")
	objOutput.WriteLine
	For Each objSvr In objServers
		On Error Resume Next
		If Ping(objSvr.CN) = True Then
			WScript.Echo "Connecting to " & objSvr.CN
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
			'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
			If Err.Number = 0 Then
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objOutput.WriteLine objSvr.CN & "," & EventID & "," & strDate
					'End If
					Else
						objOutput.WriteLine objSvr.CN & ",Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
					objOutput.WriteLine
				Next
			Else
				objOutput.WriteLine objSvr.CN & ",WMI Connection Error"
				WScript.Echo "Error connecting to " & objSvr.CN
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine objSvr.CN & ",Computer offline"
			WScript.Echo objSvr.CN & " is offline"
		End If
	Next
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

RobSampson

Hi, I haven't tested this, but give it a shot.

Regards,

Rob.

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Const EventID = 6008
DateToCheck = DateAdd("d", -30, Now)
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate DateToCheck, True
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5
Dim objRoot:Set objRoot = GetObject("LDAP://RootDSE")
Dim objDomain:Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objOUs = GetObject(objDomain.adsPath)
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOutput:Set objOutput = objFso.CreateTextFile("6008Events.log")
EnumOUs(objDomain.ADsPath)

objOutput.Close
Set objOutput=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit 

Sub EnumOUs(adspath)
    Dim objOUs, OU
    Set objOUs = GetObject(adspath)
    objOUs.Filter = Array("OrganizationalUnit")
    Call EnumUsers(objOUs.ADsPath)
    For Each OU In objOUs
        wscript.echo "Processing " & Replace(OU.Name, "OU=", "")
        objOutput.WriteLine Replace(Ucase(OU.Name), "OU=", "")
        Call EnumOUs(OU.ADsPath)
    Next
End Sub

Sub EnumUsers(adspath)
	Dim objServers:Set objServers = GetObject(adspath)
	objServers.Filter = Array("Computer")
	objOutput.WriteLine
	For Each objSvr In objServers
		On Error Resume Next
		If Ping(objSvr.CN) = True Then
			WScript.Echo "Connecting to " & objSvr.CN
			Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & objSvr.CN & "\root\cimv2")
			'wscript.echo "Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'"
			Set colEvents = objWMI.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'System' And EventCode=" & EventID & " And TimeWritten > '" & dtmStartDate & "'")
			If Err.Number = 0 Then
				Set objDataList = CreateObject("ADOR.Recordset")
				objDataList.Fields.Append "TimeWritten", adVarChar
				objDataList.Fields.Append "FormattedDate", adVarChar
				objDataList.Open
				For Each objEvent In colEvents
					If Err.Number = 0 Then
					'If x > 3 Then Exit For
						strDate=objEvent.TimeWritten
						strYear=Left(strDate,4)
						strMonth=Mid(strDate,5,2)
						strDay=Mid(strDate,7,2)
						strHour=Mid(strDate,9,2)
						strMin=Mid(strDate,11,2)
						strSec=Mid(strDate,13,2)
						strDate=strMonth & "/" & strDay & "/" & strYear & " " & strHour & ":" & strMin & ":" & strSec
						objDataList.AddNew
						objDataList("TimeWritten") = objEvent.TimeWritten
						objDataList("FormattedDate") = strDate
						objDataList.Update
					'End If
					Else
						objOutput.WriteLine objSvr.CN & vbTab & "Error " & Err.Number & "," & Err.Description
						Err.Clear
					End If
				Next
				objOutput.WriteLine objSvr.CN
				objDataList.Sort = "TimeWritten"
				While Not objDataList.EOF
					objOutput.WriteLine EventID & vbTab & objDataList("FormattedDate")
					objDataList.MoveNext
				Wend
				objDataList.Close
				objOutput.WriteLine
			Else
				objOutput.WriteLine objSvr.CN & vbTab & "WMI Connection Error"
				WScript.Echo "Error connecting to " & objSvr.CN
				Err.Clear
				On Error Goto 0
			End If
		Else
			objOutput.WriteLine objSvr.CN & vbTab & "Computer offline"
			WScript.Echo objSvr.CN & " is offline"
		End If
	Next
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

RobSampson

Oh, you'll probably need to change
objDataList.Sort = "TimeWritten"
to
objDataList.Sort = "TimeWritten DESC"

Regards,

Rob.