Const HTML_WHITE = "#FFFFFF"
Const HTML_RED = "#FF0000"
Const HTML_YELLOW = "#FFFF00"
Const HTML_PINK = "#FF6699"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Set objShell = CreateObject("WScript.Shell")
Set dctComputers = CreateObject("Scripting.Dictionary")
' Set the interval in hours, to go back from the time now, when searching for events
intInterval = 8
strComputers = "computers.txt"
strOutput = "EventReport.html"
strEventIDs = "608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,4774,4775,4756,4777,4768,4771,4772,4769,4770,4773,4783,4784,4785,4786,4787,4788,4789,4790,4791,4792,4741,4742,4743,4744,4745,4746,4747,4748,4749,4750,4751,4752,4753,4759,4760,4761,4762,4782,4793,4727,4728,4729,4730,4731,4732,4733,4734,4735,4737,4754,4755,4756,4757,4758,4764,4720,4722,4723,4724,4725,4726,4738,4740,4765,4766,4767,4780,4781,4794,5376,5377,4692,4693,4694,4695,4688,4696,4689,5712,4928,4929,4930,4931,4934,4935,4936,4937,4662,5136,5137,5138,5139,5141,4932,4933,4978,4979,4980,4981,4982,4983,4984,4646,4650,4651,4652,4653,4655,4976,5049,5453,4654,4977,5451,5452,4634,4647,4624,4625,4648,4675,6272,6273,6274,6275,6276,6277,6278,6279,6280,4649,4778,4779,4800,4801,4802,4803,5378,5632,5633,4964,4665,4666,4667,4668,5145,5140,5142,5143,5144,5168,4664,4985,5051,4671,4691,4698,4699,4700,4701,4702,4702,5888,5888,5890,4657,5039,4659,4660,4661,4663,4715,4719,4817,4902,4904,4905,4906,4907,4908,4912,4706,4707,4713,4716,4717,4718,4739,4864,4865,4866,4867,4704,4705,4714,4670,4672,4673,4674,4616,4621,4697"
strReportHeader = "report-header.html"
strReportRow = "report-row.html"
strReportFooter = "report-footer.html"
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmMsg = CreateObject("WbemScripting.SWbemDateTime")
EndDate = Now
StartDate = DateAdd("h", -intInterval, EndDate)
dtmStartDate.SetVarDate StartDate, True
dtmEndDate.SetVarDate EndDate, True
' Get HTML Data
Set objHeader = objFSO.OpenTextFile(strReportHeader, intForReading, False)
strReportHeader = objHeader.ReadAll
objHeader.Close
Set objRow = objFSO.OpenTextFile(strReportRow, intForReading, False)
strReportRow = objRow.ReadAll
objRow.Close
Set objFooter = objFSO.OpenTextFile(strReportFooter, intForReading, False)
strReportFooter = objFooter.ReadAll
objFooter.Close
' Write to output file
Set objHTML = objFSO.CreateTextFile(strOutput, True)
objHTML.WriteLine strReportHeader
Set objComputers = objFSO.OpenTextFile(strComputers, intForReading, False)
While Not objComputers.AtEndOfStream
strComputer = Trim(objComputers.ReadLine)
If strComputer <> "" Then
If Ping(strComputer) = True Then
strReturn = TestWMIConnection(strComputer, 10)
If strReturn = "success" Then
'WScript.Echo "WMI connection successful."
strQuery = "Select * from Win32_NTLogEvent Where LogFile='Security' and "
For Each intID In Split(strEventIDs, ",")
If Right(LCase(strQuery), 5) = " and " Then
strQuery = strQuery & "EventCode = '" & intID & "'"
Else
strQuery = strQuery & " or EventCode = '" & intID & "'"
End If
Next
strQuery = strQuery & " and (TimeWritten >= '" & dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "')"
'Run the query
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "\root\cimv2")
Set colEvents = objWMIService.ExecQuery (strQuery)
blnEventsFound = False
For Each objItem In colEvents
blnEventsFound = True
On Error Resume Next
strCategory = objItem.Category
strCategoryString = objItem.CategoryString
strComputerName = objItem.ComputerName
strData = Join(objItem.Data, ",")
strEventCode = objItem.EventCode
strEventIdentifier = objItem.EventIdentifier
strEventType = objItem.EventType
strInsertionStrings = Join(objItem.InsertionStrings, ",")
strLogFile = objItem.Logfile
strMessage = objItem.Message
strRecordNumber = objItem.RecordNumber
strSourceName = objItem.SourceName
dtmMsg.value = objItem.TimeGenerated
strTimeGenerated = dtmMsg.GetVarDate
dtmMsg.value = objItem.TimeWritten
strTimeWritten = dtmMsg.GetVarDate
strType = objItem.Type
strUser = objItem.User
Err.Clear
On Error Goto 0
If strCategory = "" Or IsNull(strCategory) = True Then strCategory = " "
If strCategoryString = "" Or IsNull(strCategoryString) = True Then strCategoryString = " "
If strComputerName = "" Or IsNull(strComputerName) = True Then strComputerName = " "
If strData = "" Or IsNull(strData) = True Then strData = " "
If strEventCode = "" Or IsNull(strEventCode) = True Then strEventCode = " "
If strEventIdentifier = "" Or IsNull(strEventIdentifier) = True Then strEventIdentifier = " "
If strEventType = "" Or IsNull(strEventType) = True Then strEventType = " "
If strInsertionStrings = "" Or IsNull(strInsertionStrings) = True Then strInsertionStrings = " "
If strLogFile = "" Or IsNull(strLogFile) = True Then strLogFile = " "
If strMessage = "" Or IsNull(strMessage) = True Then strMessage = " "
If strRecordNumber = "" Or IsNull(strRecordNumber) = True Then strRecordNumber = " "
If strSourceName = "" Or IsNull(strSourceName) = True Then strSourceName = " "
If strTimeGenerated = "" Or IsNull(strTimeGenerated) = True Then strTimeGenerated = " "
If strTimeWritten = "" Or IsNull(strTimeWritten) = True Then strTimeWritten = " "
If strType = "" Or IsNull(strType) = True Then strType = " "
If strUser = "" Or IsNull(strUser) = True Then strUser = " "
On Error Resume Next
If strMessage <> " " Then
arrMsgItem = Split(strMessage, vbCrLf)
strDescription = Replace(Split(arrMsgItem(0),":")(0), vbTab, "")
strTargetAccountName = UCase(Replace(Split(arrMsgItem(6),":")(1), vbTab, ""))
strDomain = Replace(Split(arrMsgItem(14),":")(1), vbTab, "")
strUserName = Replace(Split(arrMsgItem(12),":")(1), vbTab, "")
strDomainUser = strDomain & "\" & strUserName
strMemberID = Replace(Split(arrMsgItem(4),":")(1), vbTab, "")
strChangeInitiatedFrom = "-"
End If
Err.Clear
On Error GoTo 0
strRowData = strReportRow
strRowData = Replace(strRowData, "%EventCode%", strEventCode)
strRowData = Replace(strRowData, "%Computer%", strComputerName)
strRowData = Replace(strRowData, "%TimeWritten%", strTimeWritten)
strRowData = Replace(strRowData, "%Description%", strDescription)
strRowData = Replace(strRowData, "%TargetAccountName%", strTargetAccountName)
strRowData = Replace(strRowData, "%MemberID%", strMemberID)
strRowData = Replace(strRowData, "%ChangeMadeBy%", strDomainUser)
strRowData = Replace(strRowData, "%ChangeInitiatedFrom%", strChangeInitiatedFrom)
strRowData = Replace(strRowData, "%BGCOLOR%", HTML_WHITE)
Next
If blnEventsFound = False Then
'WScript.Echo "No events found."
strRowData = strReportRow
strRowData = Replace(strRowData, "%EventCode%", "NONE")
strRowData = Replace(strRowData, "%Computer%", strComputer)
strRowData = Replace(strRowData, "%TimeWritten%", " ")
strRowData = Replace(strRowData, "%Description%", " ")
strRowData = Replace(strRowData, "%TargetAccountName%", " ")
strRowData = Replace(strRowData, "%MemberID%", " ")
strRowData = Replace(strRowData, "%ChangeMadeBy%", " ")
strRowData = Replace(strRowData, "%ChangeInitiatedFrom%", " ")
strRowData = Replace(strRowData, "%BGCOLOR%", HTML_WHITE)
End If
ElseIf strReturn = "failed" Then
'WScript.Echo "WMI connection failed."
strRowData = strReportRow
strRowData = Replace(strRowData, "%EventCode%", "WMI ERROR")
strRowData = Replace(strRowData, "%Computer%", strComputer)
strRowData = Replace(strRowData, "%TimeWritten%", " ")
strRowData = Replace(strRowData, "%Description%", " ")
strRowData = Replace(strRowData, "%TargetAccountName%", " ")
strRowData = Replace(strRowData, "%MemberID%", " ")
strRowData = Replace(strRowData, "%ChangeMadeBy%", " ")
strRowData = Replace(strRowData, "%ChangeInitiatedFrom%", " ")
strRowData = Replace(strRowData, "%BGCOLOR%", HTML_WHITE)
ElseIf strReturn = "time out" Then
'WScript.Echo "WMI connection timed out."
strRowData = strReportRow
strRowData = Replace(strRowData, "%EventCode%", "WMI TIME OUT")
strRowData = Replace(strRowData, "%Computer%", strComputer)
strRowData = Replace(strRowData, "%TimeWritten%", " ")
strRowData = Replace(strRowData, "%Description%", " ")
strRowData = Replace(strRowData, "%TargetAccountName%", " ")
strRowData = Replace(strRowData, "%MemberID%", " ")
strRowData = Replace(strRowData, "%ChangeMadeBy%", " ")
strRowData = Replace(strRowData, "%ChangeInitiatedFrom%", " ")
strRowData = Replace(strRowData, "%BGCOLOR%", HTML_WHITE)
End If
Else
'WScript.Echo strComputer & " is offline"
strRowData = strReportRow
strRowData = Replace(strRowData, "%EventCode%", "OFFLINE")
strRowData = Replace(strRowData, "%Computer%", strComputer)
strRowData = Replace(strRowData, "%TimeWritten%", " ")
strRowData = Replace(strRowData, "%Description%", " ")
strRowData = Replace(strRowData, "%TargetAccountName%", " ")
strRowData = Replace(strRowData, "%MemberID%", " ")
strRowData = Replace(strRowData, "%ChangeMadeBy%", " ")
strRowData = Replace(strRowData, "%ChangeInitiatedFrom%", " ")
strRowData = Replace(strRowData, "%BGCOLOR%", HTML_WHITE)
End If
End If
objHTML.WriteLine strRowData
Wend
objComputers.Close
objHTML.WriteLine strReportFooter
objHTML.Close
MsgBox "Done. Please see " & strOutput
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
Function TestWMIConnection(strComputer, intTimeOutInSeconds)
' Function written by Raja - 11 Aug 2014
' Experts-Exchange volunteer:
http://http://support.microsoft.com/kb/977519.html
' Return strings from this function are in lower case, and consist of:
' "success": WMI Connection successful
' "failed": WMI Connection failed
' "time out": WMI Connection attempt timed out
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"
Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
objTempFile.WriteLine "On Error Resume Next"
objTempFile.WriteLine "Set objWMIService = GetObject(""winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2"")"
objTempFile.WriteLine "If Err.Number = 0 Then"
objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Success"""
objTempFile.WriteLine "Else"
objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""Failed"""
objTempFile.WriteLine "End If"
objTempFile.Close
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
intSeconds = 0
While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
WScript.Sleep 1000
intSeconds = intSeconds + 1
Wend
If objExec.Status = 1 Then
strReturn = objExec.StdOut.ReadAll
Else
On Error Resume Next
objExec.Terminate
Err.Clear
On Error GoTo 0
strReturn = "Time Out"
End If
objFSO.DeleteFile strTempScript, True
TestWMIConnection = LCase(strReturn)
End Function
Regards, Raja.S