Check audit log.

I use this script to check the audit log of the doamain controller for event id 6 (policy change). The script checks for the event in the past hour. This script uses CDO to sent a smtp mail. You must have the CDO library in outlook installed.


Const MsgFileData = 1
Const MsgFileLink = 2
Const MsgOle = 3
'*** from address
strFromAddress = "AuditCheck@mydomain.com"
'*** To address
strToAddress = "audit@mydomain.com"
'*** subject
strSubject = "Audit Policy has been changed"
'*** Ip address of smtp server
strSmtpMailServer = "192.168.10.10"
'*** name of server to check
strServer = "myservername"
strSchema = "http://schemas.microsoft.com/cdo/configuration/" 

strMonth = Month(date)
If Len(strMonth) = 1 Then 
	strMonth = "0" & strMonth
End If
strDay = Day(date)
If Len(strDay) = 1 Then 
	strDay = "0" & strDay
End If
strHour = Hour(time) - 1
If Len(strHour) = 1 Then 
	strHour = "0" & strHour
Else
	If strHour < 0 Then
		strHour = "23"
	End If
End If
qryDate = Year(date) & strMonth & strDay  & _
  strHour & "0000.000000+120"

'*** query event log for events with ID 6 in the past hour
strQuery = "select * from Win32_NTLogEvent " & _
"where Logfile = 'Security' " & _
"and Category = 6 and TimeGenerated > '" & qryDate & "'"


Set oLog = GetObject("winmgmts://" & _
 	strServer & "/root/CIMv2").ExecQuery(strQuery)

'*** loop through the events
For each oLogEntry in oLog
   strdateTime = oLogEntry.TimeGenerated
   strDate = Mid(strdateTime,1,4) & "-" & Mid(strdateTime,5,2) & _ 
   "-" & Mid(strdateTime,7,2) & " " &  _ 
   Mid(strdateTime,9,2) & ":" & Mid(strdateTime,11,2)
   '*** Create textbody for mail
   strTextbody = "Category : " & oLogEntry.CategoryString & VbCrLf
   strTextbody = strTextbody & "Date/Time: " & strDate  & VbCrLf
   strTextbody = strTextbody & "User: " & oLogEntry.User & VbCrLf
   strTextbody = strTextbody &"Computer: " & _ 
                 oLogEntry.ComputerName & VbCrLf
   strTextbody = strTextbody &"Information : "  & VbCrLf
   strTextbody = strTextbody &oLogEntry.Message & VbCrLf
   strTextbody = strTextbody & VbCrLf

   '*** create mail object by using CDO library from outlook
   Set objEmail = CreateObject("CDO.Message")
   With objEmail
      .From = strFromAddress
      .To = strToAddress
      .Subject = strSubject 
      .Textbody = strTextBody
       
       With .Configuration.Fields
         .Item(strschema & "sendusing") = 2
         .Item(strschema & "smtpserver") = strSmtpMailServer
         .Item(strschema & "smtpserverport") = 25
         .Update  
      End With
      
      '*** send smtp mail
      .Send
   End With
Next