Solved

Anyone can give me a script that checks every Distribution group each day once and gets the differences to a file.?

Posted on 2010-08-17
44
464 Views
Last Modified: 2012-05-10
Hi,

Anyone can please help me with a script that can be scheduled to check an OU where i have 100's of distribution groups and check the count and member names and match with a older file and then place the changes alone to a new file. All group and membership changes to a file.

Like which group which user was removed and which group which user was added. if no change then mention nothing.

I tried many ways but could not succed via some free tools and Event logs.

Can anyone help me with a powershell or vbs script.

regards
Sharath



0
Comment
Question by:bsharath
  • 22
  • 21
44 Comments
 
LVL 9

Expert Comment

by:skipper68
ID: 33457999
Without scripting, this might be easier if you have access to the domain controller servers.  If not, then ask your infrastructure team to do this and export the logs when you need them.

Enable auditing on domain controller and watch the event logs. You can export the event logs and import into Excel somehow too.

Enable a Group Policy on all the domain controllers to ensure this option is set.
Steps: On your domain controller open Start > Administration Tools > Domain Controller Security Policy
Expand Local polices and click on Audit Policy
Edit "Audit account management" and select "Success"
Do this to all your Domain Controllers or Apply a GPO
Watch the event log for the following Event IDs


Event IDs:
631 = Global Group Created
632 = Global Group Member Added
633 = Global Group Member Removed
634 = Global Group Deleted
641 = Global Group Changed

Group Policy
You can add this rule to your existing GPO, or create a new GPO for each rule and then apply to a security group.
Steps: Open the GPO editor
Create a new policy and give it a name
Expand Computer Configuration > Windows Settings > Local policies > Audit Policy
Select Audit account management
Check the boxes "Define these policy settings" and  "Success"
Apply this GPO all the Domain Controllers or use a security group
 
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462107
how the older file looks like?
is it csv or just plain text file which lists groups membership users?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33462163
Hi,

The first time also has to be done and then after that would be the reference.
So each time when run check the new file or files and get the report
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462217
awsome, already done that.
i created a vb script which monitor AD changes. 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,AccountDisabled,AccountExpirationDate,PasswordLastChanged,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 each line in curStateArr

		if Trim(line) <> "" and InStr(prevStateData, line) = 0 then

			matchLine = FindUserChangeDelta(line, prevStateArr)

			if matchLine <> "" then

				strResult = strResult & LogUserPropertiesChange(matchLine, line)

			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 = "meir.rivkin@odysii.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)

	arr1 = Split(matchLine, ",")

	arr2 = Split(line, ",")

	

	userPropsArr = Split(USER_PROPS, ",")

	strResult = "[" & arr1(0) & "]" & vbNewLine

	

	for i=1 to UBound(userPropsArr)

		

		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

			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

			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

				end if

			end if

		end if

	next 

	

	LogUserPropertiesChange = strResult & vbNewLine

	

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")



	ldaproot = "LDAP://" & strDNSDomain

	

	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

		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

0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462228
ROOT_OU is the the root from which to monitor AD changes.
USER_PROPS are the properties which are monitored.
if change occurred, am email is being sent (change ToAddress variable in NotifyByEmail sub)
0
 
LVL 11

Author Comment

by:bsharath
ID: 33462249
Thanks
Does the email go from outlook?
Does it only monitor Distribution groups?
Will it first log whats there and then if any change done and script run again intimate?
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462292

>>Does the email go from outlook?
yes

>>Does it only monitor Distribution groups?
all groups

>>Will it first log whats there and then if any change done and script run again intimate?
yes
0
 
LVL 11

Author Comment

by:bsharath
ID: 33462355
I get these headers

Name,AccountDisabled,AccountExpirationDate,PasswordLastChanged,GroupMembership

Only users are retrieved and no group membership is populated...
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462390
it's defently working.
after running the first time, take some user modify its memberOf list (add group or remove group).
run the script again and you should get email notification.
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33462458
after the 2nd run, u should see 3 files under c:\temp:
repository.log -> currently log
repository_comp.log -> previously log
result.log -> compare result

the content of result.log is being sent by email.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33462680
it works but i get this

PasswordLastChanged:
Before = 6/21/2010 1:23:57 PM
After = 8/18/2010 1:35:13 PM


I dont get the membership change details . May be need to give some time after the change.

It does not work for the Ou i mentioned it scans the whole domain
I gave the Ou path and the Full ou path with Domain name but no luck


0
 
LVL 11

Author Comment

by:bsharath
ID: 33462767
Only 1 file is created in temp
result.log
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33463138
i've updated the script
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,PasswordLastChanged,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 each line in curStateArr
		if Trim(line) <> "" and InStr(prevStateData, line) = 0 then
			matchLine = FindUserChangeDelta(line, prevStateArr)
			if matchLine <> "" then
				strResult = strResult & LogUserPropertiesChange(matchLine, line)
			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@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)
	arr1 = Split(matchLine, ",")
	arr2 = Split(line, ",")
	
	userPropsArr = Split(USER_PROPS, ",")
	strResult = "[" & arr1(0) & "]" & vbNewLine
	
	for i=1 to UBound(userPropsArr)
		
		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
			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
			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
				end if
			end if
		end if
	next 
	
	LogUserPropertiesChange = strResult & vbNewLine
	
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
		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33463753
I get this

---------------------------
Windows Script Host
---------------------------
Script:      C:\AD group chganges.vbs
Line:      228
Char:      2
Error:      Table does not exist.
Code:      80040E37
Source:       Provider

---------------------------
OK  
---------------------------
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33463783
what did u put as ROOT_OU?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33463827
I have this
const ROOT_OU = "OU=Yoho"

Yohio is the OU name
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33463848
if the ou is not under the AD root, u need to provide the whole ldap path.
for instance if the OU from which you wish to monitor is under OU called Site, then the ROOT_OU should be set like this:

const ROOT_OU  = "OU=Yoho,OU=Site"

0
 
LVL 11

Author Comment

by:bsharath
ID: 33464816
Thanks works
in the email i want to get just the user name and which OU group he was there and which is is not or vise vers
i dont want all the groups listed.

Can you tell me other than groups what else does it check
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33464873
if one of the following properties has changed, the email will be sent:
1. AccountDisabled
2. AccountExpirationDate
3. PasswordLastChanged
4. GroupMembership
5. if user was deleted, or new user was created
0
 
LVL 11

Author Comment

by:bsharath
ID: 33464887
When i run the 3rd time i get every user with a differnce
Say
Sharath
before = HR,CID,POD
After = POD,HR.CID

Even though they are same i get them as a differnce.

i want just the different user details

0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33464921
it's weird cause they should have the same order.
it's probably if u remove the first group and then add it back, so now it is the last one in the list.
i'll update the script.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33464945
But i get all my 3000+ users listed as different
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 42

Expert Comment

by:sedgwick
ID: 33464998
does it happens only regarding the GroupMembership property?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33465076
yes only group data
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33465180
done
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,PasswordLastChanged,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 each line in curStateArr
		if Trim(line) <> "" and InStr(prevStateData, line) = 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
			arrMembers1 = Split(arr1(i), ";")
			arrMembers2 = Split(arr2(i), ";")
			if UBound(arrMembers1) <> UBound(arrMembers2) then
				strLine = userPropsArr(i) & ": " & vbNewLine
				strLine = strLine & "Before = " & arr1(i) & vbNewLine
				strLine = strLine & "After = " & arr2(i) & vbNewLine
					
				strResult = strResult & strLine & vbNewLine
				changeResult = true
			else
				for each mem1 in arrMembers1
					found=false
					for each mem2 in arrMembers2
						if mem1 = mem2 then
							found=true
							exit for
						end if
					next
					if found = false then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = " & arr1(i) & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
						
						strResult = strResult & strLine & vbNewLine
						changeResult = true
						exit for
					end if
				next
			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
		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33465317
I get this

---------------------------
Windows Script Host
---------------------------
Script:      C:\AD group chganges.vbs
Line:      143
Char:      4
Error:      Subscript out of range: 'i'
Code:      800A0009
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33465395
that should do the trick
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,PasswordLastChanged,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 each line in curStateArr
		if Trim(line) <> "" and InStr(prevStateData, line) = 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)
		if UBound(arr1) >= i and UBound(arr2) >= i then
			if arr1(i) <> arr2(i) then
				'special handling for GroupMembership
				if userPropsArr(i) = "GroupMembership" then
					arrMembers1 = Split(arr1(i), ";")
					arrMembers2 = Split(arr2(i), ";")
					if UBound(arrMembers1) <> UBound(arrMembers2) then
						strLine = userPropsArr(i) & ": " & vbNewLine
						strLine = strLine & "Before = " & arr1(i) & vbNewLine
						strLine = strLine & "After = " & arr2(i) & vbNewLine
							
						strResult = strResult & strLine & vbNewLine
						changeResult = true
					else
						for each mem1 in arrMembers1
							found=false
							for each mem2 in arrMembers2
								if mem1 = mem2 then
									found=true
									exit for
								end if
							next
							if found = false then
								strLine = userPropsArr(i) & ": " & vbNewLine
								strLine = strLine & "Before = " & arr1(i) & vbNewLine
								strLine = strLine & "After = " & arr2(i) & vbNewLine
								
								strResult = strResult & strLine & vbNewLine
								changeResult = true
								exit for
							end if
						next
					end if
				else
					strLine = userPropsArr(i) & ": " & vbNewLine
					strLine = strLine & "Before = " & arr1(i) & vbNewLine
					strLine = strLine & "After = " & arr2(i) & vbNewLine
					
					strResult = strResult & strLine & vbNewLine
					changeResult = true
				end if
			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
	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
		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33466574
Thanks all fine

Can i get just the user name and what group was the exact change . rather than all groups please.
And just the group name without the Ou's and Dn's
0
 
LVL 11

Author Comment

by:bsharath
ID: 33466583
What else can we Audit by this script. If you can give me some ideas .Shall post a related Q... As this is extremely useful for me...
0
 
LVL 11

Author Comment

by:bsharath
ID: 33472458
sedgwick
Can we remove the password change monitoring. because it shows changes made by users themselves and thats not of great use to me...
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33472728
hope i got it right
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,PasswordLastChanged,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



	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

		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33472851
I get this

---------------------------
Windows Script Host
---------------------------
Script:      C:\AD group chganges.vbs
Line:      248
Char:      3
Error:      Type mismatch: 'objLog.WriteLine'
Code:      800A000D
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33472916
i can't find the problem, can u post the exact script you use?
0
 
LVL 11

Author Comment

by:bsharath
ID: 33472929
Here is the code
const ROOT_OU = "OU=Cai,OU=Ia,OU=Offices"



const REPOSITORY_FILE = "c:\groups\repository.log"

const REPOSITORY_COMPARE_FILE = "c:\groups\repository_comp.log"

const RESULT_FILE = "c:\temp\result.log"

const USER_PROPS = "Name,AccountDisabled,AccountExpirationDate,PasswordLastChanged,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 = "sharath@plc.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



	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

		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

0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33472976
try this
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,PasswordLastChanged,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
		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33473812
I tried multiple times but no complete box appears or no email. The files are created and the script completes though
0
 
LVL 11

Author Comment

by:bsharath
ID: 33473818
I checked this path
C:\temp\result.log
I could see the change i expected. But no email arrived..
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33473828
i removed the "Complete" box and commented the email function by accident for testing purposes.

here's the same script with them back on
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,PasswordLastChanged,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 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

		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

0
 
LVL 11

Author Comment

by:bsharath
ID: 33473877
I still get this. Is this capturing password change on the clients themselves or the administrator changing the password from Domain controller?

If it collects all please remove this
PasswordLastChanged:

Groups when removed i get the results as added and when added as removed
0
 
LVL 42

Accepted Solution

by:
sedgwick earned 500 total points
ID: 33473902

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,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

		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

0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33473905
i removed the passwordLastChange property, add fixed the groups status
0
 
LVL 11

Author Comment

by:bsharath
ID: 33474388
Works perfect
Can we have the email to trigger when outlook is closed?

At present

Group membership
Disabled
Created new
Deleted

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

Let me know shall post a related Q...
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33474486
please post related Q in regards to the additions.

cheers, glad it worked for you.
0
 
LVL 11

Author Comment

by:bsharath
ID: 33474517
Thanks a lot. This was one aweome help...
Posted a related Q...
http://www.experts-exchange.com/Programming/Languages/Q_26414412.html
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

This is a PowerShell web interface I use to manage some task as a network administrator. Clicking an action button on the left frame will display a form in the middle frame to input some data in textboxes, process this data in PowerShell and display…
Create and license users in Office 365 in bulk based on a CSV file. A step-by-step guide with PowerShell script examples.
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
This video teaches viewers about errors in exception handling.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now