Anyone can give me a script that checks every Distribution group each day once and gets the differences to a file.?
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
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
how the older file looks like?
is it csv or just plain text file which lists groups membership users?
is it csv or just plain text file which lists groups membership users?
ASKER
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
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
awsome, already done that.
i created a vb script which monitor AD changes. check it out.
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
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)
USER_PROPS are the properties which are monitored.
if change occurred, am email is being sent (change ToAddress variable in NotifyByEmail sub)
ASKER
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?
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?
>>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
ASKER
I get these headers
Name,AccountDisabled,Accou
Only users are retrieved and no group membership is populated...
Name,AccountDisabled,Accou
Only users are retrieved and no group membership is populated...
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.
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.
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.
repository.log -> currently log
repository_comp.log -> previously log
result.log -> compare result
the content of result.log is being sent by email.
ASKER
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
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
ASKER
Only 1 file is created in temp
result.log
result.log
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
ASKER
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
--------------------------
--------------------------
Windows Script Host
--------------------------
Script: C:\AD group chganges.vbs
Line: 228
Char: 2
Error: Table does not exist.
Code: 80040E37
Source: Provider
--------------------------
OK
--------------------------
what did u put as ROOT_OU?
ASKER
I have this
const ROOT_OU = "OU=Yoho"
Yohio is the OU name
const ROOT_OU = "OU=Yoho"
Yohio is the OU name
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"
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"
ASKER
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
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
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
1. AccountDisabled
2. AccountExpirationDate
3. PasswordLastChanged
4. GroupMembership
5. if user was deleted, or new user was created
ASKER
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
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
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.
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.
ASKER
But i get all my 3000+ users listed as different
does it happens only regarding the GroupMembership property?
ASKER
yes only group data
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
ASKER
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
--------------------------
--------------------------
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
--------------------------
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
ASKER
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
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
ASKER
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...
ASKER
sedgwick
Can we remove the password change monitoring. because it shows changes made by users themselves and thats not of great use to me...
Can we remove the password change monitoring. because it shows changes made by users themselves and thats not of great use to me...
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 subASKER
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
--------------------------
--------------------------
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
--------------------------
i can't find the problem, can u post the exact script you use?
ASKER
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
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
ASKER
I tried multiple times but no complete box appears or no email. The files are created and the script completes though
ASKER
I checked this path
C:\temp\result.log
I could see the change i expected. But no email arrived..
C:\temp\result.log
I could see the change i expected. But no email arrived..
i removed the "Complete" box and commented the email function by accident for testing purposes.
here's the same script with them back on
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 subASKER
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
If it collects all please remove this
PasswordLastChanged:
Groups when removed i get the results as added and when added as removed
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
i removed the passwordLastChange property, add fixed the groups status
ASKER
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...
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...
please post related Q in regards to the additions.
cheers, glad it worked for you.
cheers, glad it worked for you.
ASKER
Thanks a lot. This was one aweome help...
Posted a related Q...
https://www.experts-exchange.com/questions/26414412/Script-to-audit-AD.html
Posted a related Q...
https://www.experts-exchange.com/questions/26414412/Script-to-audit-AD.html
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