Wednesday, May 23, 2007

Snapshotting and Auditing changes to Mailbox folder delegation rights and Changes to Mailbox Rules

Somebody left a comment last week about displaying changes to rules and mailbox acls via an RSS feed. While this is possible it got me to thinking about maybe using a snapshot technique to track changes to delegated mailbox folder ACLS and Rules. What I mean by this is that you take an initial snapshot of the current ACL’s and Rules of a mailbox and then at sometime in the future you take another snapshot and you then compare this to the original snap and report on any changes. The cool thing about this (well what I like about it) is that this can then start to answer of number of questions for you like.

Getting Notification when a user adds a forwarding rule to their mailbox – (you can then verify this against whatever email policy you have any make sure it complies)

Get Notifcation when a user changes a forwarding rule on their mailbox (eg address changes)

Report when a user delegates any section of the mailbox and find and fix users that have delegated there mailboxes incorrectly (eg giving everybody full access to their mailbox when the just wanted to allows a few people to see their calendars). Also catch rouge admins,helpdesk people who are changing delegation setting incorrectly or in a destructive manner.

Give you a view of how people are using Delegation and rules over a period of time this might allow you see how affective specific training in Outlook was by seeing how many people created new rules and delegated their calendars after a training course. (Try pegging the trainer’s fee to this and watch them squirm)

And this list goes on you just need to be a little creative.

I’ve written 2 versions of this script the first is a CDO version that requires that you also have the ACL.dll and Rule.dll installed to be able to access and decoded the Folder ACL’s and Rules. The other version is a RDO version (RDO is part of Redemption) because RDO has its own ACL and Rule libraries you don’t need any separate dll’s and RDO is also not encumbered by security Popups that can happen with CDO 1.2 depending on which version your using.

The scripts works similar to my Ad Mailbox rights Snapshot script it creates a XML file using some simple Filesystem object code for all the folder permissions and rules using MAPI to access the mailbox folders ACL’s and Rules. The script only records the ACLS on the Root folders of a mailbox because these are generally the folders that users will delegate with Outlook. Once one snapshot has been taken the next time the script runs it creates a new snapshot and then opens both of these XML files at the same time and then using 2 scripting dictionary objects it compares any changes to the permissions or the rules actions or arguments. If any changes are detected it then creates a HTML file based report and saves it to the reports directory. To keep an audit trail all older snapshots are archived to a snaparchive directory.

With the rule change detection logic currently the script will detect changes such as a folder change in a move or copy rule and an address change in a forward or delegate rule. It won’t detect or report on Logic changes within a rule eg if somebody changes the from address of a move rule etc.

The script takes two command line parameters at runtime which is the ServerName and Mailbox you want to run the script against. Eg to run the script you need to use a line such as

Cscript acl-rule-snapv2.vbs yourservername yourmailbox

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-" & mbMailboxName & ".xml"
psPreviousSnapFileName = "c:\temp\prevSnap-" & mbMailboxName & ".xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACL-Rule-ChangeReport-" & mbMailboxName

As you can see the name of the snap is prefixed with the username to allow the script to be run against multiple mailboxes. If you do want to run the script against multiple mailboxes you need to either come up with a simple batch file and include the users you want the script to run on or create another script that includes a ADSI query to get all the users you want reported on. I’ve included a script like this in the download that accepts one commandline parameter which is the mailserver name you want to query against it will then query Active Directory for all the users that are on this server and visible in the GAL and then run the script against these mailboxes. (This script is called the headscript in the download). Because the report it produces is in HTML if you want to receive emails of any of the changes it detects you can easily substitute some code and use the HTML as the body of a email

The CDO 1.2 version of the script requires the ACL.dll which you can download from here and Rule.dll which you can download from here. The RDO version requires Redemption

I’ve put a downloadable copy of all the scripts here the CDO version looks like

snServername = wscript.arguments(0)
mbMailboxName = wscript.arguments(1)

unDisplayname = ""

csCurrentSnapFileName = "c:\temp\currentSnap-" & mbMailboxName & ".xml"
psPreviousSnapFileName = "c:\temp\prevSnap-" & mbMailboxName & ".xml"
adArchieveDirectory = "c:\temp\SnapArchive\"
rfReportFileName = "c:\temp\ACL-Rule-ChangeReport-" & mbMailboxName
rrRightReport = 0
Set fso = CreateObject("Scripting.FileSystemObject")
'check SnapArchive'
If Not fso.FolderExists(adArchieveDirectory) Then
wscript.echo "Archive Folder Created"
fso.createfolder(adArchieveDirectory)
End if
''

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("//Folder")
For Each xnUserNode In xnCurrentPermsUsers
fnFolderName = xnUserNode.attributes.getNamedItem("Name").nodeValue
For Each caACLs In xnUserNode.ChildNodes
ReDim aclArray1(1)
aclArray1(0) = caACLs.attributes.getNamedItem("Right").nodeValue
aclArray1(1) = caACLs.attributes.getNamedItem("Name").nodeValue
ckCurrentACL = fnFolderName & "|-|" &
caACLs.attributes.getNamedItem("User").nodeValue
ckCurrentPerms.add ckCurrentACL, aclArray1
Next
Next
Set xnPrevPermsUsers = xdXmlDocument.selectNodes("//Folder")
For Each xnUserNode1 In xnPrevPermsUsers
fnFolderName1 = xnUserNode1.attributes.getNamedItem("Name").nodeValue
For Each caACLs1 In xnUserNode1.ChildNodes
ReDim aclArray1(1)
aclArray1(0) = caACLs1.attributes.getNamedItem("Right").nodeValue
aclArray1(1) = caACLs1.attributes.getNamedItem("Name").nodeValue
pkPrevACL = fnFolderName1 & "|-|" & caACLs1.attributes.getNamedItem("User").nodeValue
pkPreviousPerms.add pkPrevACL, aclArray1
rem Do a Check for Any Deleted or Changed Permisssions
If ckCurrentPerms.exists(pkPrevACL) Then
ckCurrentACLArray = ckCurrentPerms(pkPrevACL)
If ckCurrentACLArray(0) <> 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 & " " & ckCurrentACLArray(0)
hrmodHtmlReport = hrmodHtmlReport & "<tr><td><font face=""Arial"" color=""#000080""
size=""2"">" & fnFolderName1 & " </font></td>" & vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">Old Rights: " & caACLs1.attributes.getNamedItem("Name").nodeValue _
& " " & caACLs1.attributes.getNamedItem("Right").nodeValue & " </font></td>" &
vbcrlf
hrmodHtmlReport = hrmodHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">New Rights: " _
& caACLs1.attributes.getNamedItem("Name").nodeValue & " " & ckCurrentACLArray(0)
& " </font></td></tr>" & vbcrlf
End if
Else
rrRightReport = 1
hrDelHtmlReport = hrDelHtmlReport & "<tr><td><font face=""Arial"" color=""#000080""
size=""2"">" & fnFolderName1 & " </font></td>" & vbcrlf
hrDelHtmlReport = hrDelHtmlReport & "<td><font face=""Arial"" color=""#000080""
size=""2"">" & caACLs1.attributes.getNamedItem("Name").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
dkpermsvaluearray = ckCurrentPerms(dkCurrenPermKey)
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"">" & dkpermsvaluearray(1) _
& " " & dkpermsvaluearray(0) & " </font></td></tr>" & vbcrlf
Wscript.echo "Found new ACL : " & dkCurrenPermKey & " " & dkpermsvaluearray(0)
End if
Next
rem Check Rules
Set ckCurrentRules = CreateObject("Scripting.Dictionary")
Set pkPreviousRules = CreateObject("Scripting.Dictionary")
Set xnCurrentRules = xdXmlDocument1.selectNodes("//Rule")
For Each xnRule In xnCurrentRules
ReDim ruleArray(1)
rnRuleName = xnRule.attributes.getNamedItem("Name").nodeValue
ruleArray(0) = xnRule.attributes.getNamedItem("ActionType").nodeValue
ruleArray(1) = xnRule.attributes.getNamedItem("Arg").nodeValue
ckCurrentRules.add rnRuleName,ruleArray
Next
Set xnPrevRules = xdXmlDocument.selectNodes("//Rule")
For Each xnRule1 In xnPrevRules
ReDim ruleArray1(1)
rnRuleName1 = xnRule1.attributes.getNamedItem("Name").nodeValue
ruleArray1(0) = xnRule1.attributes.getNamedItem("ActionType").nodeValue
ruleArray1(1) = xnRule1.attributes.getNamedItem("Arg").nodeValue
pkPreviousRules.add rnRuleName1, ruleArray1
rem Do a Check for Any Deleted or Changed rules
If ckCurrentRules.exists(rnRuleName1) Then
ckCurrentRuleArray = ckCurrentRules(rnRuleName1)
If ckCurrentRuleArray(0) <>
xnRule1.attributes.getNamedItem("ActionType").nodeValue Then
rrRightReport = 1
wscript.echo "Rule - Action Change"
wscript.echo "Old Value : " &
xnRule1.attributes.getNamedItem("ActionType").nodeValue
wscript.echo "New Value : " & ckCurrentRuleArray(0)
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & rnRuleName1 & " </font></td>" & vbcrlf
Else
If ckCurrentRuleArray(1) <> xnRule1.attributes.getNamedItem("Arg").nodeValue
Then
rrRightReport = 1
wscript.echo "Rule - Arg Change"
wscript.echo "Old Value : " & xnRule1.attributes.getNamedItem("Arg").nodeValue
wscript.echo "New Value : " & ckCurrentRuleArray(1)
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & rnRuleName1 & " </font></td>" & vbcrlf
if ckCurrentRuleArray(0) = 1 Or ckCurrentRuleArray(0) = 2 then
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" &
DisplayActionType(xnRule1.attributes.getNamedItem("ActionType").nodeValue) & "
</font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">Old Folder: " &
xnRule1.attributes.getNamedItem("Arg").nodeValue _
& " </font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">New Folder: " _
& ckCurrentRuleArray(1) & " </font></td></tr>" & vbcrlf
Elseif ckCurrentRuleArray(0) = 6 Or ckCurrentRuleArray(0) = 7 then
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" &
DisplayActionType(xnRule1.attributes.getNamedItem("ActionType").nodeValue) & "
</font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">Old Recipients: " &
xnRule1.attributes.getNamedItem("Arg").nodeValue _
& " </font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">New Recipients: " _
& ckCurrentRuleArray(1) & " </font></td></tr>" & vbcrlf
Else
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" &
DisplayActionType(xnRule1.attributes.getNamedItem("ActionType").nodeValue) & "
</font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">Old Arg: " &
xnRule1.attributes.getNamedItem("Arg").nodeValue _
& " </font></td>" & vbcrlf
hrmodRuleHtmlReport = hrmodRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">New Arg: " _
& ckCurrentRuleArray(1) & " </font></td></tr>" & vbcrlf
End If
End if
End if

Else
rrRightReport = 1
hrDelRuleHtmlReport = hrDelRuleHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" & rnRuleName1 & " </font></td>" & vbcrlf
hrDelRuleHtmlReport = hrDelRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" &
DisplayActionType(xnRule1.attributes.getNamedItem("ActionType").nodeValue) _
& " " & xnRule1.attributes.getNamedItem("Arg").nodeValue & " </font></td></tr>"
& vbcrlf
Wscript.echo "Found Deleted Rule: " & rnRuleName1
End if
Next
rem Do forward check of Rule
For Each dkCurrentRuleKey In ckCurrentRules.keys
If Not pkPreviousRules.exists(dkCurrentRuleKey) Then
rrRightReport = 1
ckCurrentRuleArray = ckCurrentRules(dkCurrentRuleKey)
hrnewRuleHtmlReport = hrnewRuleHtmlReport & "<tr><td><font face=""Arial""
color=""#000080"" size=""2"">" _
& " " & dkCurrentRuleKey & " </font></td>" & vbcrlf
hrnewRuleHtmlReport = hrnewRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" & DisplayActionType(ckCurrentRuleArray(0)) & "
</font></td>" & vbcrlf
hrnewRuleHtmlReport = hrnewRuleHtmlReport & "<td><font face=""Arial""
color=""#000080"" size=""2"">" _
& " " & ckCurrentRuleArray(1) & " </font></td></tr>" & vbcrlf
Wscript.echo "Found new Rule : " & dkCurrentRuleKey
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 Rules or Delgated Folder Permissions for " &
unDisplayname & "<Br> 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
If hrnewRuleHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">New Rule Added</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport & hrnewRuleHtmlReport & "</table>"
End If
If hrDelRuleHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">Rule Deleted</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport & hrDelRuleHtmlReport & "</table>"
End If
If hrmodRuleHtmlReport <> "" Then
hrHtmlReport = hrHtmlReport & "<p><font face=""Arial"" color=""#000080""
size=""2"">Rule Modified</font></p>"
hrHtmlReport = hrHtmlReport & "<table border=""1"" width=""100%"" id=""table1""
cellspacing=""0"" cellpadding=""0"" bordercolor=""#000000"">"
hrHtmlReport = hrHtmlReport & hrmodRuleHtmlReport & "</table>"
End If
hrHtmlReport = hrHtmlReport & "</body></html>" & vbcrlf
rfReportFileName = rfReportFileName &
Replace(Replace(Replace(NewSnapDate,":",""),",","")," ","") & ".htm"
wscript.echo rfReportFileName
set rfile = fso.opentextfile(rfReportFileName,2,true)
rfile.writeline(hrHtmlReport)
End If

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 objSession = CreateObject("MAPI.Session")
On Error resume next
objSession.Logon "","",false,true,true,true,snServerName & vbLF & mbMailboxName
if err.number <> 0 Then
wscript.echo "logon Error"
wscript.echo err.description
err.clear
End if
On Error goto 0
set objCuser = objSession.CurrentUser
unDisplayname = objCuser.Name
Set CdoInfoStore = objSession.GetInfoStore
Set CdoFolderRoot = CdoInfoStore.RootFolder
Set ACLObj = CreateObject("MSExchange.aclobject")
ACLObj.CDOItem = CdoFolderRoot
Set FolderACEs = ACLObj.ACEs
fwFirstWrite = 0
For each fldace in FolderACEs
RecipArray = GetACLEntryName(fldace.ID, objSession)
if cstr(objCuser.address) <> cstr(RecipArray(0)) Then
If fwFirstWrite = 0 Then
wfile.writeline(" <Folder Name=""root"">")
fwFirstWrite = 1
End if
wfile.writeline("<ACE User=""" & RecipArray(0) & """ Right=""" &
DispACERules(fldace) & """ Name = """ & RecipArray(1) & """></ACE>")
end if
Next
If fwFirstWrite = 1 then
wfile.writeline("</Folder>")
End if
Set CdoFolders = CdoFolderRoot.Folders
Set CdoFolder = CdoFolders.GetFirst
do while Not (CdoFolder Is Nothing)
ACLObj.CDOItem = CdoFolder
Set FolderACEs = ACLObj.ACEs
fwFirstWrite = 0
For each fldace in FolderACEs
RecipArray = GetACLEntryName(fldace.ID, objSession)
if cstr(objCuser.address) <> cstr(RecipArray(0)) Then
If fwFirstWrite = 0 Then
wfile.writeline(" <Folder Name=""" & CdoFolder.Name & """>")
fwFirstWrite = 1
End if
wfile.writeline("<ACE User=""" & RecipArray(0) & """ Right=""" &
DispACERules(fldace) & """ Name = """ & RecipArray(1) & """></ACE>")
end if
Next
If fwFirstWrite = 1 then
wfile.writeline("</Folder>")
End if
Set CdoFolder = CdoFolders.GetNext
Loop
Set mrMailboxRules = CreateObject("MSExchange.Rules")
mrMailboxRules.Folder = objSession.Inbox
Wscript.echo "Checking Rules"
fwFirstWrite = 0
bnum = 0
Set dupRules = CreateObject("Scripting.Dictionary")
for Each roRule in mrMailboxRules
If fwFirstWrite = 0 Then
wfile.writeline("<Rules>")
fwFirstWrite = 1
End If
agrstr = ""
acActType = ""
rname = ""
for each aoAction in roRule.actions
acActType = aoAction.ActionType
if aoAction.ActionType = 7 Or aoAction.ActionType = 6 Then
If aoAction.ActionType = 7 Then
rname = "Delegate-Forward-Rule-" & bnum
bnum = bnum + 1
End if
for each aoAdressObject in aoAction.arg
Set objAddrEntry = objSession.GetAddressEntry(aoAdressobject)
If agrstr = "" then
agrstr = agrstr & objAddrEntry.Name
Else
agrstr = agrstr & ";" & objAddrEntry.Name
End if
next
end If
If aoAction.ActionType = 1 Or aoAction.ActionType = 2 Then
agrstr = agrstr & aoAction.arg.Name & " "
End if
Next
argstr = fwAdddress
If roRule.Name = "" And rname = "" Then
rname = "Blank-" & acActType
Else
If rname = "" Then
rname = Replace(Replace(roRule.Name,"<"," "),">"," ")
End if
End If
bnum = bnum + 1
If dupRules.exists(rname) Then
wscript.echo "Duplicate in Rules Founds #########################"
Else
dupRules.add rname,1
wfile.writeLine(" <Rule Name =""" & rname & """ ActionType=""" & acActType & """
Arg=""" & agrstr & """></Rule>")
End if
Next
If fwFirstWrite = 1 then
wfile.writeline("</Rules>")
End if

if Not objSession Is Nothing Then objSession.Logoff
set objSession = Nothing
Set ACLObj = Nothing
Set mrMailboxRules = Nothing
Set CdoFolderRoot = nothing
Set ACLObj = nothing
Set FolderACEs = nothing

wfile.writeline("</SnappedACLS>")
wscript.echo "New Snap Taken"

End Sub


Function GetACLEntryName(ACLEntryID,SubSession)
Dim tmpName(1)
select case ACLEntryID
case "ID_ACL_DEFAULT"
tmpName(0) = "Default"
tmpName(1) = "Default"
GetACLEntryName = tmpName
case "ID_ACL_ANONYMOUS"
tmpName(0) = "Anonymous"
tmpName(1) = "Anonymous"
GetACLEntryName = tmpName
case else
Set tmpEntry = SubSession.GetAddressEntry(ACLEntryID)
tmpName(0) = tmpEntry.address
tmpName(1) = tmpEntry.Name
GetACLEntryName = tmpName
end select

End Function

Function DispACERules(DisptmpACE)

Select Case DisptmpACE.Rights

Case ROLE_NONE, 0 ' Checking in case the role has not been set on that entry.
DispACERules = "None"
Case 1024 ' Check value since ROLE_NONE is incorrect
DispACERules = "None"
Case ROLE_AUTHOR
DispACERules = "Author"
Case 1051 ' Check value since ROLE_AUTHOR is incorrect
DispACERules = "Author"
Case ROLE_CONTRIBUTOR
DispACERules = "Contributor"
Case 1026 ' Check value since ROLE_CONTRIBUTOR is incorrect
DispACERules = "Contributor"
Case 1147 ' Check value since ROLE_EDITOR is incorrect
DispACERules = "Editor"
Case ROLE_NONEDITING_AUTHOR
DispACERules = "Nonediting Author"
Case 1043 ' Check value since ROLE_NONEDITING AUTHOR is incorrect
DispACERules = "Nonediting Author"
Case 2043 ' Check value since ROLE_OWNER is incorrect
DispACERules = "Owner"
Case ROLE_PUBLISH_AUTHOR
DispACERules = "Publishing Author"
Case 1179 ' Check value since ROLE_PUBLISHING_AUTHOR is incorrect
DispACERules = "Publishing Author"
Case 1275 ' Check value since ROLE_PUBLISH_EDITOR is incorrect
DispACERules = "Publishing Editor"
Case ROLE_REVIEWER
DispACERules = "Reviewer"
Case 1025 ' Check value since ROLE_REVIEWER is incorrect
DispACERules = "Reviewer"
Case Else
DispACERules = "Custom"
End Select

End Function

Function DisplayActionType(acActionType)
Select Case acActionType
Case 1 DisplayActionType = "Move-Rule"
Case 2 DisplayActionType = "Copy-Rule"
Case 3 DisplayActionType = "Delete-Message"
Case 4 DisplayActionType = "Reply"
Case 5 DisplayActionType = "OOF-Reply"
Case 6 DisplayActionType = "Forward-Rule"
Case 7 DisplayActionType = "Delegate-Forward-Rule"
Case 8 DisplayActionType = "Bounce-Message"
Case 9 DisplayActionType = "Tag-Message"
Case 10 DisplayActionType = "Mark-Read"
Case 11 DisplayActionType = "Mark-Defer"
Case Else DisplayActionType = "Unknown"
End Select
End Function

1 comment:

Anonymous said...

Glen, this is awesome, thank you! Solved a big and time critical problem for us, and worked within a few minutes.

5 stars!

Thanks again,

G