Option Explicit
'Copyright 2018 Nate Shull
'GNU License
'I take no responsibility for any broken systems, use at your own risk
'this script will record  events in the log pertaining to a group change into a log file, 
'if there are no events in the log or file it will echo a good text line else it will
'pop off the first group change as a warning (for remove) or critical state (for add).
'2018-03-08 change to write the file all at once

'objects and variables
Dim shell, fso

'variables from nagios
Const intOK = 0
Const intWarning = 1
Const intCritical = 2
Const intError = 3

Set shell = CreateObject("WScript.Shell")

Set fso = createobject("Scripting.FileSystemObject")

Dim baseFolderPath
baseFolderPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

'Grab Arguments
Dim keywordArry, keywordArryTrig, index, hostName
hostName = "."
keywordArryTrig = false
ReDim keywordArry(0)
For index=0 to WScript.Arguments.Count-1
	If WScript.Arguments(index) = "-k" Then
		keywordArry = addtoArray(keywordArry, WScript.Arguments(index+1))
		keywordArryTrig = true
	End If
	
	If WScript.Arguments(index) = "-h" Then
		hostName = WScript.Arguments(index+1)
	End If
Next

'******************main program****************************
If keywordArryTrig Then
	Dim currSystime
	Dim groupChgLogFile, groupChgLogFileObj, groupChgLogFileLines
	'build spool file
	groupChgLogFile = baseFolderPath
	Dim tempElement, groupChgLogFileName
	For Each tempElement in keywordArry
		groupChgLogFileName = groupChgLogFileName & replace(replace(tempElement," ",""),"\","")
	Next
	'keep file name from getting too large.
	If Len(groupChgLogFileName) > 200 Then
		groupChgLogFileName = left(groupChgLogFileName,200)
	End If
	
	if hostName = "." then
		groupChgLogFile = groupChgLogFile & groupChgLogFileName & ".txt"
	else
		groupChgLogFile = groupChgLogFile & hostName & groupChgLogFileName & ".txt"
	end if
	
	Dim lastSystime, groupChgFileBool, queryDate
	Const CONVERT_TO_LOCAL_TIME = True
	groupChgFileBool = False
	'Set queryDate = CreateObject("WbemScripting.SWbemDateTime")
	'grab audit file split into lines in array
	'first line includes last runtime, if no file is found run 2 days worth.
	If fso.fileExists(groupChgLogFile) Then
		groupChgLogFileObj = fso.OpenTextFile(groupChgLogFile,1,true).ReadAll
		groupChgLogFileLines = split(groupChgLogFileObj,vbCrLf)
		'read last dates
		lastSystime = CDate(groupChgLogFileLines(0))
		queryDate = wmiDateConvert(lastSystime)
		'queryDate.SetVarDate lastSystime,CONVERT_TO_LOCAL_TIME
		If isInArray(groupChgLogFileLines,"Warning") OR isInArray(groupChgLogFileLines,"Critical") Then
			groupChgLogFileLines = popArray(groupChgLogFileLines)
			groupChgFileBool = True
		Else
			groupChgLogFileLines = popArray(groupChgLogFileLines)
			groupChgFileBool = False
		End If
	Else
		lastSystime = dateadd("h",-2,Now())
		'queryDate.SetVarDate lastSystime,CONVERT_TO_LOCAL_TIME
		queryDate = wmiDateConvert(lastSystime)
		groupChgFileBool = 0
	End If
	currSystime = FormatDateTime(Now(),0)
	
	'run wmi query
	Dim groupChgEvents, sqlVars, groupChgEventLine, groupChgQueryBool
	ReDim groupChgEvents(0)
	groupChgQueryBool = False
	'event 632 = add member, event 633 = delete member, 661 = Enterprise delete member, 660 Enterprise Add member
	'local add= 4732, del = 4733 universal add = 4756, del = 4757 global add = 4728, del= 4729
	sqlVars = "(Logfile = 'Security' and EventCode = 632 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 633 and TimeWritten > '" & queryDate & "') " & _
	"OR (Logfile = 'Security' and EventCode = 661 and TimeWritten > '" & queryDate & "') " & _
	"OR (LogFile = 'Security' and EventCode = 660 and TimeWritten > '" & queryDate & "') " & _
	"OR (LogFile = 'Security' and EventCode = 636 and TimeWritten > '" & queryDate & "') " & _
	"OR (LogFile = 'Security' and EventCode = 637 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4732 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4733 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4756 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4757 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4728 and TimeWritten > '" & queryDate & "') " &_
	"OR (Logfile = 'Security' and EventCode = 4729 and TimeWritten > '" & queryDate & "')"
	groupChgEvents = getGroupChangeEvents(sqlVars, keywordArry, hostName)

	Dim groupChgFinalArray
	ReDim groupChgFinalArray(0)
	If groupChgQueryBool And groupChgFileBool Then
		groupChgFinalArray = combineArrays(groupChgLogFileLines,groupChgEvents)
	ElseIf groupChgQueryBool Then
		groupChgFinalArray = groupChgEvents
	ElseIf groupChgFileBool Then
		groupChgFinalArray = groupChgLogFileLines
	Else
		wscript.echo "OK - No Changes to Monitored Groups"
		fso.OpenTextFile(groupChgLogFile,2,true).WriteLine currSystime
		wscript.Quit(intOK)
	End If
	groupChgFinalArray = cleanArray(groupChgFinalArray)
   
	'read first element into stdout
	wscript.echo groupChgFinalArray(0)
	Dim warnBool
	warnBool = False
	If instr(groupChgFinalArray(0),"Warning") Then
		warnBool = true
	End If
	'write left over elements to audit file or delete it if empty
	'remove first event from array, write the rest
	
	groupChgFinalArray = popArray(groupChgFinalArray)
	dim textOut, eventOut
	textOut = currSystime & vbCrlf
	for each eventOut in groupChgFinalArray
		textOut = textOut & vbcrlf &  eventOut
	next
	'on error resume next
	fso.OpenTextFile(groupChgLogFile ,2,true).WriteLine textOut
	'on error goto 0
	
	If warnBool Then
		wscript.Quit(intWarning)
	Else
		wscript.Quit(intCritical)
	End If
Else
	wscript.Echo "Error - No Group Keyword(s) Specified (script.vbs -k ""Group Name"" -k ""group2"" etc...)"
	wscript.Quit(intError)
End If 
	
	
'****************functions*********
	'wmi filter date
	function wmiDateConvert(datein)
		dim wmiTimeObj, wmiTimeCol, timeZoneObj, timeZone
		Set wmiTimeObj = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
		Set wmiTimeCol = wmiTimeObj.ExecQuery ("SELECT * FROM Win32_TimeZone")
		For Each timeZoneObj in wmiTimeCol
		 timeZone = timeZoneObj.Bias
		Next

		dim wmiDateBuild, wmiDateBuildMon, wmiDateBuildDay
		dim wmiDateBuildHour, wmiDateBuildMin, wmiDateBuildSec

		wmiDateBuild = Year(datein)

		wmiDateBuildMon = Month(datein)
		If Len(wmiDateBuildMon) = 1 Then
		 wmiDateBuildMon = "0" & wmiDateBuildMon
		End If

		wmiDateBuild = wmiDateBuild & wmiDateBuildMon

		wmiDateBuildDay = Day(datein)
		If Len(wmiDateBuildDay) = 1 Then
		 wmiDateBuildDay = "0" & wmiDateBuildDay
		End If
		
		wmiDateBuild = wmiDateBuild & wmiDateBuildDay
		
		wmiDateBuildHour = Hour(datein)
		If Len(wmiDateBuildHour) = 1 Then
		 wmiDateBuildHour = "0" & wmiDateBuildHour
		End If
		
		wmiDateBuild = wmiDateBuild & wmiDateBuildHour

		wmiDateBuildMin = Minute(datein)
		If Len(wmiDateBuildMin) = 1 Then
		 wmiDateBuildMin = "0" & wmiDateBuildMin
		End If
		
		wmiDateBuild = wmiDateBuild & wmiDateBuildMin

		wmiDateBuildSec = Second(datein)
		If Len(wmiDateBuildSec) = 1 Then
		 wmiDateBuildSec = "0" & wmiDateBuildSec
		End If
		
		wmiDateBuild = wmiDateBuild & wmiDateBuildSec & ".000000"
		wmiDateBuild = wmiDateBuild & Cstr(timeZone)
		'wscript.echo wmiDateBuild & vbcrlf
		wmiDateConvert = wmiDateBuild
	end function


	'******* test array contents
	function testarry(arrytotest)
		dim tstcomb, tstIndex, tstElement
		tstcomb= ""
		For Each tstElement In arrytotest
			tstcomb = tstcomb & vbCr & tstElement
		Next
		wscript.echo tstcomb
	end function
	
	'addtoarray (easy array resize and add, returns array)
	Function addtoArray(arrayVar,Value)
		dim addtoArraySize, addtoArrayWorkArray
		addtoArrayWorkArray = arrayVar
		addtoArraySize = UBound(addtoArrayWorkArray)
		If len(addtoArrayWorkArray(0)) = 0 Then
			addtoArrayWorkArray(0) = Value
		Else
			addtoArraySize = addtoArraySize + 1
			ReDim Preserve addtoArrayWorkArray(addtoArraySize)
			addtoArrayWorkArray(addtoArraySize) = Value
		End If
		addtoArray = addtoArrayWorkArray
	End Function
	
	Function cleanArray(arryToClean)
		Dim cleanWorkArry, cleanElement
		ReDim cleanWorkArry(0)
		For Each cleanElement in arryToClean
			If len(cleanElement) > 0 Then
				cleanWorkArry = addtoArray(cleanWorkArry,cleanElement)
			End If
		Next
		cleanArray = cleanWorkArry
	End Function
	
	'combinearrays (easy array merge, first arg is begining, second arg is after, returns array)
	Function combineArrays(firstArray,secondArray)
		Dim combArray, combArrLine
		combArray = firstArray
		For Each combArrLine in secondArray
			combArray = addtoArray(combArray,combArrLine)
		Next
		combineArrays = combArray
	End Function
	
	Function isInArray(searchArry,searchString)
		Dim isInArrayElement, isInArrayRes
		isInArrayRes = False
		For Each isInArrayElement In searchArry
			If InStr(isInArrayElement,searchString) Then
				isInArrayRes = True
			End If
		Next
		isInArray = isInArrayRes
	End Function
	
	Function writeArrytoFile(arrytoWrite,filePath,overWriteFile)
		Dim overWriteVar, writeFileElement, writeFileLines
		writeFileLines = 0
		For Each writeFileElement in arrytoWrite
			If overWriteFile = true Then
				overWriteVar = 2
				overWriteFile = false
			Else
				overWriteVar = 8
			End If
			fso.OpenTextFile(filePath,overWriteVar,true).WriteLine writeFileElement
			writeFileLines = writeFileLines + 1
		Next
		writeArrytoFile = writeFileLines
	End Function
	
	'poparray (easy drop first element, returns array)
	Function popArray(popMeArray)
		Dim popArry, popArryElement, popArryTrg
		ReDim popArry(0)
		'trigger the skip of the first element
		popArryTrg = False
		For Each popArryElement In popMeArray
			If popArryTrg Then
				popArry = addtoArray(popArry,popArryElement)
			Else
				popArryTrg = True
			End If
		Next
		popArray = popArry
	End Function
	
	Function getMidText(fullText,StartingPhrase,EndingPhrase,textTrim)
		Dim strPhraseLen, endPhraseLen, strPhrasePos, endPhrasePos
		Dim midTextStart, midTextEnd,midTextResult
		strPhraseLen = len(StartingPhrase)
		endPhraseLen = len(EndingPhrase)
		strPhrasePos = InStr(fullText,StartingPhrase)
		endPhrasePos = InStr(fullText,EndingPhrase)
		If strPhraseLen < 1 OR endPhraseLen < 1 OR endPhrasePos < 1 Then
			midTextResult = "error"
		Else
			midTextStart = strPhrasePos + strPhraseLen
			midTextEnd = endPhrasePos - midTextStart 
			midTextResult = Mid(fullText,midTextStart,midTextEnd)
			'wscript.echo midTextResult
			If textTrim Then
				midTextResult = replace(midTextResult,vbCr,"")
				midTextResult = replace(midTextResult,vbLf,"")
				midTextResult = replace(midTextResult,vbCrLf,"")
				midTextResult = replace(midTextResult,vbTab,"")
				midTextResult = replace(midTextResult,vbNewLine,"")
				midTextResult = Trim(midTextResult)
			End If
		End If
		getMidText = midTextResult
	End Function
	
	'getGroupChangeEvents (wmi log query using date and accepting a filter as an argument, returns array of matches)
	Function getGroupChangeEvents(condition, kwordArray, hostToCheck)
		'WMI vars and objects
		Dim objWMI, objEvent, wmiQuery, colLoggedEvents
		Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & hostToCheck & "\root\cimv2")
		Const wbemFlagReturnImmediately = &h10
		Const wbemFlagForwardOnly = &h20
		wmiQuery = "Select * from Win32_NTLogEvent Where " & condition
		
		Dim eventstrDate, eventstrTime, eventLog, eventCode, eventMsg, MsgLines
		DIm eventGroup, eventUserAdd, groupName, adminUser, userChange, statusLine
		ReDim MsgLines(0)
		
		Dim groupKeyword
		
		Set colLoggedEvents = objWMI.ExecQuery(wmiQuery,"WQL",wbemFlagReturnImmediately + wbemFlagForwardOnly)
		For Each objEvent in colLoggedEvents
			groupName = false
			eventstrDate = Mid(objEvent.TimeWritten,5,2) & "/" & Mid(objEvent.TimeWritten,7,2) & "/" & Mid(objEvent.TimeWritten,1,4)
			eventstrTime = Mid(objEvent.TimeWritten,9,2) & ":" & Mid(objEvent.TimeWritten,11,2) & ":" & Mid(objEvent.TimeWritten,13,2)
			eventCode = objEvent.EventCode
			eventMsg = objEvent.Message
			If InStr(eventMsg, "Offer Remote Assistance") Then
				'skip
			Else
				For Each groupKeyword in  kwordArray
					If InStr(eventMsg, groupKeyword) Then
						groupName = groupKeyword
					End If
				Next
				If Not groupName = false Then
					If eventCode = 4732 OR eventCode = 4733 OR eventCode = 4728 OR eventCode = 4729 OR eventCode = 4756 OR eventCode = 4757 Then
						userChange = getMidText(eventMsg,"Member:","Group:",true)
						userChange = getMidText(userChange,"Security ID:","Account Name:",true)
						userChange = nameFromSID(userChange)
						userChange = replace(userChange, "\", ":")
						adminUser = getMidText(eventMsg,"Subject:","Logon ID:",true)
						adminUser = getMidText(adminUser,"Security ID:","Account Name:",true)
						adminUser = nameFromSID(adminUser)
						adminUser = replace(adminUser, "\", ":")
					Else
						userChange = getMidText(eventMsg,"Member ID:","Target Account Name:",true)
						userChange = replace(userChange, "\", ":")
						adminUser = objEvent.User
						adminUser = replace(adminUser, "\", ":")
					End If
					
					If eventCode = 632 OR eventCode = 660 OR eventCode = 636 OR eventCode = 4728 OR eventCode = 4732 OR eventCode = 4756 Then
						statusLine = "Critical - " & adminUser & " Added " & userChange & " To " & groupName & " On " & eventstrDate & " " & eventstrTime
					Else
						statusLine = "Warning - " & adminUser & " Deleted " & userChange & " From " & groupName & " On " & eventstrDate & " " & eventstrTime
					End If
					groupChgQueryBool = True
					MsgLines = addtoArray(MsgLines,statusLine)
				End If
			End If
		Next
		getGroupChangeEvents = MsgLines
	End Function
	
	Function nameFromSID(SIDinfo)
		Dim objSIDWMI, objSIDUser
		Set objSIDWMI = GetObject("winmgmts:\\.\root\cimv2")
		Set objSIDUser = objSIDWMI.Get("Win32_SID.SID='" & SIDinfo & "'")
		nameFromSID = objSIDUser.ReferencedDomainName & "\" & objSIDUser.AccountName
	End Function