asked on

Script to audit AD.

Hi,

Script to audit AD.

At present these are captured

Group membership
Disabled
Created new
Deleted

I want these additions.
Capture manager name change
capture OU moved status from and TO OU

Email has to be sent even when outlook closed.

Regards
Sharath

Meir Rivkin

const ROOT_OU = "cn=users"
const REPOSITORY_FILE = "c:\temp\repository.log"
const REPOSITORY_COMPARE_FILE = "c:\temp\repository_comp.log"
const RESULT_FILE = "c:\temp\result.log"
const USER_PROPS = "Name,AccountDisabled,AccountExpirationDate,Manager,GroupMembership"

Set usersPropsDict = CreateObject("Scripting.Dictionary")
set objFSO = createobject("scripting.filesystemobject")

GetUsersProps

if objFSO.FileExists(REPOSITORY_FILE) then
	objFSO.CopyFile REPOSITORY_FILE, REPOSITORY_COMPARE_FILE, TRUE

	LogUsersProps
	CheckUserChanges
else
	LogUsersProps
end if

function CheckUsersStatus(prevStateArr, curStateArr)

	dim strResult
	Set usersDict = CreateObject("Scripting.Dictionary")
	
	for each line in prevStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			usersDict.Add user, 0
		end if
	next
	
	for each line in curStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			if usersDict.Exists(user) then
				usersDict.Item(user) = 2
			else
				usersDict.Add user, 1
			end if
		end if
	next
	
	for each key in usersDict
		select case usersDict.Item(key) 
			case 0: 'user was deleted
				strResult = strResult & "User [" & key & "] was deleted" & vbNewLine
			case 1: 'new created user
				strResult = strResult & "New user [" & key & "] was created" & vbNewLine
			case 2: 'user wasn't changed
		end select
	next
	CheckUsersStatus = strResult
end function

sub CheckUserChanges

	curStateData = objFSO.OpenTextFile(REPOSITORY_FILE, 1).ReadAll
	prevStateData = objFSO.OpenTextFile(REPOSITORY_COMPARE_FILE, 1).ReadAll
	curStateArr = Split(curStateData, vbNewLine)
	prevStateArr = Split(prevStateData, vbNewLine)
	
	strSubject = "AD User Changes Result Log - " & Date & " " & Time
	
	strResult = CheckUsersStatus(prevStateArr, curStateArr)
	for i=1 to UBound(curStateArr)
		line = curStateArr(i)
		if InStr(prevStateData, Trim(line) & vbNewLine) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then				
				changeResult = LogUserPropertiesChange(matchLine, line)
				if changeResult <> "" then
					strResult = strResult & changeResult
				end if
			end if
		end if
	next
	
	if objFSO.FileExists(RESULT_FILE) then
		set objResFile = objFSO.OpenTextFile(RESULT_FILE, 8)
	else
		set objResFile = objFSO.CreateTextFile(RESULT_FILE, 2)
	end if
	
	objResFile.WriteLine strSubject
	
	if strResult <> "" then
		objResFile.WriteLine strResult
		'NotifyByEmail strSubject, strResult
	else
		objResFile.WriteLine "No changes were monitored."
	end if
	objResFile.Close
	
end sub

sub NotifyByEmail(strSubject, strResult)
	Dim ToAddress
	Dim MessageSubject
	Dim MessageBody
	Dim MessageAttachment

	Dim ol, ns, newMail

	ToAddress = "XXX.YYY@ZZZ.com"
	MessageSubject = strSubject
	MessageBody = strResult

	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	ns.logon "","",true,false
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.Body = MessageBody & vbCrLf

	' validate the recipient, just in case...
	Set myRecipient = ns.CreateRecipient(ToAddress)
	myRecipient.Resolve
	If Not myRecipient.Resolved Then
	   MsgBox "unknown recipient"
	Else
	   newMail.Recipients.Add(myRecipient)
	   newMail.Send
	End If

	Set ol = Nothing

end sub

function LogUserPropertiesChange(matchLine, line)

	changeResult = false
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		'special handling for GroupMembership
		if userPropsArr(i) = "GroupMembership" then
			if UBound(arr1) < i then
				strResult = strResult & "Groups [" & Replace(arr2(i), ";",",") & "] were removed" & vbNewLine
				changeResult =true
			else
				if UBound(arr2) < i then
					strResult = strResult & "Groups [" & Replace(arr1(i), ";",",") & "] were added" & vbNewLine
					changeResult =true
				else
					arrMembers1 = Split(arr1(i), ";")
					arrMembers2 = Split(arr2(i), ";")
					strResult = strResult & userPropsArr(i) & ": " & vbNewLine
					
					Set dictmembers2 = CreateObject("Scripting.Dictionary")
					Set dictmembers1 = CreateObject("Scripting.Dictionary")

					for each mem2 in arrMembers2
						dictmembers2.Add mem2, nothing
					next
					
					for each mem1 in arrMembers1
						if dictmembers2.Exists(mem1) = false then 	
							strResult = strResult & "Group [" & mem1 & "] was added" & vbNewLine
						end if
						
						dictmembers1.Add mem1, nothing
					next
					
					for each mem2 in arrMembers2
						if dictmembers1.Exists(mem2) = false then 	
							strResult = strResult & "Group [" & mem2 & "] was removed" & vbNewLine
						end if
					next
					
					changeResult =true
				end if
			end if
		else
			if UBound(arr1) >= i and UBound(arr2) >= i then
				if arr1(i) <> arr2(i) then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			else
				if UBound(arr1) >= i and UBound(arr2) < i then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = No Property" & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				else 
					if UBound(arr1) < i and UBound(arr2) >= i then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = No Property" & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					end if
				end if
			end if
		end if
	next 
	if changeResult = true then
		LogUserPropertiesChange = strResult & vbNewLine
	else
		LogUserPropertiesChange = ""
	end if
	
end function

function FindUserChangeDelta(line, prevStateArr)

	dim user,matchLine
	user = Split(line, ",")(0)
	
	for each prevLine in prevStateArr
		if Trim(prevLine) <> "" then
			if Split(prevLine, ",")(0) = user then
				matchLine = prevLine
				exit for
			end if
		end if
	next

	FindUserChangeDelta = matchLine
end function

sub LogUsersProps
	on error resume next
	dim userProp
	set objLog = objFSO.CreateTextFile(REPOSITORY_FILE, 2)
	
	objLog.WriteLine USER_PROPS
	
	for each objKey in usersPropsDict
		userProp = objKey
		for each objInnerKey in usersPropsDict(objKey)
			userProp = userProp & "," & usersPropsDict(objKey)(objInnerKey)
		next
		
		objLog.WriteLine userProp
	next
	
	objLog.Close
end sub

sub GetUsersProps
	dim user
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if
		
	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='user'"
	
	Set objRecordSet = objCommand.Execute

	While Not objRecordSet.EOF
		user = objRecordSet.Fields("sAMAccountName").Value
		
		if usersPropsDict.Exists(user) = false then
			on error resume next
			Set propsDict = CreateObject("Scripting.Dictionary")
			usersPropsDict.Add user, propsDict
			Set ObjUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
			propsDict.Add "AccountDisabled", ObjUser.AccountDisabled
			propsDict.Add "AccountExpirationDate", ObjUser.AccountExpirationDate
			'propsDict.Add "PasswordLastChanged", objUser.PasswordLastChanged
			propsDict.Add "Manager", objUser.Manager
		end if
		
		objRecordSet.MoveNext
	WEnd 
	
	getUsersGroups
end sub

sub getUsersGroups

	dim group
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if

	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='group'"
	
	Set objRecordSet = objCommand.Execute
	
	While Not objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
		
		Set ObjGroup = GetObject("LDAP://" & group)
		for each objMember in objGroup.Members
			if usersPropsDict.Exists(objmember.samaccountname) then
				if usersPropsDict.Item(objmember.samaccountname).Exists("groupMembership") then
					groupMembership = usersPropsDict.Item(objmember.samaccountname).Item("groupMembership")
					groupMembership = groupMembership & ";" & objGroup.samaccountname
					usersPropsDict.Item(objmember.samaccountname).Item("groupMembership") = groupMembership
				else
					usersPropsDict.Item(objmember.samaccountname).Add "groupMembership", objGroup.samaccountname
				end if
				
			end if			
		next
		objRecordSet.MoveNext
	WEnd 
end sub

Open in new window

Meir Rivkin

i added the Manager attribute, let me know if it's working for you, i'll see what can be done with moved OU.

Meir Rivkin

updated

const ROOT_OU = "cn=users"
const REPOSITORY_FILE = "c:\temp\repository.log"
const REPOSITORY_COMPARE_FILE = "c:\temp\repository_comp.log"
const RESULT_FILE = "c:\temp\result.log"
const USER_PROPS = "Name,AccountDisabled,AccountExpirationDate,Manager,GroupMembership"

Set usersPropsDict = CreateObject("Scripting.Dictionary")
set objFSO = createobject("scripting.filesystemobject")

GetUsersProps

if objFSO.FileExists(REPOSITORY_FILE) then
	objFSO.CopyFile REPOSITORY_FILE, REPOSITORY_COMPARE_FILE, TRUE

	LogUsersProps
	CheckUserChanges
else
	LogUsersProps
end if

wscript.echo "Complete"

function CheckUsersStatus(prevStateArr, curStateArr)

	dim strResult
	Set usersDict = CreateObject("Scripting.Dictionary")
	
	for each line in prevStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			usersDict.Add user, 0
		end if
	next
	
	for each line in curStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			if usersDict.Exists(user) then
				usersDict.Item(user) = 2
			else
				usersDict.Add user, 1
			end if
		end if
	next
	
	for each key in usersDict
		select case usersDict.Item(key) 
			case 0: 'user was deleted
				strResult = strResult & "User [" & key & "] was deleted" & vbNewLine
			case 1: 'new created user
				strResult = strResult & "New user [" & key & "] was created" & vbNewLine
			case 2: 'user wasn't changed
		end select
	next
	CheckUsersStatus = strResult
end function

sub CheckUserChanges

	curStateData = objFSO.OpenTextFile(REPOSITORY_FILE, 1).ReadAll
	prevStateData = objFSO.OpenTextFile(REPOSITORY_COMPARE_FILE, 1).ReadAll
	curStateArr = Split(curStateData, vbNewLine)
	prevStateArr = Split(prevStateData, vbNewLine)
	
	strSubject = "AD User Changes Result Log - " & Date & " " & Time
	
	strResult = CheckUsersStatus(prevStateArr, curStateArr)
	for i=1 to UBound(curStateArr)
		line = curStateArr(i)
		if InStr(prevStateData, Trim(line) & vbNewLine) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then				
				changeResult = LogUserPropertiesChange(matchLine, line)
				if changeResult <> "" then
					strResult = strResult & changeResult
				end if
			end if
		end if
	next
	
	if objFSO.FileExists(RESULT_FILE) then
		set objResFile = objFSO.OpenTextFile(RESULT_FILE, 8)
	else
		set objResFile = objFSO.CreateTextFile(RESULT_FILE, 2)
	end if
	
	objResFile.WriteLine strSubject
	
	if strResult <> "" then
		objResFile.WriteLine strResult
		NotifyByEmail strSubject, strResult
	else
		objResFile.WriteLine "No changes were monitored."
	end if
	objResFile.Close
	
end sub

sub NotifyByEmail(strSubject, strResult)
	Dim ToAddress
	Dim MessageSubject
	Dim MessageBody
	Dim MessageAttachment

	Dim ol, ns, newMail

	ToAddress = "XXX.YYY@ZZZ.com"
	MessageSubject = strSubject
	MessageBody = strResult

	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	ns.logon "","",true,false
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.Body = MessageBody & vbCrLf

	' validate the recipient, just in case...
	Set myRecipient = ns.CreateRecipient(ToAddress)
	myRecipient.Resolve
	If Not myRecipient.Resolved Then
	   MsgBox "unknown recipient"
	Else
	   newMail.Recipients.Add(myRecipient)
	   newMail.Send
	End If

	Set ol = Nothing

end sub

function LogUserPropertiesChange(matchLine, line)

	changeResult = false
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		'special handling for GroupMembership
		if userPropsArr(i) = "GroupMembership" then
			if UBound(arr1) < i then
				strResult = strResult & "Groups [" & Replace(arr2(i), ";",",") & "] were removed" & vbNewLine
				changeResult =true
			else
				if UBound(arr2) < i then
					strResult = strResult & "Groups [" & Replace(arr1(i), ";",",") & "] were added" & vbNewLine
					changeResult =true
				else
					arrMembers1 = Split(arr1(i), ";")
					arrMembers2 = Split(arr2(i), ";")
					strResult = strResult & userPropsArr(i) & ": " & vbNewLine
					
					Set dictmembers2 = CreateObject("Scripting.Dictionary")
					Set dictmembers1 = CreateObject("Scripting.Dictionary")

					for each mem2 in arrMembers2
						dictmembers2.Add mem2, nothing
					next
					
					for each mem1 in arrMembers1
						if dictmembers2.Exists(mem1) = false then 	
							strResult = strResult & "Group [" & mem1 & "] was removed" & vbNewLine
						end if
						
						dictmembers1.Add mem1, nothing
					next
					
					for each mem2 in arrMembers2
						if dictmembers1.Exists(mem2) = false then 	
							strResult = strResult & "Group [" & mem2 & "] was added" & vbNewLine
						end if
					next
					
					changeResult =true
				end if
			end if
		else
			if UBound(arr1) >= i and UBound(arr2) >= i then
				if arr1(i) <> arr2(i) then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			else
				if UBound(arr1) >= i and UBound(arr2) < i then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = No Property" & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				else 
					if UBound(arr1) < i and UBound(arr2) >= i then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = No Property" & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					end if
				end if
			end if
		end if
	next 
	if changeResult = true then
		LogUserPropertiesChange = strResult & vbNewLine
	else
		LogUserPropertiesChange = ""
	end if
	
end function

function FindUserChangeDelta(line, prevStateArr)

	dim user,matchLine
	user = Split(line, ",")(0)
	
	for each prevLine in prevStateArr
		if Trim(prevLine) <> "" then
			if Split(prevLine, ",")(0) = user then
				matchLine = prevLine
				exit for
			end if
		end if
	next

	FindUserChangeDelta = matchLine
end function

sub LogUsersProps
	on error resume next
	dim userProp
	set objLog = objFSO.CreateTextFile(REPOSITORY_FILE, 2)
	
	objLog.WriteLine USER_PROPS
	
	for each objKey in usersPropsDict
		userProp = objKey
		for each objInnerKey in usersPropsDict(objKey)
			userProp = userProp & "," & usersPropsDict(objKey)(objInnerKey)
		next
		
		objLog.WriteLine userProp
	next
	
	objLog.Close
end sub

sub GetUsersProps
	dim user
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if
		
	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='user'"
	
	Set objRecordSet = objCommand.Execute

	While Not objRecordSet.EOF
		user = objRecordSet.Fields("sAMAccountName").Value
		
		if usersPropsDict.Exists(user) = false then
			on error resume next
			Set propsDict = CreateObject("Scripting.Dictionary")
			usersPropsDict.Add user, propsDict
			Set ObjUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
			propsDict.Add "AccountDisabled", ObjUser.AccountDisabled
			propsDict.Add "AccountExpirationDate", ObjUser.AccountExpirationDate
			propsDict.Add "Manager", Replace(ObjUser.Manager,","," ")
		end if
		
		objRecordSet.MoveNext
	WEnd 
	
	getUsersGroups
end sub

sub getUsersGroups

	dim group
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if

	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='group'"
	
	Set objRecordSet = objCommand.Execute
	
	While Not objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
		
		Set ObjGroup = GetObject("LDAP://" & group)
		for each objMember in objGroup.Members
			if usersPropsDict.Exists(objmember.samaccountname) then
				if usersPropsDict.Item(objmember.samaccountname).Exists("groupMembership") then
					groupMembership = usersPropsDict.Item(objmember.samaccountname).Item("groupMembership")
					groupMembership = groupMembership & ";" & objGroup.samaccountname
					usersPropsDict.Item(objmember.samaccountname).Item("groupMembership") = groupMembership
				else
					usersPropsDict.Item(objmember.samaccountname).Add "groupMembership", objGroup.samaccountname
				end if
				
			end if			
		next
		objRecordSet.MoveNext
	WEnd 
end sub

Open in new window

Meir Rivkin

>>capture OU moved status from and TO OU

what do u mean by moved status?

bsharath

ASKER

Moved a user from one Ou to another or a group moved from one Ou to another

Meir Rivkin

this would a massive time consuming task, cause it involves looping through every single user/group under the whole domain.
are you this is what u need?

bsharath

ASKER

As we first capture what OU a user resides. is it not easy to find if he is still there or not.
Can we get if user not there in the Ou which was previously scanned and recorded?
I will again need within a Ou and not whole Domain

Meir Rivkin

we didn't capture what OU the use resides, just if the user stillas moe exists under the root OU.
but if he was moved (not deleted/added), the current script does not detect that.
what i can do is since i get the user object anyway, i can monitor its LDAP path.
so next scan if its LDAP was changed, i know it was moved.
is that ok?

bsharath

ASKER

Ya that would be fine but while emailing just need the Ou names in any case i dont want the LDAP paths

bsharath

ASKER

Just now the scheduled task i got a email of all users details as this

[name of user1]
GroupMembership:
[name of user2]
GroupMembership:

I got all my 3000+ user details and just the field and no group details. Any idea why i got such email

Meir Rivkin

i've updated the script to show just manager name and not LDAP path of manager.
also fixed groupMembership problem

const ROOT_OU = "cn=users"
const REPOSITORY_FILE = "c:\temp\repository.log"
const REPOSITORY_COMPARE_FILE = "c:\temp\repository_comp.log"
const RESULT_FILE = "c:\temp\result.log"
const USER_PROPS = "Name,AccountDisabled,AccountExpirationDate,Manager,GroupMembership"

Set usersPropsDict = CreateObject("Scripting.Dictionary")
set objFSO = createobject("scripting.filesystemobject")

GetUsersProps

if objFSO.FileExists(REPOSITORY_FILE) then
	objFSO.CopyFile REPOSITORY_FILE, REPOSITORY_COMPARE_FILE, TRUE

	LogUsersProps
	CheckUserChanges
else
	LogUsersProps
end if

wscript.echo "Complete"

function CheckUsersStatus(prevStateArr, curStateArr)

	dim strResult
	Set usersDict = CreateObject("Scripting.Dictionary")
	
	for each line in prevStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			usersDict.Add user, 0
		end if
	next
	
	for each line in curStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			if usersDict.Exists(user) then
				usersDict.Item(user) = 2
			else
				usersDict.Add user, 1
			end if
		end if
	next
	
	for each key in usersDict
		select case usersDict.Item(key) 
			case 0: 'user was deleted
				strResult = strResult & "User [" & key & "] was deleted" & vbNewLine
			case 1: 'new created user
				strResult = strResult & "New user [" & key & "] was created" & vbNewLine
			case 2: 'user wasn't changed
		end select
	next
	CheckUsersStatus = strResult
end function

sub CheckUserChanges

	curStateData = objFSO.OpenTextFile(REPOSITORY_FILE, 1).ReadAll
	prevStateData = objFSO.OpenTextFile(REPOSITORY_COMPARE_FILE, 1).ReadAll
	curStateArr = Split(curStateData, vbNewLine)
	prevStateArr = Split(prevStateData, vbNewLine)
	
	strSubject = "AD User Changes Result Log - " & Date & " " & Time
	
	strResult = CheckUsersStatus(prevStateArr, curStateArr)
	for i=1 to UBound(curStateArr)
		line = curStateArr(i)
		if InStr(prevStateData, Trim(line) & vbNewLine) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then				
				changeResult = LogUserPropertiesChange(matchLine, line)
				if changeResult <> "" then
					strResult = strResult & changeResult
				end if
			end if
		end if
	next
	
	if objFSO.FileExists(RESULT_FILE) then
		set objResFile = objFSO.OpenTextFile(RESULT_FILE, 8)
	else
		set objResFile = objFSO.CreateTextFile(RESULT_FILE, 2)
	end if
	
	objResFile.WriteLine strSubject
	
	if strResult <> "" then
		objResFile.WriteLine strResult
		NotifyByEmail strSubject, strResult
	else
		objResFile.WriteLine "No changes were monitored."
	end if
	objResFile.Close
	
end sub

sub NotifyByEmail(strSubject, strResult)
	Dim ToAddress
	Dim MessageSubject
	Dim MessageBody
	Dim MessageAttachment

	Dim ol, ns, newMail

	ToAddress = "XXX.YYY@ZZZ.com"
	MessageSubject = strSubject
	MessageBody = strResult

	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	ns.logon "","",true,false
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.Body = MessageBody & vbCrLf

	' validate the recipient, just in case...
	Set myRecipient = ns.CreateRecipient(ToAddress)
	myRecipient.Resolve
	If Not myRecipient.Resolved Then
	   MsgBox "unknown recipient"
	Else
	   newMail.Recipients.Add(myRecipient)
	   newMail.Send
	End If

	Set ol = Nothing

end sub

function GetGroupMembershipChanges(i, arr1, arr2)
	changeResult = false
	strResult = "GroupMembership: " & vbNewLine
	
	if UBound(arr1) < i then
		if UBound(arr2) >= i then
			strResult = strResult & "Groups [" & Replace(arr2(i), ";",",") & "] were removed" & vbNewLine
			changeResult = true
		end if
	else
		if UBound(arr2) < i then
			if UBound(arr1) >= i then
				strResult = strResult & "Groups [" & Replace(arr1(i), ";",",") & "] were added" & vbNewLine
				changeResult = true
			end if
		else
			arrMembers1 = Split(arr1(i), ";")
			arrMembers2 = Split(arr2(i), ";")
			
			Set dictmembers2 = CreateObject("Scripting.Dictionary")
			Set dictmembers1 = CreateObject("Scripting.Dictionary")

			for each mem2 in arrMembers2
				dictmembers2.Add mem2, nothing
			next
			
			for each mem1 in arrMembers1
				if dictmembers2.Exists(mem1) = false then 	
					strResult = strResult & "Group [" & mem1 & "] was removed" & vbNewLine
					changeResult = true
				end if
				
				dictmembers1.Add mem1, nothing
			next
			
			for each mem2 in arrMembers2
				if dictmembers1.Exists(mem2) = false then 	
					strResult = strResult & "Group [" & mem2 & "] was added" & vbNewLine
					changeResult = true
				end if
			next
			
		end if
	end if
	
	if changeResult = true then
		GetGroupMembershipChanges = strResult
	else
		GetGroupMembershipChanges = ""
	end if	
end function

function LogUserPropertiesChange(matchLine, line)

	changeResult = false
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		'special handling for GroupMembership
		if userPropsArr(i) = "GroupMembership" then
			strGroupResult = GetGroupMembershipChanges(i,arr1,arr2)
			if strGroupResult <> "" then
				strResult = strResult & strGroupResult & vbNewLine
			end if
		else
			if UBound(arr1) >= i and UBound(arr2) >= i then
				if arr1(i) <> arr2(i) then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			else
				if UBound(arr1) >= i and UBound(arr2) < i then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = No Property" & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				else 
					if UBound(arr1) < i and UBound(arr2) >= i then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = No Property" & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					end if
				end if
			end if
		end if
	next 
	if changeResult = true then
		LogUserPropertiesChange = strResult & vbNewLine
	else
		LogUserPropertiesChange = ""
	end if
	
end function

function FindUserChangeDelta(line, prevStateArr)

	dim user,matchLine
	user = Split(line, ",")(0)
	
	for each prevLine in prevStateArr
		if Trim(prevLine) <> "" then
			if Split(prevLine, ",")(0) = user then
				matchLine = prevLine
				exit for
			end if
		end if
	next

	FindUserChangeDelta = matchLine
end function

sub LogUsersProps
	on error resume next
	dim userProp
	set objLog = objFSO.CreateTextFile(REPOSITORY_FILE, 2)
	
	objLog.WriteLine USER_PROPS
	
	for each objKey in usersPropsDict
		userProp = objKey
		for each objInnerKey in usersPropsDict(objKey)
			userProp = userProp & "," & usersPropsDict(objKey)(objInnerKey)
		next
		
		objLog.WriteLine userProp
	next
	
	objLog.Close
end sub

sub GetUsersProps
	dim user
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if
		
	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='user'"
	
	Set objRecordSet = objCommand.Execute

	While Not objRecordSet.EOF
		user = objRecordSet.Fields("sAMAccountName").Value
		
		if usersPropsDict.Exists(user) = false then
			on error resume next
			Set propsDict = CreateObject("Scripting.Dictionary")
			usersPropsDict.Add user, propsDict
			Set ObjUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
			propsDict.Add "AccountDisabled", ObjUser.AccountDisabled
			propsDict.Add "AccountExpirationDate", ObjUser.AccountExpirationDate
			set objManager = GetObject("LDAP://" & ObjUser.Manager)
			propsDict.Add "Manager", Replace(objManager.Name, "CN=", "")
		end if
		
		objRecordSet.MoveNext
	WEnd 
	
	getUsersGroups
end sub

sub getUsersGroups

	dim group
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if

	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='group'"
	
	Set objRecordSet = objCommand.Execute
	
	While Not objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
		
		Set ObjGroup = GetObject("LDAP://" & group)
		for each objMember in objGroup.Members
			if usersPropsDict.Exists(objmember.samaccountname) then
				if usersPropsDict.Item(objmember.samaccountname).Exists("groupMembership") then
					groupMembership = usersPropsDict.Item(objmember.samaccountname).Item("groupMembership")
					groupMembership = groupMembership & ";" & objGroup.samaccountname
					usersPropsDict.Item(objmember.samaccountname).Item("groupMembership") = groupMembership
				else
					usersPropsDict.Item(objmember.samaccountname).Add "groupMembership", objGroup.samaccountname
				end if
				
			end if			
		next
		objRecordSet.MoveNext
	WEnd 
end sub

Open in new window

Meir Rivkin

i've added Parent OU to the log file which will indicate if the user was moved.
for example:

AD User Changes Result Log - 8/19/2010 9:52:28 PM
[liorf]
Parent OU:
Before = Builtin
After = Users

--> user liorf was moved from OU Builtin to OU Users

const ROOT_OU = "cn=users"
const REPOSITORY_FILE = "c:\temp\repository.log"
const REPOSITORY_COMPARE_FILE = "c:\temp\repository_comp.log"
const RESULT_FILE = "c:\temp\result.log"
const USER_PROPS = "Name,Parent OU,AccountDisabled,AccountExpirationDate,Manager,GroupMembership"

Set usersPropsDict = CreateObject("Scripting.Dictionary")
set objFSO = createobject("scripting.filesystemobject")

GetUsersProps

if objFSO.FileExists(REPOSITORY_FILE) then
	objFSO.CopyFile REPOSITORY_FILE, REPOSITORY_COMPARE_FILE, TRUE

	LogUsersProps
	CheckUserChanges
else
	LogUsersProps
end if

wscript.echo "Complete"

function CheckUsersStatus(prevStateArr, curStateArr)

	dim strResult
	Set usersDict = CreateObject("Scripting.Dictionary")
	
	for each line in prevStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			usersDict.Add user, 0
		end if
	next
	
	for each line in curStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			if usersDict.Exists(user) then
				usersDict.Item(user) = 2
			else
				usersDict.Add user, 1
			end if
		end if
	next
	
	for each key in usersDict
		select case usersDict.Item(key) 
			case 0: 'user was deleted
				strResult = strResult & "User [" & key & "] was deleted" & vbNewLine
			case 1: 'new created user
				strResult = strResult & "New user [" & key & "] was created" & vbNewLine
			case 2: 'user wasn't changed
		end select
	next
	CheckUsersStatus = strResult
end function

sub CheckUserChanges

	curStateData = objFSO.OpenTextFile(REPOSITORY_FILE, 1).ReadAll
	prevStateData = objFSO.OpenTextFile(REPOSITORY_COMPARE_FILE, 1).ReadAll
	curStateArr = Split(curStateData, vbNewLine)
	prevStateArr = Split(prevStateData, vbNewLine)
	
	strSubject = "AD User Changes Result Log - " & Date & " " & Time
	
	strResult = CheckUsersStatus(prevStateArr, curStateArr)
	for i=1 to UBound(curStateArr)
		line = curStateArr(i)
		if InStr(prevStateData, Trim(line) & vbNewLine) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then				
				changeResult = LogUserPropertiesChange(matchLine, line)
				if changeResult <> "" then
					strResult = strResult & changeResult
				end if
			end if
		end if
	next
	
	if objFSO.FileExists(RESULT_FILE) then
		set objResFile = objFSO.OpenTextFile(RESULT_FILE, 8)
	else
		set objResFile = objFSO.CreateTextFile(RESULT_FILE, 2)
	end if
	
	objResFile.WriteLine strSubject
	
	if strResult <> "" then
		objResFile.WriteLine strResult
		NotifyByEmail strSubject, strResult
	else
		objResFile.WriteLine "No changes were monitored."
	end if
	objResFile.Close
	
end sub

sub NotifyByEmail(strSubject, strResult)
	Dim ToAddress
	Dim MessageSubject
	Dim MessageBody
	Dim MessageAttachment

	Dim ol, ns, newMail

	ToAddress = "XXX.YYY@ZZZ.com"
	MessageSubject = strSubject
	MessageBody = strResult

	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	ns.logon "","",true,false
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.Body = MessageBody & vbCrLf

	' validate the recipient, just in case...
	Set myRecipient = ns.CreateRecipient(ToAddress)
	myRecipient.Resolve
	If Not myRecipient.Resolved Then
	   MsgBox "unknown recipient"
	Else
	   newMail.Recipients.Add(myRecipient)
	   newMail.Send
	End If

	Set ol = Nothing

end sub

function GetGroupMembershipChanges(i, arr1, arr2)
	changeResult = false
	strResult = "GroupMembership: " & vbNewLine
	
	if UBound(arr1) < i then
		if UBound(arr2) >= i then
			strResult = strResult & "Groups [" & Replace(arr2(i), ";",",") & "] were removed" & vbNewLine
			changeResult = true
		end if
	else
		if UBound(arr2) < i then
			if UBound(arr1) >= i then
				strResult = strResult & "Groups [" & Replace(arr1(i), ";",",") & "] were added" & vbNewLine
				changeResult = true
			end if
		else
			arrMembers1 = Split(arr1(i), ";")
			arrMembers2 = Split(arr2(i), ";")
			
			Set dictmembers2 = CreateObject("Scripting.Dictionary")
			Set dictmembers1 = CreateObject("Scripting.Dictionary")

			for each mem2 in arrMembers2
				dictmembers2.Add mem2, nothing
			next
			
			for each mem1 in arrMembers1
				if dictmembers2.Exists(mem1) = false then 	
					strResult = strResult & "Group [" & mem1 & "] was removed" & vbNewLine
					changeResult = true
				end if
				
				dictmembers1.Add mem1, nothing
			next
			
			for each mem2 in arrMembers2
				if dictmembers1.Exists(mem2) = false then 	
					strResult = strResult & "Group [" & mem2 & "] was added" & vbNewLine
					changeResult = true
				end if
			next
			
		end if
	end if
	
	if changeResult = true then
		GetGroupMembershipChanges = strResult
	else
		GetGroupMembershipChanges = ""
	end if	
end function

function LogUserPropertiesChange(matchLine, line)

	changeResult = false
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		'special handling for GroupMembership
		if userPropsArr(i) = "GroupMembership" then
			strGroupResult = GetGroupMembershipChanges(i,arr1,arr2)
			if strGroupResult <> "" then
				strResult = strResult & strGroupResult & vbNewLine
			end if
		else
			if UBound(arr1) >= i and UBound(arr2) >= i then
				if arr1(i) <> arr2(i) then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			else
				if UBound(arr1) >= i and UBound(arr2) < i then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = No Property" & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				else 
					if UBound(arr1) < i and UBound(arr2) >= i then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = No Property" & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					end if
				end if
			end if
		end if
	next 
	if changeResult = true then
		LogUserPropertiesChange = strResult & vbNewLine
	else
		LogUserPropertiesChange = ""
	end if
	
end function

function FindUserChangeDelta(line, prevStateArr)

	dim user,matchLine
	user = Split(line, ",")(0)
	
	for each prevLine in prevStateArr
		if Trim(prevLine) <> "" then
			if Split(prevLine, ",")(0) = user then
				matchLine = prevLine
				exit for
			end if
		end if
	next

	FindUserChangeDelta = matchLine
end function

sub LogUsersProps
	on error resume next
	dim userProp
	set objLog = objFSO.CreateTextFile(REPOSITORY_FILE, 2)
	
	objLog.WriteLine USER_PROPS
	
	for each objKey in usersPropsDict
		userProp = objKey
		for each objInnerKey in usersPropsDict(objKey)
			userProp = userProp & "," & usersPropsDict(objKey)(objInnerKey)
		next
		
		objLog.WriteLine userProp
	next
	
	objLog.Close
end sub

sub GetUsersProps
	dim user
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if
		
	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='user'"
	
	Set objRecordSet = objCommand.Execute

	While Not objRecordSet.EOF
		user = objRecordSet.Fields("sAMAccountName").Value
		
		if usersPropsDict.Exists(user) = false then
			on error resume next
			Set propsDict = CreateObject("Scripting.Dictionary")
			usersPropsDict.Add user, propsDict
			
			distName = objRecordSet.Fields("distinguishedName").Value
			Set ObjUser = GetObject("LDAP://" & distName)
			arrPath = Split(distName, ",")
			intLength = Len(arrPath(1))
			intNameLength = intLength - 3
			parentOU = Right(arrPath(1), intNameLength)
			propsDict.Add "Parent OU", parentOU
			propsDict.Add "AccountDisabled", ObjUser.AccountDisabled
			propsDict.Add "AccountExpirationDate", ObjUser.AccountExpirationDate
			set objManager = GetObject("LDAP://" & ObjUser.Manager)
			propsDict.Add "Manager", Replace(objManager.Name, "CN=", "")
		end if
		
		objRecordSet.MoveNext
	WEnd 
	
	getUsersGroups
end sub

sub getUsersGroups

	dim group
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if

	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='group'"
	
	Set objRecordSet = objCommand.Execute
	
	While Not objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
		
		Set ObjGroup = GetObject("LDAP://" & group)
		for each objMember in objGroup.Members
			if usersPropsDict.Exists(objmember.samaccountname) then
				if usersPropsDict.Item(objmember.samaccountname).Exists("groupMembership") then
					groupMembership = usersPropsDict.Item(objmember.samaccountname).Item("groupMembership")
					groupMembership = groupMembership & ";" & objGroup.samaccountname
					usersPropsDict.Item(objmember.samaccountname).Item("groupMembership") = groupMembership
				else
					usersPropsDict.Item(objmember.samaccountname).Add "groupMembership", objGroup.samaccountname
				end if
				
			end if			
		next
		objRecordSet.MoveNext
	WEnd 
end sub

Open in new window

bsharath

ASKER

I checked the manager and i got this

[Some name]
Manager:
Before = Sharath
After = Paul

Where as i removed the manager and that user does not have a manager but dont know how it shows some other user as the manager

bsharath

ASKER

1. Does it not consider the Ou thats the first root
I moved to the Root OU and it did not log it

2. When i move a user between Ou's it mentions Created new user and not moved user

3. Its not the same always some times i get the group names alone and some times the Ldap path for groups

bsharath

ASKER

For managers i get like this for all users

[test]
Manager:
Before = No Property
After = paul anderson

Its wrong. Even after there is no manager for this user.

And No quering of managers are needed for disabled users

Meir Rivkin

fixed the manager issue, check it out

const ROOT_OU = "cn=users"
const REPOSITORY_FILE = "c:\temp\repository.log"
const REPOSITORY_COMPARE_FILE = "c:\temp\repository_comp.log"
const RESULT_FILE = "c:\temp\result.log"
const USER_PROPS = "Name,Parent OU,AccountDisabled,AccountExpirationDate,Manager,GroupMembership"

Set usersPropsDict = CreateObject("Scripting.Dictionary")
set objFSO = createobject("scripting.filesystemobject")

GetUsersProps

if objFSO.FileExists(REPOSITORY_FILE) then
	objFSO.CopyFile REPOSITORY_FILE, REPOSITORY_COMPARE_FILE, TRUE

	LogUsersProps
	CheckUserChanges
else
	LogUsersProps
end if

wscript.echo "Complete"

function CheckUsersStatus(prevStateArr, curStateArr)

	dim strResult
	Set usersDict = CreateObject("Scripting.Dictionary")
	
	for each line in prevStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			usersDict.Add user, 0
		end if
	next
	
	for each line in curStateArr
		if Trim(line) <> "" then
			user = Split(line, ",")(0)
			if usersDict.Exists(user) then
				usersDict.Item(user) = 2
			else
				usersDict.Add user, 1
			end if
		end if
	next
	
	for each key in usersDict
		select case usersDict.Item(key) 
			case 0: 'user was deleted
				strResult = strResult & "User [" & key & "] was deleted" & vbNewLine
			case 1: 'new created user
				strResult = strResult & "New user [" & key & "] was created" & vbNewLine
			case 2: 'user wasn't changed
		end select
	next
	CheckUsersStatus = strResult
end function

sub CheckUserChanges

	curStateData = objFSO.OpenTextFile(REPOSITORY_FILE, 1).ReadAll
	prevStateData = objFSO.OpenTextFile(REPOSITORY_COMPARE_FILE, 1).ReadAll
	curStateArr = Split(curStateData, vbNewLine)
	prevStateArr = Split(prevStateData, vbNewLine)
	
	strSubject = "AD User Changes Result Log - " & Date & " " & Time
	
	strResult = CheckUsersStatus(prevStateArr, curStateArr)
	for i=1 to UBound(curStateArr)
		line = curStateArr(i)
		if InStr(prevStateData, Trim(line) & vbNewLine) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then				
				changeResult = LogUserPropertiesChange(matchLine, line)
				if changeResult <> "" then
					strResult = strResult & changeResult
				end if
			end if
		end if
	next
	
	if objFSO.FileExists(RESULT_FILE) then
		set objResFile = objFSO.OpenTextFile(RESULT_FILE, 8)
	else
		set objResFile = objFSO.CreateTextFile(RESULT_FILE, 2)
	end if
	
	objResFile.WriteLine strSubject
	
	if strResult <> "" then
		objResFile.WriteLine strResult
		NotifyByEmail strSubject, strResult
	else
		objResFile.WriteLine "No changes were monitored."
	end if
	objResFile.Close
	
end sub

sub NotifyByEmail(strSubject, strResult)
	Dim ToAddress
	Dim MessageSubject
	Dim MessageBody
	Dim MessageAttachment

	Dim ol, ns, newMail

	ToAddress = "XXX.YYY@ZZZ.com"
	MessageSubject = strSubject
	MessageBody = strResult

	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	ns.logon "","",true,false
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.Body = MessageBody & vbCrLf

	' validate the recipient, just in case...
	Set myRecipient = ns.CreateRecipient(ToAddress)
	myRecipient.Resolve
	If Not myRecipient.Resolved Then
	   MsgBox "unknown recipient"
	Else
	   newMail.Recipients.Add(myRecipient)
	   newMail.Send
	End If

	Set ol = Nothing

end sub

function GetGroupMembershipChanges(i, arr1, arr2)
	changeResult = false
	strResult = "GroupMembership: " & vbNewLine
	
	if UBound(arr1) < i then
		if UBound(arr2) >= i then
			strResult = strResult & "Groups [" & Replace(arr2(i), ";",",") & "] were removed" & vbNewLine
			changeResult = true
		end if
	else
		if UBound(arr2) < i then
			if UBound(arr1) >= i then
				strResult = strResult & "Groups [" & Replace(arr1(i), ";",",") & "] were added" & vbNewLine
				changeResult = true
			end if
		else
			arrMembers1 = Split(arr1(i), ";")
			arrMembers2 = Split(arr2(i), ";")
			
			Set dictmembers2 = CreateObject("Scripting.Dictionary")
			Set dictmembers1 = CreateObject("Scripting.Dictionary")

			for each mem2 in arrMembers2
				dictmembers2.Add mem2, nothing
			next
			
			for each mem1 in arrMembers1
				if dictmembers2.Exists(mem1) = false then 	
					strResult = strResult & "Group [" & mem1 & "] was removed" & vbNewLine
					changeResult = true
				end if
				
				dictmembers1.Add mem1, nothing
			next
			
			for each mem2 in arrMembers2
				if dictmembers1.Exists(mem2) = false then 	
					strResult = strResult & "Group [" & mem2 & "] was added" & vbNewLine
					changeResult = true
				end if
			next
			
		end if
	end if
	
	if changeResult = true then
		GetGroupMembershipChanges = strResult
	else
		GetGroupMembershipChanges = ""
	end if	
end function

function LogUserPropertiesChange(matchLine, line)

	changeResult = false
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		'special handling for GroupMembership
		if userPropsArr(i) = "GroupMembership" then
			strGroupResult = GetGroupMembershipChanges(i,arr1,arr2)
			if strGroupResult <> "" then
				strResult = strResult & strGroupResult & vbNewLine
			end if
		else
			if UBound(arr1) >= i and UBound(arr2) >= i then
				if arr1(i) <> arr2(i) then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			else
				if UBound(arr1) >= i and UBound(arr2) < i then
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = No Property" & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				else 
					if UBound(arr1) < i and UBound(arr2) >= i then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = No Property" & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					end if
				end if
			end if
		end if
	next 
	if changeResult = true then
		LogUserPropertiesChange = strResult & vbNewLine
	else
		LogUserPropertiesChange = ""
	end if
	
end function

function FindUserChangeDelta(line, prevStateArr)

	dim user,matchLine
	user = Split(line, ",")(0)
	
	for each prevLine in prevStateArr
		if Trim(prevLine) <> "" then
			if Split(prevLine, ",")(0) = user then
				matchLine = prevLine
				exit for
			end if
		end if
	next

	FindUserChangeDelta = matchLine
end function

sub LogUsersProps
	on error resume next
	dim userProp
	set objLog = objFSO.CreateTextFile(REPOSITORY_FILE, 2)
	
	objLog.WriteLine USER_PROPS
	
	for each objKey in usersPropsDict
		userProp = objKey
		for each objInnerKey in usersPropsDict(objKey)
			userProp = userProp & "," & usersPropsDict(objKey)(objInnerKey)
		next
		
		objLog.WriteLine userProp
	next
	
	objLog.Close
end sub

sub GetUsersProps
	dim user
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if
		
	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='user'"
	
	Set objRecordSet = objCommand.Execute

	While Not objRecordSet.EOF
		user = objRecordSet.Fields("sAMAccountName").Value
		
		if usersPropsDict.Exists(user) = false then
			on error resume next
			Set propsDict = CreateObject("Scripting.Dictionary")
			usersPropsDict.Add user, propsDict
			
			distName = objRecordSet.Fields("distinguishedName").Value
			Set ObjUser = GetObject("LDAP://" & distName)
			arrPath = Split(distName, ",")
			intLength = Len(arrPath(1))
			intNameLength = intLength - 3
			parentOU = Right(arrPath(1), intNameLength)
			propsDict.Add "Parent OU", parentOU
			propsDict.Add "AccountDisabled", ObjUser.AccountDisabled
			
			if ObjUser.AccountExpirationDate <> "" then
				propsDict.Add "AccountExpirationDate", ObjUser.AccountExpirationDate
			else
				propsDict.Add "AccountExpirationDate", ""
			end if
			
			if ObjUser.Manager <> "" then
			set objManager = GetObject("LDAP://" & ObjUser.Manager)
				propsDict.Add "Manager", Replace(objManager.Name, "CN=", "")
			else
				propsDict.Add "Manager", ""
			end if
		end if
		
		objRecordSet.MoveNext
	WEnd 
	
	getUsersGroups	
end sub

sub getUsersGroups

	dim group
	Const ADS_SCOPE_SUBTREE = 2

	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")

	if ROOT_OU <> "" then
		ldaproot = "LDAP://" & ROOT_OU & "," & strDNSDomain
	else
		ldaproot = "LDAP://" & strDNSDomain
	end if

	objCommand.CommandText = "SELECT distinguishedName,sAMAccountName FROM '" & ldaproot & "' WHERE objectCategory='group'"
	
	Set objRecordSet = objCommand.Execute
	
	While Not objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
		
		Set ObjGroup = GetObject("LDAP://" & group)
		for each objMember in objGroup.Members
			if usersPropsDict.Exists(objmember.samaccountname) then
				if usersPropsDict.Item(objmember.samaccountname).Exists("groupMembership") then
					groupMembership = usersPropsDict.Item(objmember.samaccountname).Item("groupMembership")
					groupMembership = groupMembership & ";" & objGroup.samaccountname
					usersPropsDict.Item(objmember.samaccountname).Item("groupMembership") = groupMembership
				else
					usersPropsDict.Item(objmember.samaccountname).Add "groupMembership", objGroup.samaccountname
				end if
				
			end if			
		next
		objRecordSet.MoveNext
	WEnd 
end sub

Open in new window

Meir Rivkin

if user was moved to a different OU which is not under the root OU (which you set in the script), it counts as removed.
because the script limit the search to all objects under the root OU.
if user was moved to OU which is under root OU, then you have the "parent OU" property which indicate that user has moved.

ASKER CERTIFIED SOLUTION

Meir Rivkin

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

bsharath

ASKER

Some issues. The log files are not created. Even the temp ones.

Meir Rivkin

can u isolate the problem?
i run this script numerous times on different cases and it worked every time.
delete all repository files before running the script.
try run the script from command line like this:

cscript thecsript.vbs > c:\ttemp\script.log

and post the script.log here

bsharath

ASKER

Thanks a lot..

Can you help with this post
https://www.experts-exchange.com/questions/26419649/Monitor-a-Ou-and-all-sub-Ou's-and-email-if-a-computer-has-not-contacted-domain-for-more-than-10-days-Vbs-or-Powershell.html?cid=239&anchorAnswerId=33494578#a33494578
Can you take the accepted post as final and add this code and the new code and post in the new Q... Please...