First up this script is not designed to audit who is making changes to permissions in Exchange. Tracking who is making changes to Active Directory objects in a distributed Network with multiple DC’s is not an easy thing to do my advice is if you need to do this hit the Google trail or look at third party products.
What this script does is give visibility of permission changes to users mailboxes/accounts made via ADUC via Exchange Mailbox Rights and Send-As/Receive as rights on the user object. It basically works by creating an XML file that is a snapshot of the current explicitly added rights on an Exchange Mailbox and any ACE’s that grant the extended rights for send and receive as. The next time the script runs it takes another snapshot of the rights and then using a couple of Scripting Dictionary object s does a comparison and finds Add ,Deletes or Permission changes and then produces a HTML report of these changes. To extend the usefulness of this script I’ve created a version that creates a WMI watcher on any ds_user modification events on a Domain controller. When a modification is detected it uses the IADstools to check the metadata in the directory to see if any of the security attributes have been modified recently an if so then does a snapshot compare to see if picks up any ACE’s changes. Any ACE changes that are found are then emailed to an emailaddress as a Htmlreport. This starts to get close to real-time reporting of changes. Now in a large network maybe you don’t want to be doing this because of the number of ds_user modification events you might receive could possible have a detrimental performance effect on the DC is question (eg don’t know really haven’t tested it)
The script itself is split up into a few different sections the first section does file management. To maintain an audit path every snap that is taken is stored so when the script has been run more then 2 times the 1st snap that is taken is then copied to an archive directory. The second section of the script handles opening, searching and comparing the different snapshots that are taken. I’ve used the Microsoft Dom object to do this although not the easiest thing in the world to use it is good for this type of data retrieval. The last section of the script is dedicated to writing the snapshot because the format of the xml was pretty simple I’ve just used the FSO item to write the XML manually.
To use the script you should first check the following 4 variables and make sure the directories that variable refers to exists.
csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"
I’ve created two versions of the script the first is a simple version that is designed to be run from a scheduler and just looks for changes against the last snap every time its run and then writes a HTML report to the configured directory if any changes are detected. The second version is WMI watcher script that watches for changes to the ds_user class on the server and then emails a configured address with a report of any changes.
For this version of the script there are three variables that need to be configured first for email functionality section.
SenderAddress = "sender@domain.com"
RecieverAddress = "reciever@domain.com"
EmailServername = “servername”
The script itself takes one commandline parameter which is the netbios name of the DC you want to run it against. The WMI version also requires that you have the Windows 2000/3 Support Tools installed so you will have the iadstools.dll registered. The other things to be aware of is there a 15 minute change detection period depending on the replication latency in your network you may need to make this greater.
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) < 15 Then fsnap = 1
I’ve put a downloadable copy of the script here the wmi version of the script looks like
Const RIGHT_DS_DELETE = &H10000
Const RIGHT_DS_READ = &H20000
Const RIGHT_DS_CHANGE = &H40000
Const RIGHT_DS_TAKE_OWNERSHIP = &H80000
Const RIGHT_DS_MAILBOX_OWNER = &H1
Const RIGHT_DS_SEND_AS = &H2
Const RIGHT_DS_PRIMARY_OWNER = &H4
csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"
SenderAddress = "sender@domain.com"
RecieverAddress = "receiver@domain.com"
EmailServername = "mailserver"
strComputer = wscript.arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
set objIadsTools = CreateObject("IADsTools.DCFunctions")
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/directory/LDAP")
strWQL = "SELECT * " & _
"FROM __InstanceModificationEvent " & _
"WITHIN 2 " & _
"WHERE TargetInstance ISA 'ds_user'"
WScript.Echo "Waiting User Modifications"
Set objEventSource = objWMIService.ExecNotificationQuery(strWQL)
Do
Set objEventObject = objEventSource.NextEvent()
WScript.Echo "User Modified : " & objEventObject.TargetInstance.DS_displayName
Call getUserData(strComputer,objEventObject.TargetInstance.DS_distinguishedName)
Loop
sub getUserData(dcDomainController,dnUserDN)
fsnap = 0
intRes = objIadsTools.GetMetaData(Cstr(dcDomainController),Cstr(dnUserDN),0)
if intRes = -1 then
Wscript.Echo objIadsTools.LastErrorText
WScript.Quit
end if
wscript.echo "User" & dnUserDN
wscript.echo Now()
for count = 1 to intRes
Select Case objIadsTools.MetaDataName(count)
Case "nTSecurityDescriptor" wscript.echo "nTSecurityDescriptor LastModified : "
& objIadsTools.MetaDataLastWriteTime(count)_
& " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
Case "msExchMailboxSecurityDescriptor" wscript.echo "msExchMailboxSecurityDescriptor
Last Modified : " _
& objIadsTools.MetaDataLastWriteTime(count) & " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
End Select
Next
If fsnap = 1 Then CheckACLs
end Sub
Sub CheckACLs()
rrRightReport = 0
If fso.FileExists(csCurrentSnapFileName) Then
wscript.echo "Snap Exists"
If fso.FileExists(psPreviousSnapFileName) Then
fso.deletefile(psPreviousSnapFileName)
fso.movefile csCurrentSnapFileName, psPreviousSnapFileName
set xdXmlDocument = CreateObject("Microsoft.XMLDOM")
xdXmlDocument.async="false"
xdXmlDocument.load(psPreviousSnapFileName)
Set xnSnaptime = xdXmlDocument.selectNodes("//SnappedACLS")
For Each exSnap In xnSnaptime
oldSnap = exSnap.attributes.getNamedItem("SnapDate").nodeValue
wscript.echo "Snap Taken : " & oldSnap
takesnap
afFileName = adArchieveDirectory &
Replace(Replace(Replace(exSnap.attributes.getNamedItem("SnapDate").nodeValue,":",""),",",""),"
","") & ".xml"
wscript.echo "Archiving Old Snap to : " & afFileName
fso.copyfile psPreviousSnapFileName, afFileName
Next
set xdXmlDocument1 = CreateObject("Microsoft.XMLDOM")
xdXmlDocument1.async="false"
xdXmlDocument1.load(csCurrentSnapFileName)
Set ckCurrentPerms = CreateObject("Scripting.Dictionary")
Set pkPreviousPerms = CreateObject("Scripting.Dictionary")
Set xnCurrentPermsUsers = xdXmlDocument1.selectNodes("//User")
For Each xnUserNode In xnCurrentPermsUsers
unUserName = xnUserNode.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs In xnUserNode.ChildNodes
ckCurrentACL = unUserName & "|-|" &
caACLs.attributes.getNamedItem("User").nodeValue
ckCurrentPerms.add ckCurrentACL,
caACLs.attributes.getNamedItem("Right").nodeValue
Next
Next
Set xnPrevPermsUsers = xdXmlDocument.selectNodes("//User")
For Each xnUserNode1 In xnPrevPermsUsers
unUserName1 = xnUserNode1.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs1 In xnUserNode1.ChildNodes
pkPrevACL = unUserName1 & "|-|" &
caACLs1.attributes.getNamedItem("User").nodeValue
pkPreviousPerms.add pkPrevACL,
caACLs1.attributes.getNamedItem("Right").nodeValue
rem Do a Check for Any Deleted or Changed Permisssions
If ckCurrentPerms.exists(pkPrevACL) Then
If ckCurrentPerms(pkPrevACL) <>
caACLs1.attributes.getNamedItem("Right").nodeValue Then
rrRightReport = 1
wscript.echo "Found Changed ACL "
wscript.echo "Old Rights : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
wscript.echo "New Rights : " & pkPrevACL & " " & ckCurrentPerms(pkPrevACL)
hrmodHtmlReport = hrmodHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">Old Rights: " & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & " </font></td>" &
vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">New Rights: " _
& caACLs1.attributes.getNamedItem("User").nodeValue & " " &
ckCurrentPerms(pkPrevACL) & " </font></td></tr>" & vbcrlf
End if
Else
rrRightReport = 1
hrDelHtmlReport = hrDelHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrDelHtmlReport = hrDelHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & "
</font></td></tr>" & vbcrlf
Wscript.echo "Found Deleted ACL : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
End if
Next
Next
rem Do forward check of ACL's
For Each dkCurrenPermKey In ckCurrentPerms.keys
If Not pkPreviousPerms.exists(dkCurrenPermKey) Then
rrRightReport = 1
dknewpermarry = Split(dkCurrenPermKey,"|-|")
hrnewHtmlReport = hrnewHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & dknewpermarry(0) & " </font></td>" & vbcrlf
hrnewHtmlReport = hrnewHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & dknewpermarry(1) _
& " " & ckCurrentPerms(dkCurrenPermKey) & " </font></td></tr>" & vbcrlf
Wscript.echo "Found new ACL : " & dkCurrenPermKey & " " &
ckCurrentPerms(dkCurrenPermKey)
End if
next
Else
wscript.echo "No current permissions snap exists taking snap"
Call TakeSnap
End If
If rrRightReport = 1 Then
wscript.echo "Writing Report"
hrHtmlReport = "<html><body>" & vbcrlf
NewSnapDate = WeekdayName(weekday(now),3) & ", " & day(now()) & " " &
Monthname(month(now()),3) & " " & year(now()) & " " & formatdatetime(now(),4) &
":00"
hrHtmlReport = hrHtmlReport & "<p><font size=""4"" face=""Arial Black""
color=""#008000"">Change To Mailbox Rights Report for Snaps Taken Between -
</font>" & oldSnap & " and "_
& NewSnapDate & "</font></p>" & vbcrlf
If hrnewHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Added</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrnewHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrmodHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Modified</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrmodHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrDelHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Deleted</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrDelHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
hrHtmlReport = hrHtmlReport & "</body></html>" & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = SenderAddress
objEmail.To = RecieverAddress
objEmail.Subject = "ACL Change Report"
objEmail.htmlbody = hrHtmlReport
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= EmailServername
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
objEmail.Configuration.Fields.Update
objEmail.Send
wscript.echo "Email Sent"
End If
End Sub
Sub TakeSnap
set wfile = fso.opentextfile(csCurrentSnapFileName,2,true)
wfile.writeline("<?xml version=""1.0""?>")
wfile.writeline("<SnappedACLS SnapDate=""" & WeekdayName(weekday(now),3) & ", "
& day(now()) & " " & Monthname(month(now()),3) & " " & year(now()) & " " &
formatdatetime(now(),4) & ":00" & """>")
Set objSystemInfo = CreateObject("ADSystemInfo")
strdname = objSystemInfo.DomainShortName
set conn1 = createobject("ADODB.Connection")
strConnString = "Data Provider=NONE; Provider=MSDataShape"
conn1.Open strConnString
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Query = "<LDAP://" & strNameingContext & ">;(&(&(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))
))));samaccountname,displayname,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = Query
Com.Properties("Page Size") = 1000
Set Rs = Com.Execute
While Not Rs.EOF
dn = "LDAP://" & replace(rs.Fields("distinguishedName").Value,"/","\/")
set objuser = getobject(dn)
Set oSecurityDescriptor = objuser.Get("msExchMailboxSecurityDescriptor")
Set oUserSecurityDescriptor = objuser.Get("ntSecurityDescriptor")
Set oUserdacl = oUserSecurityDescriptor.DiscretionaryAcl
Set oUserace = CreateObject("AccessControlEntry")
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject("AccessControlEntry")
fwFirstWrite = 0
For Each ace In dacl
if ace.AceFlags <> 18 then
if ace.Trustee <> "NT AUTHORITY\SELF" Then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End if
wfile.writeline("<ACE User=""" & ace.Trustee & """ Right=""" &
getRights(ace.AccessMask) & """></ACE>")
end if
end if
Next
For Each oUserace In oUserdacl
if lcase(oUserace.ObjectType) = "{ab721a54-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 Then
if fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exsa-" & """ Right=""Send
As""></ACE>")
end if
end if
if lcase(oUserace.ObjectType) = "{ab721a56-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exra-" & """
Right=""Recieve As""></ACE>")
end if
end if
Next
If fwFirstWrite = 1 then
wfile.writeline("</User>")
End if
rs.movenext
Wend
wfile.writeline("</SnappedACLS>")
wscript.echo "New Snap Taken"
End Sub
Function getRights(hvHexValue)
If (hvHexValue And RIGHT_DS_SEND_AS) Then
getRights = "Send As"
End If
If (hvHexValue And RIGHT_DS_CHANGE) Then
getRights = "Modify user attributes"
End If
If (hvHexValue And RIGHT_DS_DELETE) Then
getRights = "Delete mailbox store"
End If
If (hvHexValue And RIGHT_DS_READ) Then
getRights = "Read permissions"
End If
If (hvHexValue And RIGHT_DS_TAKE_OWNERSHIP) Then
getRights = "Take Ownership"
End If
If (hvHexValue And RIGHT_DS_MAILBOX_OWNER) Then
getRights = "Mailbox Owner"
End If
If (hvHexValue And RIGHT_DS_PRIMARY_OWNER) Then
getRights = "Mailbox Primary Owner"
End If
End Function
Function reformatdate(dtDatetoTransform)
dtarry = split(dtDatetoTransform,"/")
tmArry = split(dtarry(2)," ")
rdReturnDate = formatdatetime(dateserial(tmArry(0),dtarry(0),dtarry(1)) & " " &
tmArry(1) & " " & tmArry(2))
reformatdate = rdReturnDate
End function
What this script does is give visibility of permission changes to users mailboxes/accounts made via ADUC via Exchange Mailbox Rights and Send-As/Receive as rights on the user object. It basically works by creating an XML file that is a snapshot of the current explicitly added rights on an Exchange Mailbox and any ACE’s that grant the extended rights for send and receive as. The next time the script runs it takes another snapshot of the rights and then using a couple of Scripting Dictionary object s does a comparison and finds Add ,Deletes or Permission changes and then produces a HTML report of these changes. To extend the usefulness of this script I’ve created a version that creates a WMI watcher on any ds_user modification events on a Domain controller. When a modification is detected it uses the IADstools to check the metadata in the directory to see if any of the security attributes have been modified recently an if so then does a snapshot compare to see if picks up any ACE’s changes. Any ACE changes that are found are then emailed to an emailaddress as a Htmlreport. This starts to get close to real-time reporting of changes. Now in a large network maybe you don’t want to be doing this because of the number of ds_user modification events you might receive could possible have a detrimental performance effect on the DC is question (eg don’t know really haven’t tested it)
The script itself is split up into a few different sections the first section does file management. To maintain an audit path every snap that is taken is stored so when the script has been run more then 2 times the 1st snap that is taken is then copied to an archive directory. The second section of the script handles opening, searching and comparing the different snapshots that are taken. I’ve used the Microsoft Dom object to do this although not the easiest thing in the world to use it is good for this type of data retrieval. The last section of the script is dedicated to writing the snapshot because the format of the xml was pretty simple I’ve just used the FSO item to write the XML manually.
To use the script you should first check the following 4 variables and make sure the directories that variable refers to exists.
csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"
I’ve created two versions of the script the first is a simple version that is designed to be run from a scheduler and just looks for changes against the last snap every time its run and then writes a HTML report to the configured directory if any changes are detected. The second version is WMI watcher script that watches for changes to the ds_user class on the server and then emails a configured address with a report of any changes.
For this version of the script there are three variables that need to be configured first for email functionality section.
SenderAddress = "sender@domain.com"
RecieverAddress = "reciever@domain.com"
EmailServername = “servername”
The script itself takes one commandline parameter which is the netbios name of the DC you want to run it against. The WMI version also requires that you have the Windows 2000/3 Support Tools installed so you will have the iadstools.dll registered. The other things to be aware of is there a 15 minute change detection period depending on the replication latency in your network you may need to make this greater.
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) < 15 Then fsnap = 1
I’ve put a downloadable copy of the script here the wmi version of the script looks like
Const RIGHT_DS_DELETE = &H10000
Const RIGHT_DS_READ = &H20000
Const RIGHT_DS_CHANGE = &H40000
Const RIGHT_DS_TAKE_OWNERSHIP = &H80000
Const RIGHT_DS_MAILBOX_OWNER = &H1
Const RIGHT_DS_SEND_AS = &H2
Const RIGHT_DS_PRIMARY_OWNER = &H4
csCurrentSnapFileName = "c:\temp\currentSnap.xml"
psPreviousSnapFileName = "c:\temp\prevSnap.xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACLChangeReport-"
SenderAddress = "sender@domain.com"
RecieverAddress = "receiver@domain.com"
EmailServername = "mailserver"
strComputer = wscript.arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
set objIadsTools = CreateObject("IADsTools.DCFunctions")
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/directory/LDAP")
strWQL = "SELECT * " & _
"FROM __InstanceModificationEvent " & _
"WITHIN 2 " & _
"WHERE TargetInstance ISA 'ds_user'"
WScript.Echo "Waiting User Modifications"
Set objEventSource = objWMIService.ExecNotificationQuery(strWQL)
Do
Set objEventObject = objEventSource.NextEvent()
WScript.Echo "User Modified : " & objEventObject.TargetInstance.DS_displayName
Call getUserData(strComputer,objEventObject.TargetInstance.DS_distinguishedName)
Loop
sub getUserData(dcDomainController,dnUserDN)
fsnap = 0
intRes = objIadsTools.GetMetaData(Cstr(dcDomainController),Cstr(dnUserDN),0)
if intRes = -1 then
Wscript.Echo objIadsTools.LastErrorText
WScript.Quit
end if
wscript.echo "User" & dnUserDN
wscript.echo Now()
for count = 1 to intRes
Select Case objIadsTools.MetaDataName(count)
Case "nTSecurityDescriptor" wscript.echo "nTSecurityDescriptor LastModified : "
& objIadsTools.MetaDataLastWriteTime(count)_
& " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
Case "msExchMailboxSecurityDescriptor" wscript.echo "msExchMailboxSecurityDescriptor
Last Modified : " _
& objIadsTools.MetaDataLastWriteTime(count) & " Time Diff : " &
DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now())
If DateDiff("n",reformatdate(objIadsTools.MetaDataLastWriteTime(count)),Now()) <
15 Then fsnap = 1
End Select
Next
If fsnap = 1 Then CheckACLs
end Sub
Sub CheckACLs()
rrRightReport = 0
If fso.FileExists(csCurrentSnapFileName) Then
wscript.echo "Snap Exists"
If fso.FileExists(psPreviousSnapFileName) Then
fso.deletefile(psPreviousSnapFileName)
fso.movefile csCurrentSnapFileName, psPreviousSnapFileName
set xdXmlDocument = CreateObject("Microsoft.XMLDOM")
xdXmlDocument.async="false"
xdXmlDocument.load(psPreviousSnapFileName)
Set xnSnaptime = xdXmlDocument.selectNodes("//SnappedACLS")
For Each exSnap In xnSnaptime
oldSnap = exSnap.attributes.getNamedItem("SnapDate").nodeValue
wscript.echo "Snap Taken : " & oldSnap
takesnap
afFileName = adArchieveDirectory &
Replace(Replace(Replace(exSnap.attributes.getNamedItem("SnapDate").nodeValue,":",""),",",""),"
","") & ".xml"
wscript.echo "Archiving Old Snap to : " & afFileName
fso.copyfile psPreviousSnapFileName, afFileName
Next
set xdXmlDocument1 = CreateObject("Microsoft.XMLDOM")
xdXmlDocument1.async="false"
xdXmlDocument1.load(csCurrentSnapFileName)
Set ckCurrentPerms = CreateObject("Scripting.Dictionary")
Set pkPreviousPerms = CreateObject("Scripting.Dictionary")
Set xnCurrentPermsUsers = xdXmlDocument1.selectNodes("//User")
For Each xnUserNode In xnCurrentPermsUsers
unUserName = xnUserNode.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs In xnUserNode.ChildNodes
ckCurrentACL = unUserName & "|-|" &
caACLs.attributes.getNamedItem("User").nodeValue
ckCurrentPerms.add ckCurrentACL,
caACLs.attributes.getNamedItem("Right").nodeValue
Next
Next
Set xnPrevPermsUsers = xdXmlDocument.selectNodes("//User")
For Each xnUserNode1 In xnPrevPermsUsers
unUserName1 = xnUserNode1.attributes.getNamedItem("SamaccountName").nodeValue
For Each caACLs1 In xnUserNode1.ChildNodes
pkPrevACL = unUserName1 & "|-|" &
caACLs1.attributes.getNamedItem("User").nodeValue
pkPreviousPerms.add pkPrevACL,
caACLs1.attributes.getNamedItem("Right").nodeValue
rem Do a Check for Any Deleted or Changed Permisssions
If ckCurrentPerms.exists(pkPrevACL) Then
If ckCurrentPerms(pkPrevACL) <>
caACLs1.attributes.getNamedItem("Right").nodeValue Then
rrRightReport = 1
wscript.echo "Found Changed ACL "
wscript.echo "Old Rights : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
wscript.echo "New Rights : " & pkPrevACL & " " & ckCurrentPerms(pkPrevACL)
hrmodHtmlReport = hrmodHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">Old Rights: " & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & " </font></td>" &
vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">New Rights: " _
& caACLs1.attributes.getNamedItem("User").nodeValue & " " &
ckCurrentPerms(pkPrevACL) & " </font></td></tr>" & vbcrlf
End if
Else
rrRightReport = 1
hrDelHtmlReport = hrDelHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & unUserName1 & " </font></td>" & vbcrlf
hrDelHtmlReport = hrDelHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & caACLs1.attributes.getNamedItem("User").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & "
</font></td></tr>" & vbcrlf
Wscript.echo "Found Deleted ACL : " & pkPrevACL & " " &
caACLs1.attributes.getNamedItem("Right").nodeValue
End if
Next
Next
rem Do forward check of ACL's
For Each dkCurrenPermKey In ckCurrentPerms.keys
If Not pkPreviousPerms.exists(dkCurrenPermKey) Then
rrRightReport = 1
dknewpermarry = Split(dkCurrenPermKey,"|-|")
hrnewHtmlReport = hrnewHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & dknewpermarry(0) & " </font></td>" & vbcrlf
hrnewHtmlReport = hrnewHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & dknewpermarry(1) _
& " " & ckCurrentPerms(dkCurrenPermKey) & " </font></td></tr>" & vbcrlf
Wscript.echo "Found new ACL : " & dkCurrenPermKey & " " &
ckCurrentPerms(dkCurrenPermKey)
End if
next
Else
wscript.echo "No current permissions snap exists taking snap"
Call TakeSnap
End If
If rrRightReport = 1 Then
wscript.echo "Writing Report"
hrHtmlReport = "<html><body>" & vbcrlf
NewSnapDate = WeekdayName(weekday(now),3) & ", " & day(now()) & " " &
Monthname(month(now()),3) & " " & year(now()) & " " & formatdatetime(now(),4) &
":00"
hrHtmlReport = hrHtmlReport & "<p><font size=""4"" face=""Arial Black""
color=""#008000"">Change To Mailbox Rights Report for Snaps Taken Between -
</font>" & oldSnap & " and "_
& NewSnapDate & "</font></p>" & vbcrlf
If hrnewHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Added</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrnewHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrmodHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Modified</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrmodHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
If hrDelHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">ACL's Deleted</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport &
Replace(Replace(hrDelHtmlReport,"-exra-",""),"-exsa-","") & "</table>"
End If
hrHtmlReport = hrHtmlReport & "</body></html>" & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = SenderAddress
objEmail.To = RecieverAddress
objEmail.Subject = "ACL Change Report"
objEmail.htmlbody = hrHtmlReport
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= EmailServername
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
objEmail.Configuration.Fields.Update
objEmail.Send
wscript.echo "Email Sent"
End If
End Sub
Sub TakeSnap
set wfile = fso.opentextfile(csCurrentSnapFileName,2,true)
wfile.writeline("<?xml version=""1.0""?>")
wfile.writeline("<SnappedACLS SnapDate=""" & WeekdayName(weekday(now),3) & ", "
& day(now()) & " " & Monthname(month(now()),3) & " " & year(now()) & " " &
formatdatetime(now(),4) & ":00" & """>")
Set objSystemInfo = CreateObject("ADSystemInfo")
strdname = objSystemInfo.DomainShortName
set conn1 = createobject("ADODB.Connection")
strConnString = "Data Provider=NONE; Provider=MSDataShape"
conn1.Open strConnString
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Query = "<LDAP://" & strNameingContext & ">;(&(&(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))
))));samaccountname,displayname,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = Query
Com.Properties("Page Size") = 1000
Set Rs = Com.Execute
While Not Rs.EOF
dn = "LDAP://" & replace(rs.Fields("distinguishedName").Value,"/","\/")
set objuser = getobject(dn)
Set oSecurityDescriptor = objuser.Get("msExchMailboxSecurityDescriptor")
Set oUserSecurityDescriptor = objuser.Get("ntSecurityDescriptor")
Set oUserdacl = oUserSecurityDescriptor.DiscretionaryAcl
Set oUserace = CreateObject("AccessControlEntry")
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject("AccessControlEntry")
fwFirstWrite = 0
For Each ace In dacl
if ace.AceFlags <> 18 then
if ace.Trustee <> "NT AUTHORITY\SELF" Then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End if
wfile.writeline("<ACE User=""" & ace.Trustee & """ Right=""" &
getRights(ace.AccessMask) & """></ACE>")
end if
end if
Next
For Each oUserace In oUserdacl
if lcase(oUserace.ObjectType) = "{ab721a54-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 Then
if fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exsa-" & """ Right=""Send
As""></ACE>")
end if
end if
if lcase(oUserace.ObjectType) = "{ab721a56-1e2f-11d0-9819-00aa0040529b}" and
oUserace.AceType = 5 Then
if oUserace.Trustee <> "NT AUTHORITY\SELF" and oUserace.AceFlags <> 6 then
If fwFirstWrite = 0 Then
wfile.writeline(" <User SamaccountName=""" & rs.fields("samaccountname") &
""">")
fwFirstWrite = 1
End If
wfile.writeline("<ACE User=""" & oUserace.Trustee & "-exra-" & """
Right=""Recieve As""></ACE>")
end if
end if
Next
If fwFirstWrite = 1 then
wfile.writeline("</User>")
End if
rs.movenext
Wend
wfile.writeline("</SnappedACLS>")
wscript.echo "New Snap Taken"
End Sub
Function getRights(hvHexValue)
If (hvHexValue And RIGHT_DS_SEND_AS) Then
getRights = "Send As"
End If
If (hvHexValue And RIGHT_DS_CHANGE) Then
getRights = "Modify user attributes"
End If
If (hvHexValue And RIGHT_DS_DELETE) Then
getRights = "Delete mailbox store"
End If
If (hvHexValue And RIGHT_DS_READ) Then
getRights = "Read permissions"
End If
If (hvHexValue And RIGHT_DS_TAKE_OWNERSHIP) Then
getRights = "Take Ownership"
End If
If (hvHexValue And RIGHT_DS_MAILBOX_OWNER) Then
getRights = "Mailbox Owner"
End If
If (hvHexValue And RIGHT_DS_PRIMARY_OWNER) Then
getRights = "Mailbox Primary Owner"
End If
End Function
Function reformatdate(dtDatetoTransform)
dtarry = split(dtDatetoTransform,"/")
tmArry = split(dtarry(2)," ")
rdReturnDate = formatdatetime(dateserial(tmArry(0),dtarry(0),dtarry(1)) & " " &
tmArry(1) & " " & tmArry(2))
reformatdate = rdReturnDate
End function