Thursday, May 31, 2007

Reporting on Mailbox sizes and counts for the Deleted-Items (or any other folder in a mailbox) for all users on a Server

Here’s one more use for an adaption of the mailbox age script I posted a while ago the mailbox manager is a great tool for enforcing age limits on mailbox folders if you would like some reporting outside of what the mailbox manager produces on folders that you intended to implement age restrictions on then this script may help.

Before running this script you need to set 2 variables in the code the first is the number of days you want this script to report on. Eg if you set it to 7 days it will produce a report of the number of items and size of those items in the folder you configure in the next variable that are under 7 days old and those that are over 7 days old. The second variable that needs to be set is the folder you want to run against by default its set to the deleted items folder.

numbdays = 7
folderurl = "/Deleted Items/"

By default the script doesn’t re-curse sub folders within the folder you configure if you want this to happen you need to unrem the following line In the script

Rem call RecurseFolder(falias & folderurl) ' Uncomment this line for recursion

What the script does is accepts one commandline parameter which is the servername of the server you want it to run against. It looks up active directory for all the users on this server and then connects to the server via the admin virtual root and then checks the folder you configure and looks at the size and age of each message. It them builds a html report for every user it found in Active directory and writes the report to the temp directory. For some more detail on the inner workings of the script please refer to my other post.

To run the script use a commandline such as cscript cntitems.vbs yourservername

I’ve put a download of the code here the script itself looks like

on error resume Next

numbdays = 7
folderurl = "/Deleted Items/"

set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())

Servername = wscript.arguments(0)
treport = "<table border=""1"" width=""100%"">" & vbcrlf
treport = treport & " <tr>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Mailbox
Name</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Less Than " & numbdays &amp;amp; " Days</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Greator Than " & numbdays &amp;amp; " Days</font></b></td>" & vbcrlf
treport = treport & "</tr>" & vbcrlf
treport = treport & " <tr>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF""> </font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
treport = treport & "</tr>" & vbcrlf
set req = createobject("microsoft.xmlhttp")
set com = createobject("ADODB.Command")
set conn = createobject("ADODB.Connection")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
polQuery = "<LDAP://" & strNameingContext &amp;amp; ">;(&(objectCategory=msExchRecipientPolicy)(cn=Default
Policy));distinguishedName,gatewayProxy;subtree"
svcQuery = "<LDAP://" & strNameingContext &amp;amp; ">;(&(objectCategory=msExchExchangeServer)(cn="
& Servername & "));cn,name,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = polQuery
Set plRs = Com.Execute
while not plRs.eof
for each adrobj in plrs.fields("gatewayProxy").value
if instr(adrobj,"SMTP:") then dpDefaultpolicy =
right(adrobj,(len(adrobj)-instr(adrobj,"@")))
next
plrs.movenext
wend
wscript.echo dpDefaultpolicy
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
GALQueryFilter = "(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(|
(&(objectCategory=person)(objectClass=user)(msExchHomeServerName=" &
rs.fields("legacyExchangeDN") &amp;amp; ")) )))))"
strQuery = "<LDAP://" & strDefaultNamingContext &amp;amp; ">;" & GALQueryFilter & ";displayname,mail,distinguishedName,mailnickname,proxyaddresses;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs1 = Com.Execute
while not Rs1.eof
falias = "http://" & servername &amp;amp; "/exadmin/admin/" & dpDefaultpolicy & "/mbx/"
for each paddress in rs1.fields("proxyaddresses").value
if instr(paddress,"SMTP:") then falias = falias & replace(paddress,"SMTP:","")

next
ReDim tresarray(1,6)
wscript.echo falias
call ProcFolder(falias &amp;amp; folderurl,replace(folderurl,"/",""))
Rem call RecurseFolder(falias & folderurl) ' Uncomment this line for recursion
wfile.close
set wfile = nothing
treport = treport &amp;amp; "<tr>" & vbcrlf
treport = treport & "<td align=""center"">" & rs1.fields("mail").value &amp;amp;
" </td>" & vbcrlf
treport = treport & "<td align=""center"">" & tresarray(0,1) &amp;amp; " </td>" &
vbcrlf
treport = treport & "<td align=""center"">" &
FormatNumber(tresarray(1,1)/1024/1024,2) &amp;amp; " </td>" & vbcrlf
treport = treport & "<td align=""center"">" & tresarray(0,2) &amp;amp; " </td>" &
vbcrlf
treport = treport & "<td align=""center"">" &
FormatNumber(tresarray(1,2)/1024/1024,2) &amp;amp; " </td>" & vbcrlf
treport = treport & "</tr>" & vbcrlf
rs1.movenext
wend
rs.movenext
wend
rs.close
set conn = nothing
set com = nothing
treport = treport &amp;amp; "</table>" & vbcrlf
Set fso = CreateObject("Scripting.FileSystemObject")
set wfile = fso.opentextfile("c:\temp\Server-" & Servername &
"-CntItems.htm",2,true)
wfile.write treport
wfile.close
set wfile = nothing
set fso = nothing

Public Sub RecurseFolder(sUrl)

req.open "SEARCH", sUrl, False, "", ""
sQuery = "<?xml version=""1.0""?>"
sQuery = sQuery & "<g:searchrequest xmlns:g=""DAV:"">"
sQuery = sQuery & "<g:sql>SELECT ""http://schemas.microsoft.com/"
sQuery = sQuery & "mapi/proptag/x0e080003"", ""DAV:hassubs"" FROM SCOPE "
sQuery = sQuery & "('SHALLOW TRAVERSAL OF """ & sUrl &amp;amp; """') "
sQuery = sQuery & "WHERE ""DAV:isfolder"" = true and ""DAV:ishidden"" = false
and ""http://schemas.microsoft.com/mapi/proptag/x36010003"" = 1"
sQuery = sQuery & "</g:sql>"
sQuery = sQuery & "</g:searchrequest>"
req.setRequestHeader "Content-Type", "text/xml"
req.setRequestHeader "Translate", "f"
req.setRequestHeader "Depth", "0"
req.setRequestHeader "Content-Length", "" & Len(sQuery)
req.send sQuery
Set oXMLDoc = req.responseXML
Set oXMLSizeNodes = oXMLDoc.getElementsByTagName("d:x0e080003")
Set oXMLHREFNodes = oXMLDoc.getElementsByTagName("a:href")
Set oXMLHasSubsNodes = oXMLDoc.getElementsByTagName("a:hassubs")
For i = 0 to oXMLSizeNodes.length - 1
call procfolder(oXMLHREFNodes.Item(i).nodeTypedValue,sUrl)
wscript.echo oXMLHREFNodes.Item(i).nodeTypedValue
If oXMLHasSubsNodes.Item(i).nodeTypedValue = True Then
call RecurseFolder(oXMLHREFNodes.Item(i).nodeTypedValue)
End If
Next
End Sub


sub procfolder(strURL,pfname)
wscript.echo strURL
ReDim resarray(1,6)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:""
xmlns:b=""urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"">"
strQuery = strQuery & "<D:sql>SELECT ""DAV:displayname"",
""urn:schemas:httpmail:subject"", "
strQuery = strQuery & """DAV:creationdate"", ""DAV:getcontentlength"", "
strQuery = strQuery & """urn:schemas:httpmail:fromemail"",
""http://schemas.microsoft.com/mapi/proptag/x0e080003"" As Msize"
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL &amp; """') Where ""DAV:ishidden"" = False AND
""DAV:isfolder"" = False</D:sql></D:searchrequest>"
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:displayname")
set oNodeList1 = oResponseDoc.getElementsByTagName("a:href")
set oSize = oResponseDoc.getElementsByTagName("Msize")
set odatereceived = oResponseDoc.getElementsByTagName("a:creationdate")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
set oNode1 = oNodeList1.nextNode
set oNode2 = oSize.nextNode
set oNode3 = odatereceived.nextNode
wscript.echo oNode3.text
If CDate(DateSerial(mid(oNode3.text,1,4),
mid(oNode3.text,6,2),mid(oNode3.text,9,2))) > dateadd("d",-numbdays,now()) Then
resarray(0,1) = resarray(0,1) + 1
resarray(1,1) = resarray(1,1) + Int(oNode2.text)
End if
If CDate(DateSerial(mid(oNode3.text,1,4),
mid(oNode3.text,6,2),mid(oNode3.text,9,2))) < dateadd("d",-numbdays,now()) Then
resarray(0,2) = resarray(0,2) + 1
resarray(1,2) = resarray(1,2) + Int(oNode2.text)
End if
Next
Else
End If
tresarray(0,1) = tresarray(0,1) + resarray(0,1)
tresarray(1,1) = tresarray(1,1) + resarray(1,1)
tresarray(0,2) = tresarray(0,2) + resarray(0,2)
tresarray(1,2) = tresarray(1,2) + resarray(1,2)
end sub

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

Wednesday, May 16, 2007

Unread Email report for all Folders in all Mailboxes on an Exchange Server

Unread email is such an analogy for a lot of the problems that plague email systems. Eg if you have a piece of email that is sitting unread in your inbox for a long period of time what’s the point of you receiving this email or the person who sent it sending it. Read recipients aside most people believe that when they send an email no matter how trivial the content that you will read or delete it. In a sense unread email is limbo information serving no higher purpose then clogging up your inbox kind of like pages that are stuck together in a book. Eg how will you know if you need to keep a piece of information if you have never bothered to actually read it? Having seen the inside of far too many people’s mailboxes it seems that a lot of people have developed a seventh sense for information they haven’t read but might need to know in the future. So one Interesting Report you might want to create is to look at how much space this limbo information is taking up.

The following is a script that produces a report of all the unread email in every folder on all mailboxes on a server. It’s based around the mailbox connect age script I posted a while ago but queries the folders to look at messages where the read property urn:schemas:httpmail:read is set to false. To make this a little bit more usefully the script also queries the users OOF State so you can see from the report that the reason a user may have a large number of unread email is because they are out of the office. Also the sent items folder is also queried and the date of the last email sent is also included in the report which might help indentifying any mailboxes that may not be used. The script breaks down the unread email a little further by showing the number and size of unread email that is 6 months old and the number and size of the unread email that is greater than 6 month old

Like the age content report the script produces a combined report for all mailboxes on a server as well as separate reports for each user that breaks down the unread email by folder.

The Script uses WebDAV via the Admin virtual root directory to access the user Mailboxes this gets around the need for the user running the script to have rights in the users mailbox and should be able to be run successfully using just delegated Exchange Admin rights. To work out the correct path to use for the Admin virtual root the script includes a LDAP query that gets the default SMTP FQDN from the default recipient policy.

By default the script isn’t using SSL which may mean you need to adjust the following line if you are using SSL on the ExAdmin Directory Eg change line 65

falias = "http://" & servername & "/exadmin/admin/" & dpDefaultpolicy & "/mbx/"

to

falias = "https://" & servername & "/exadmin/admin/" & dpDefaultpolicy & "/mbx/"

If you are still using Exchange 2000 you need to change line 67 in the script to

if instr(paddress,"SMTP:") then falias = falias & left(replace(paddress,"SMTP:",""),(instr(replace(paddress,"SMTP:",""),"@")-1))


The script requires one command-line parameter which is the name of the server you want to run the script against eg cscript ureadrep.vbs yourservername

I’ve put a downloadable copy of the script here the script itself look like

on error resume Next
set shell = createobject("wscript.shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())

Servername = wscript.arguments(0)
treport = "<table border=""1"" width=""100%"">" & vbcrlf
treport = treport & " <tr>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Mailbox
Name</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Less Than 6 Months</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Greator Than 6 Months</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">OOF
Status</font></b></td>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Last
Sent</font></b></td>" & vbcrlf
treport = treport & "</tr>" & vbcrlf
treport = treport & " <tr>" & vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">&nbsp;</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
treport = treport & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
treport = treport & "</tr>" & vbcrlf
set req = createobject("microsoft.xmlhttp")
set com = createobject("ADODB.Command")
set conn = createobject("ADODB.Connection")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
polQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchRecipientPolicy)(cn=Default
Policy));distinguishedName,gatewayProxy;subtree"
svcQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchExchangeServer)(cn="
& Servername & "));cn,name,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = polQuery
Set plRs = Com.Execute
while not plRs.eof
for each adrobj in plrs.fields("gatewayProxy").value
if instr(adrobj,"SMTP:") then dpDefaultpolicy =
right(adrobj,(len(adrobj)-instr(adrobj,"@")))
next
plrs.movenext
wend
wscript.echo dpDefaultpolicy
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
GALQueryFilter = "(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(|
(&(objectCategory=person)(objectClass=user)(msExchHomeServerName=" &
rs.fields("legacyExchangeDN") & ")) )))))"
strQuery = "<LDAP://" & strDefaultNamingContext & ">;" & GALQueryFilter & ";displayname,mail,distinguishedName,mailnickname,proxyaddresses;subtree"
com.Properties("Page Size") = 100
Com.CommandText = strQuery
Set Rs1 = Com.Execute
while not Rs1.eof
report = "<table border=""1"" width=""100%"">" & vbcrlf
report = report & " <tr>" & vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Folder
Name</font></b></td>" & vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Less Than 6 Months</font></b></td>" & vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080"" colspan=""2""><b><font
color=""#FFFFFF"">Greator Than 6 Months</font></b></td>" & vbcrlf
report = report & "</tr>" & vbcrlf
report = report & " <tr>" & vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">&nbsp;</font></b></td>"
& vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">#Messages</font></b></td>"
& vbcrlf
report = report & "<td align=""center"" bgcolor=""#000080""><b><font color=""#FFFFFF"">Size(MB)</font></b></td>"
& vbcrlf
report = report & "</tr>" & vbcrlf
falias = "http://" & servername & "/exadmin/admin/" & dpDefaultpolicy & "/mbx/"
for each paddress in rs1.fields("proxyaddresses").value
if instr(paddress,"SMTP:") then falias = falias & left(replace(paddress,"SMTP:",""),(instr(replace(paddress,"SMTP:",""),"@")-1))
next
ReDim tresarray(1,6)
wscript.echo falias
offstat = chkoof(falias & "/" & "non_ipm_subtree/")
call RecurseFolder(falias)
LastSent = getlastsent(falias)
report = report & "</table>" & vbcrlf
Set fso = CreateObject("Scripting.FileSystemObject")
set wfile = fso.opentextfile("c:\temp\" & rs1.fields("mail").value &
".htm",2,true)
wfile.write report
wfile.close
set wfile = nothing
treport = treport & "<tr>" & vbcrlf
treport = treport & "<td align=""center"">" & rs1.fields("mail").value &
"&nbsp;</td>" & vbcrlf
treport = treport & "<td align=""center"">" & tresarray(0,1) & "&nbsp;</td>" &
vbcrlf
treport = treport & "<td align=""center"">" &
FormatNumber(tresarray(1,1)/1024/1024,2) & "&nbsp;</td>" & vbcrlf
treport = treport & "<td align=""center"">" & tresarray(0,2) & "&nbsp;</td>" &
vbcrlf
treport = treport & "<td align=""center"">" &
FormatNumber(tresarray(1,2)/1024/1024,2) & "&nbsp;</td>" & vbcrlf
treport = treport & "<td align=""center"">" & offstat & "&nbsp;</td>" & vbcrlf
treport = treport & "<td align=""center"">" & LastSent & "&nbsp;</td>" & vbcrlf
treport = treport & "</tr>" & vbcrlf
rs1.movenext
wend
rs.movenext
wend
rs.close
set conn = nothing
set com = nothing
treport = treport & "</table>" & vbcrlf
Set fso = CreateObject("Scripting.FileSystemObject")
set wfile = fso.opentextfile("c:\temp\Server-" & Servername &
"-UnreadReport.htm",2,true)
wfile.write treport
wfile.close
set wfile = nothing
set fso = nothing

Public Sub RecurseFolder(sUrl)

req.open "SEARCH", sUrl, False, "", ""
sQuery = "<?xml version=""1.0""?>"
sQuery = sQuery & "<g:searchrequest xmlns:g=""DAV:"">"
sQuery = sQuery & "<g:sql>SELECT ""http://schemas.microsoft.com/"
sQuery = sQuery & "mapi/proptag/x0e080003"", ""DAV:hassubs"" FROM SCOPE "
sQuery = sQuery & "('SHALLOW TRAVERSAL OF """ & sUrl & """') "
sQuery = sQuery & "WHERE ""DAV:isfolder"" = true and ""DAV:ishidden"" = false
and ""http://schemas.microsoft.com/mapi/proptag/x36010003"" = 1"
sQuery = sQuery & "</g:sql>"
sQuery = sQuery & "</g:searchrequest>"
req.setRequestHeader "Content-Type", "text/xml"
req.setRequestHeader "Translate", "f"
req.setRequestHeader "Depth", "0"
req.setRequestHeader "Content-Length", "" & Len(sQuery)
req.send sQuery
Set oXMLDoc = req.responseXML
Set oXMLSizeNodes = oXMLDoc.getElementsByTagName("d:x0e080003")
Set oXMLHREFNodes = oXMLDoc.getElementsByTagName("a:href")
Set oXMLHasSubsNodes = oXMLDoc.getElementsByTagName("a:hassubs")
For i = 0 to oXMLSizeNodes.length - 1
call procfolder(oXMLHREFNodes.Item(i).nodeTypedValue,sUrl)
wscript.echo oXMLHREFNodes.Item(i).nodeTypedValue
If oXMLHasSubsNodes.Item(i).nodeTypedValue = True Then
call RecurseFolder(oXMLHREFNodes.Item(i).nodeTypedValue)
End If
Next
End Sub

sub procfolder(strURL,pfname)
wscript.echo strURL
ReDim resarray(1,6)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:""
xmlns:b=""urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"">"
strQuery = strQuery & "<D:sql>SELECT ""DAV:displayname"",
""urn:schemas:httpmail:subject"", "
strQuery = strQuery & """DAV:creationdate"", ""DAV:getcontentlength"", "
strQuery = strQuery & """urn:schemas:httpmail:fromemail"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND
""DAV:isfolder"" = False AND ""urn:schemas:httpmail:read"" =
False</D:sql></D:searchrequest>"
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:displayname")
set oNodeList1 = oResponseDoc.getElementsByTagName("a:href")
set oSize = oResponseDoc.getElementsByTagName("a:getcontentlength")
set odatereceived = oResponseDoc.getElementsByTagName("a:creationdate")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
set oNode1 = oNodeList1.nextNode
set oNode2 = oSize.nextNode
set oNode3 = odatereceived.nextNode
wscript.echo oNode3.text
If CDate(DateSerial(mid(oNode3.text,1,4),
mid(oNode3.text,6,2),mid(oNode3.text,9,2))) > dateadd("m",-6,now()) Then
resarray(0,1) = resarray(0,1) + 1
resarray(1,1) = resarray(1,1) + Int(oNode2.text)
End if
If CDate(DateSerial(mid(oNode3.text,1,4),
mid(oNode3.text,6,2),mid(oNode3.text,9,2))) < dateadd("m",-6,now()) Then
resarray(0,2) = resarray(0,2) + 1
resarray(1,2) = resarray(1,2) + Int(oNode2.text)
End if
Next
Else
End If
tresarray(0,1) = tresarray(0,1) + resarray(0,1)
tresarray(1,1) = tresarray(1,1) + resarray(1,1)
tresarray(0,2) = tresarray(0,2) + resarray(0,2)
tresarray(1,2) = tresarray(1,2) + resarray(1,2)
report = report & "<tr>" & vbcrlf
report = report & "<td align=""center"">" & unescape(Replace(strURL,falias,""))
& "&nbsp;</td>" & vbcrlf
report = report & "<td align=""center"">" & resarray(0,1) & "&nbsp;</td>" &
vbcrlf
report = report & "<td align=""center"">" &
FormatNumber(resarray(1,1)/1024/1024,2) & "&nbsp;</td>" & vbcrlf
report = report & "<td align=""center"">" & resarray(0,2) & "&nbsp;</td>" &
vbcrlf
report = report & "<td align=""center"">" &
FormatNumber(resarray(1,2)/1024/1024,2) & "&nbsp;</td>" & vbcrlf
report = report & "</tr>" & vbcrlf
end sub

Function chkoof(mburl)

xmlstr = "<?xml version='1.0' encoding='UTF-8' ?>" _
& "<a:propfind xmlns:a='DAV:' xmlns:b='urn:schemas-microsoft-com:datatypes'>" _

& "<a:prop xmlns:d='http://schemas.microsoft.com/exchange/'>" _
& "<d:oof-state/>" _
& "</a:prop>" _
& "</a:propfind>"
req.open "PROPFIND", mburl, false
req.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
req.setRequestHeader "Depth", "0"
req.setRequestHeader "Translate", "f"
req.send xmlstr
set oResponseDoc = req.responseXML
set osubNodeList = oResponseDoc.getElementsByTagName("d:oof-state/")
ntar = osubNodeList.length -1
wscript.Echo "********** OOf-State :" & osubNodeList.Item(ntar).text
chkoof = osubNodeList.Item(ntar).text
End Function

function getlastsent(mburl)
getlastsent = "N/A"
strURL = mburl & "/Sent Items/"
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:""
xmlns:b=""urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"">"
strQuery = strQuery & "<D:sql>SELECT ""DAV:displayname"",
""urn:schemas:httpmail:subject"", "
strQuery = strQuery & """DAV:creationdate"", ""DAV:getcontentlength"", "
strQuery = strQuery & """urn:schemas:httpmail:fromemail"",
""urn:schemas:mailheader:date"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND
""DAV:isfolder"" = False</D:sql></D:searchrequest>"
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.setRequestHeader "Range", "rows=0-0"
req.send strQuery
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("e:date")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
wscript.echo "*******Last Sent :" & oNode.text
getlastsent =
dateadd("h",toffset,DateSerial(Mid(oNode.text,1,4),Mid(oNode.text,6,2),Mid(oNode.text,9,2))
& " " & Mid(oNode.text,12,8))
Next
Else
End If
end function

Thursday, May 10, 2007

Export all Outlook contact pictures to the File System

Somebody asked a question today about how do you export all of your Outlook contact pictures to a folder in the file system. With a little CDO 1.2 this is pretty simple let’s start with some code that logs onto the mailbox and server you specify as command line parameter and then gets the contacts folder

Public Const CdoDefaultFolderContacts = 5
snServername = wscript.arguments(0)
mbMailboxName = wscript.arguments(1)
set csCDOSession = CreateObject("MAPI.Session")
pfProfile = snServername & vbLf & mbMailboxName
csCDOSession.Logon "","",False,True,0,True, pfProfile
set cfContactsFolder = csCDOSession.getdefaultfolder(CdoDefaultFolderContacts)

When a contact in Outlook has a picture the following MAPI named property will be set to true {00062004-0000-0000-C000-000000000046}0x8015 . So in CDO 1.2 you can create a filter that will filter the collection of items in the contact folder so only those with a picture will be returned. Eg

set cfContactscol = cfContactsFolder.messages
set ofConFilter = cfContactscol.Filter
Set cfContFltFld1 = ofConFilter.Fields.Add("0x8015",vbBoolean,true,"0420060000000000C000000000000046")

Then all that’s left is to iterate though the contacts and their attachments and download the attachment that relates to the contact picture which will always be named ContactPicture.jpg. The code that downloads the contact picture includes some functions to make sure the filename is unique by using the subject of the contact (which is generally the file as property).

For Each ctContact In cfContactscol
Set collAttachments = ctContact.Attachments
For Each atAttachment In collAttachments
If atAttachment.name = "ContactPicture.jpg" Then
fname = replace(replace(replace(replace(replace((ctContact.subject & "-" &
atAttachment.name),":","-"),"\",""),"/",""),"?",""),chr(34),"")
fname = replace(replace(replace(replace(replace(replace(fname,"<",""),">",""),chr(11),""),"*",""),"|",""),"(","")
fname = replace(replace(replace(fname,")",""),chr(12),""),chr(15),"")
atAttachment.WriteToFile("c:\contactpictures\" & fname)
wscript.echo "Exported Picture to : " & fname
End if
next
Next


I put a downloadable copy of the full script here

Tuesday, May 08, 2007

Exchange 2007 Mailbox Size Powershell Form Script version 2

I've created Version 3 of the script now that gets around having to use EWS

[Updated 17-5-1007 fixed URL bug]


A while back I posted version 1 of this script and a few people have made me aware lately that there are a few problems with the logic I used in this script. The first problem with this script is that it expects the CAS (Client Access Role) and the Mailbox role to be on the same server which may be true if your poor like me but for a lot of large deployments, roles will be split out onto different servers. So the method I’ve used will fail if this is the case because Exchange Web Services is part of the CAS role.

To solve this problem in version 2 I’ve used the Autodiscovery service which you can query with the email address of the user you want to access and Autodiscovery will then return the URL to use for EWS for this user. To make an autodicovery request you first need to find the service connection point for the Auto discovery service (the url to use in your request). The easy way to get this info is to use the Get-ClientAccessServer cmdlet eg

[array]$SCPCurrent = Get-ClientAccessServer

this will return an array that contains one or more entries from the CAS servers in your Exchange Organization and then you can pull the SCP from the first entry in the array.

$strRootURI = $SCPCurrent[0].AutoDiscoverServiceInternalUri.absoluteuri

Another method to get the SCP is just to query Active Directory directly via LDAP. Once you have the SCP entry all you need to do is then send a XML formatted request to the Autodiscovery service and then you should be able to parse the EWS url from the ASUrl property in the response

Eg this is the code section that was added to handle autodisco

## AutoDisco for EWS
[array]$SCPCurrent = Get-ClientAccessServer
$autodiscoResponse = "<Autodiscover xmlns=`"http://schemas.microsoft.com/exchange/autodiscover/outlook/requestschema/2006`">"
`
+ " <Request>"`
+ " <EMailAddress>" + $siSIDToSearch.WindowsEmailAddress + "</EMailAddress>"`
+ " <AcceptableResponseSchema>http://schemas.microsoft.com/exchange/autodiscover/outlook/responseschema/2006a</AcceptableResponseSchema>"`
+ " </Request>"`
+ "</Autodiscover>"
$strRootURI = $SCPCurrent[0].AutoDiscoverServiceInternalUri.absoluteuri
$WDRequest = [System.Net.WebRequest]::Create($strRootURI)
$WDRequest.ContentType = "text/xml"
$WDRequest.Headers.Add("Translate", "F")
$WDRequest.Method = "Post"
$WDRequest.UseDefaultCredentials = $True
$bytes = [System.Text.Encoding]::UTF8.GetBytes($autodiscoResponse)
$WDRequest.ContentLength = $bytes.Length
$RequestStream = $WDRequest.GetRequestStream()
$RequestStream.Write($bytes, 0, $bytes.Length)
$RequestStream.Close()
$WDResponse = $WDRequest.GetResponse()
$ResponseStream = $WDResponse.GetResponseStream()
$ResponseXmlDoc = new-object System.Xml.XmlDocument
$ResponseXmlDoc.Load($ResponseStream)
$EWSNodes = @($ResponseXmlDoc.getElementsByTagName("ASUrl"))
if ($EWSNodes.length -ne 0){
$ewsURL = $EWSNodes[0].'#text'
}
##


Another problem with this script revolves around authentication by default I’ve used impersonation as a method of accessing people’s mailboxes instead of delegation which was preferable because of the misuse that often happens with delegated accounts. But if you have resource mailboxes or any other disabled mailboxes impersonation will fail because you can’t impersonate a disabled account. So what I needed to do was add some more logic into to first detect if the account was disabled and if it was to change the request so instead of using impersonation that code dropped back to using delegation. This involved changing the SOAP request that was submitted. Delegation is described in the SDK here .

For delegation to work you must have given the account that the script is running under rights to the mailboxes in question. The Exchange Management Shell makes this pretty easy for instance to assign an account delegate access to every Room Mailbox you could use something like

get-user -recipienttypedetails 'RoomMailbox' | foreach-object {

Add-MailboxPermission $_.Identity -AccessRights FullAccess -user username

}

For details on how the rest of the code works please have a look at the previous post (link at the top of this post)

I’ve put a download copy of the new version here the script looks like

[System.Reflection.Assembly]::LoadWithPartialName("System.Drawing")
[System.Reflection.Assembly]::LoadWithPartialName("System.windows.forms")

$unUserName = "UserName"
$psPassword = "password"
$dnDomainName = "domain"
$cdUsrCredentials = new-object System.Net.NetworkCredential($unUserName , $psPassword
, $dnDomainName)

function getMailboxSizes(){

$lbListView.clear()
$lbListView.Columns.Add("UserName",150)
$lbListView.Columns.Add("# Items",70)
$lbListView.Columns.Add("MB Size(MB)",80)
$lbListView.Columns.Add("DelItems (KB)",90)
$lbListView.Columns.Add("ID",0)

get-mailboxstatistics -Server $snServerNameDrop.SelectedItem.ToString() |
ForEach-Object{
$item1 = new-object System.Windows.Forms.ListViewItem($_.DisplayName)
$item1.SubItems.Add($_.ItemCount)
$item1.SubItems.Add($_.TotalItemSize.Value.ToMB() )
$item1.SubItems.Add($_.TotalDeletedItemSize.Value.ToKB())
$item1.SubItems.Add($_.Identity)

$lbListView.items.add($item1)
}

$form.Controls.Add($lbListView)
}

function enumFolderSizes($fsFolderIDtoSearch){
$private:enfsFilterString = "ParentID = '" + $fsFolderIDtoSearch + "'"
$private:enSubFolders = $fsTable.select($enfsFilterString)
for($fcount1 = 0;$fcount1 -le $enSubFolders.GetUpperBound(0); $fcount1++){
$global:fldSize = $global:fldSize + $enSubFolders[$fcount1][3]
$global:itemCount = $global:itemCount + $enSubFolders[$fcount1][5]
if ($enSubFolders[$fcount1][4] -ne 0){
enumFolderSizes($enSubFolders[$fcount1][1])
}

}
}

function BackFolder(){
$private:bfFilterString = "FolderID = '" + $global:LastFolder + "'"
$private:bfFolder = $fsTable.select($bfFilterString)
GetSubFolderSizes($bfFolder[0][2])

}

function GetSubFolderSizes($fiFIDToSearch){
$global:LastFolder = $fiFIDToSearch
$upButton.visible = $true
$lbFldListView.clear()
$lbFldListView.Columns.Add("Folder Name",150)
$lbFldListView.Columns.Add("# Items",80)
$lbFldListView.Columns.Add("Size(MB)",80)
$lbFldListView.Columns.Add("Has Sub",80)
$lbFldListView.Columns.Add("FID",0)
$subfsFilterString = "ParentID = '" + $fiFIDToSearch + "'"
$subFolders = $fstable.select($subfsFilterString)
for($fcount2 = 0;$fcount2 -le $subFolders.GetUpperBound(0); $fcount2++){
$global:fldSize = $subFolders[$fcount2][3]
$global:itemCount = $subFolders[$fcount2][5]
if ($subFolders[$fcount2][4] -ne 0){
enumFolderSizes($subFolders[$fcount2][1])
}
$item1 = new-object System.Windows.Forms.ListViewItem($subFolders[$fcount2][0])
$item1.SubItems.Add($global:itemCount)
$item1.SubItems.Add([math]::round(($fldsize/1mb),2))
if ($subFolders[$fcount2][4] -ne 0){
$item1.SubItems.Add("Yes")
}
else {
$item1.SubItems.Add("No")
}
$item1.SubItems.Add($subFolders[$fcount2][1])
$lbFldListView.items.add($item1)
}


}


function GetFolderSizes($siSIDToSearch){
$fsTable.clear()
$lbFldListView.clear()
$lbFldListView.Columns.Add("Folder Name",150)
$lbFldListView.Columns.Add("# Items",80)
$lbFldListView.Columns.Add("Size(MB)",80)
$lbFldListView.Columns.Add("Has Sub",80)
$lbFldListView.Columns.Add("FID",0)
$snServername = $snServerNameDrop.SelectedItem.ToString()
$siSIDToSearch = get-user $siSIDToSearch
write-host $siSIDToSearch.WindowsEmailAddress
## AutoDisco for EWS
[array]$SCPCurrent = Get-ClientAccessServer
$autodiscoResponse = "<Autodiscover xmlns=`"http://schemas.microsoft.com/exchange/autodiscover/outlook/requestschema/2006`">"
`
+ " <Request>"`
+ " <EMailAddress>" + $siSIDToSearch.WindowsEmailAddress + "</EMailAddress>"`
+ "
<AcceptableResponseSchema>http://schemas.microsoft.com/exchange/autodiscover/outlook/responseschema/2006a</AcceptableResponseSchema>"`
+ " </Request>"`
+ "</Autodiscover>"
$strRootURI = $SCPCurrent[0].AutoDiscoverServiceInternalUri.absoluteuri
$WDRequest = [System.Net.WebRequest]::Create($strRootURI)
$WDRequest.ContentType = "text/xml"
$WDRequest.Headers.Add("Translate", "F")
$WDRequest.Method = "Post"
$WDRequest.UseDefaultCredentials = $True
$bytes = [System.Text.Encoding]::UTF8.GetBytes($autodiscoResponse)
$WDRequest.ContentLength = $bytes.Length
$RequestStream = $WDRequest.GetRequestStream()
$RequestStream.Write($bytes, 0, $bytes.Length)
$RequestStream.Close()
$WDResponse = $WDRequest.GetResponse()
$ResponseStream = $WDResponse.GetResponseStream()
$ResponseXmlDoc = new-object System.Xml.XmlDocument
$ResponseXmlDoc.Load($ResponseStream)
$EWSNodes = @($ResponseXmlDoc.getElementsByTagName("ASUrl"))
if ($EWSNodes.length -ne 0){
$ewsURL = $EWSNodes[0].'#text'
}
##
write-host $ewsURL
$uoUser = [ADSI]("LDAP://" + $siSIDToSearch.DistinguishedName.ToString())
$smSoapMessage = "<?xml version='1.0' encoding='utf-8'?>" `
+ "<soap:Envelope xmlns:soap=`"http://schemas.xmlsoap.org/soap/envelope/`" " `
+ " xmlns:xsi=`"http://www.w3.org/2001/XMLSchema-instance`"
xmlns:xsd=`"http://www.w3.org/2001/XMLSchema`"" `
+ " xmlns:t=`"http://schemas.microsoft.com/exchange/services/2006/types`" >" `
+ "<soap:Header>"
if ($uoUser.PSBase.InvokeGet("AccountDisabled") -ne $true){
$smSoapMessage = $smSoapMessage + "<t:ExchangeImpersonation>" `
+ "<t:ConnectingSID>" `
+ "<t:SID>" + $siSIDToSearch.SID + "</t:SID>" `
+ "</t:ConnectingSID>" `
+ "</t:ExchangeImpersonation>" `
}
$smSoapMessage = $smSoapMessage + "</soap:Header>" `
+ "<soap:Body>" `
+ "<FindFolder
xmlns=`"http://schemas.microsoft.com/exchange/services/2006/messages`" " `
+ "xmlns:t=`"http://schemas.microsoft.com/exchange/services/2006/types`"
Traversal=`"Deep`"> " `
+ "<FolderShape>" `
+ "<t:BaseShape>AllProperties</t:BaseShape>" `
+ "<AdditionalProperties
xmlns=""http://schemas.microsoft.com/exchange/services/2006/types"">" `
+ "<ExtendedFieldURI PropertyTag=""0x0e08"" PropertyType=""Integer"" />" `
+ "</AdditionalProperties>" `
+ "</FolderShape>" `
+ "<ParentFolderIds>"
if ($uoUser.PSBase.InvokeGet("AccountDisabled") -eq $true){
$smSoapMessage = $smSoapMessage + "<DistinguishedFolderId Id=`"root`" "`
+ "xmlns=`"http://schemas.microsoft.com/exchange/services/2006/types`">" `
+ "<Mailbox><EmailAddress>"+ $siSIDToSearch.WindowsEmailAddress `
+ "</EmailAddress></Mailbox></DistinguishedFolderId>"
}
else{
$smSoapMessage = $smSoapMessage + "<t:DistinguishedFolderId Id=`"root`"/>"
}
$smSoapMessage = $smSoapMessage + "</ParentFolderIds>" `
+ "</FindFolder>" `
+ "</soap:Body></soap:Envelope>"
$strRootURI = $ewsURL
$WDRequest = [System.Net.WebRequest]::Create($strRootURI)
$WDRequest.ContentType = "text/xml"
$WDRequest.Headers.Add("Translate", "F")
$WDRequest.Method = "Post"
$WDRequest.Credentials = $cdUsrCredentials
$bytes = [System.Text.Encoding]::UTF8.GetBytes($smSoapMessage)
$WDRequest.ContentLength = $bytes.Length
$RequestStream = $WDRequest.GetRequestStream()
$RequestStream.Write($bytes, 0, $bytes.Length)
$RequestStream.Close()
$WDResponse = $WDRequest.GetResponse()
$ResponseStream = $WDResponse.GetResponseStream()
$ResponseXmlDoc = new-object System.Xml.XmlDocument
$ResponseXmlDoc.Load($ResponseStream)
$DisplayNameNodes = @($ResponseXmlDoc.getElementsByTagName("t:DisplayName"))
$ExtenedPropertyField = @($ResponseXmlDoc.getElementsByTagName("t:Value"))
$FolderIdNodes = @($ResponseXmlDoc.getElementsByTagName("t:FolderId"))
$ParentFolderIdNodes =
@($ResponseXmlDoc.getElementsByTagName("t:ParentFolderId"))
$ChildFolderCountNodes =
@($ResponseXmlDoc.getElementsByTagName("t:ChildFolderCount"))
$TotalItemCountNodes = @($ResponseXmlDoc.getElementsByTagName("t:TotalCount"))
for($i=0;$i -lt $DisplayNameNodes.Count;$i++){
if ($DisplayNameNodes[$i].'#text' -eq "Top of Information Store"){$rootFolderID
= $FolderIdNodes[$i].GetAttributeNode("Id").'#text'}
$fiFolderID = $FolderIdNodes[$i].GetAttributeNode("Id")
$pfParentFolderID = $ParentFolderIdNodes[$i].GetAttributeNode("Id")
$fsTable.Rows.Add($DisplayNameNodes[$i].'#text',$fiFolderID.'#text',$pfParentFolderID.'#text',$ExtenedPropertyField[$i].'#text',$ChildFolderCountNodes[$i].'#text',$TotalItemCountNodes[$i].'#text')
}
$fsFilterString = "ParentID = '" + $rootFolderID + "'"
$rrRootFolders = $fstable.select($fsFilterString)
for($fcount = 0;$fcount -le $rrRootFolders.GetUpperBound(0); $fcount++){
if ($rrRootFolders[$fcount][0] -ne "Top of Information Store"){
$global:fldSize = $rrRootFolders[$fcount][3]
$global:itemCount = $rrRootFolders[$fcount][5]
if ($rrRootFolders[$fcount][4] -ne 0){
enumFolderSizes($rrRootFolders[$fcount][1])
}
$item1 = new-object
System.Windows.Forms.ListViewItem($rrRootFolders[$fcount][0])
$item1.SubItems.Add($global:itemCount)
$item1.SubItems.Add([math]::round(($fldsize/1mb),2))
if ($rrRootFolders[$fcount][4] -ne 0){
$item1.SubItems.Add("Yes")
}
else {
$item1.SubItems.Add("No")
}
$item1.SubItems.Add($rrRootFolders[$fcount][1])
$lbFldListView.items.add($item1)
}
}

$form.Controls.Add($lbFldListView)
}
$form = new-object System.Windows.Forms.form
$global:LastFolder = ""
# Add DataTable

$Dataset = New-Object System.Data.DataSet
$fsTable = New-Object System.Data.DataTable
$fsTable.TableName = "Folder Sizes"
$fsTable.Columns.Add("DisplayName")
$fsTable.Columns.Add("FolderID")
$fsTable.Columns.Add("ParentID")
$fsTable.Columns.Add("Size)",[int])
$fsTable.Columns.Add("ChildFolderCount",[int])
$fsTable.Columns.Add("TotalCount",[int])
$Dataset.tables.add($fsTable)

# Add Server DropLable
$snServerNamelableBox = new-object System.Windows.Forms.Label
$snServerNamelableBox.Location = new-object System.Drawing.Size(10,20)
$snServerNamelableBox.size = new-object System.Drawing.Size(100,20)
$snServerNamelableBox.Text = "ServerName"
$form.Controls.Add($snServerNamelableBox)

# Add Server Drop Down
$snServerNameDrop = new-object System.Windows.Forms.ComboBox
$snServerNameDrop.Location = new-object System.Drawing.Size(130,20)
$snServerNameDrop.Size = new-object System.Drawing.Size(130,30)
get-mailboxserver | ForEach-Object{$snServerNameDrop.Items.Add($_.Name)}
$snServerNameDrop.Add_SelectedValueChanged({getMailboxSizes})
$form.Controls.Add($snServerNameDrop)

# Add List Box to DisplayMailboxs


$lbListView = new-object System.Windows.Forms.ListView
$lbListView.Location = new-object System.Drawing.Size(10,50)
$lbListView.size = new-object System.Drawing.Size(400,500)
$lbListView.LabelEdit = $True
$lbListView.AllowColumnReorder = $True
$lbListView.CheckBoxes = $False
$lbListView.FullRowSelect = $True
$lbListView.GridLines = $True
$lbListView.View = "Details"
$lbListView.Sorting = "Ascending"
$lbListView.add_click({GetFolderSizes($this.SelectedItems.item(0).subitems[4].text)});



# Add List Box to Display FolderSizes


$lbFldListView = new-object System.Windows.Forms.ListView
$lbFldListView.Location = new-object System.Drawing.Size(500,50)
$lbFldListView.size = new-object System.Drawing.Size(400,500)
$lbFldListView.LabelEdit = $True
$lbFldListView.AllowColumnReorder = $True
$lbFldListView.FullRowSelect = $True
$lbFldListView.GridLines = $True
$lbFldListView.View = "Details"
$lbFldListView.Sorting = "Ascending"
$lbFldListView.add_click({GetSubFolderSizes($this.SelectedItems.item(0).subitems[4].text)});


# UP folder Button

$upButton = new-object System.Windows.Forms.Button
$upButton.Location = new-object System.Drawing.Size(500,19)
$upButton.Size = new-object System.Drawing.Size(120,23)
$upButton.Text = "Back Folder level"
$upButton.visible = $false
$upButton.Add_Click({BackFolder})
$form.Controls.Add($upButton)

$form.Text = "Exchange 2007 Mailbox Size Form"
$form.size = new-object System.Drawing.Size(1000,600)
$form.autoscroll = $true
$form.topmost = $true
$form.Add_Shown({$form.Activate()})
$form.ShowDialog()

Tuesday, May 01, 2007

Resource Mailbox availability web page for Exchange 2007

One of the coolest new things about Exchange Web Services on Exchange 2007 is the GetUserAvailability operation. This operation gives you the ability to get the Free-busy information about a number of users with one request and also not just only whether the users are free or busy which by itself has limited use but where this adds value is that you can also request to see the basic information about the calendar appointments a user is involved in. This makes it a great building block for any small team calendars or collaborative apps you are trying to build. It’s also good if you want to build availability pages for resource mailboxes which is what I’ve used it for in this post.

To provide information in a Internet portal what i put together was an Asp.net page that first makes a request to the Find Room WebService I posted the other day. This WebService returns a list of Email Address’s and DisplayName’s which can then be used in a GetUserAvailability request which will then retrieve the freebusy times for the mailboxes returned from the Find Room Query and the detail of those appointments. To display the appointments to the user I’ve used a datagrid which uses as a datasource a datatable created from the result of the GetUserAvailability operation that is formatted specifically in a time Grid. To do specific row formatting and color changes and row spans I’ve used the data-binding event to map alternate colors for each Meeting and change row span setting to the number of hours an appointment is scheduled for. This produces something that looks like the following

The code is set to query a time period within one day eg business hours from 8 AM - 6 PM (you can adjust this using variables in the code).To cater for many combinations the logic in the code allows for all day appointments, appointments that start before the time period and appointments that end after the time period and as many other scenarios I could think of. The codes designed to run around the default 30 minute interval period it can be adapted for other intervals but requires a little bit more logic.

The Anatomy of code is first there is a stub to deal with self signed certs (this needs to be extended out a bit in production). Then the FindRoom sub runs which returns all the rooms in AD. The Freebusy request timezone information is then configured as per my other post the other day. The results are format into a Datatable which is then bound to the datagrid. To do the default Table formatting I’ve used a Style sheet and then for the specific formatting of each of the appointments this is done though the databinding event for each row in the datagrid.

Before using the Code you need to configure the following variables either via the code of via a webConfig file. To use the GetUserAvailability Operation you need make the request with a security context of a user that either has a mailbox or has been granted impersonation rights. The ServerName is the server that is hosting EWS.

String unUserName = "usrName";
String pnPassWord = "password";
String dnDomain = "domain";
String snServerName = "CASservername";
String stStartTime = "08:00:00";
String etEndTime = "18:00:00";

I’ve put a downloadable copy of the code and Asp.net page here the code itself looks

private struct SYSTEMTIME
{
public Int16 wYear;
public Int16 wMonth;
public Int16 wDayOfWeek;
public Int16 wDay;
public Int16 wHour;
public Int16 wMinute;
public Int16 wSecond;
public Int16 wMilliseconds;
public void getSysTime(byte[] Tzival, int offset)
{
wYear = BitConverter.ToInt16(Tzival, offset);
wMonth = BitConverter.ToInt16(Tzival, offset + 2);
wDayOfWeek = BitConverter.ToInt16(Tzival, offset + 4);
wDay = BitConverter.ToInt16(Tzival, offset + 6);
wHour = BitConverter.ToInt16(Tzival, offset + 8);
wMinute = BitConverter.ToInt16(Tzival, offset + 10);
wSecond = BitConverter.ToInt16(Tzival, offset + 12);
wMilliseconds = BitConverter.ToInt16(Tzival, offset + 14);
}
}
private struct REG_TZI_FORMAT
{
public Int32 Bias;
public Int32 StandardBias;
public Int32 DaylightBias;
public SYSTEMTIME StandardDate;
public SYSTEMTIME DaylightDate;
public void regget(byte[] Tzival)
{
Bias = BitConverter.ToInt32(Tzival, 0);
StandardBias = BitConverter.ToInt32(Tzival, 4);
DaylightBias = BitConverter.ToInt32(Tzival, 8);
StandardDate = new SYSTEMTIME();
StandardDate.getSysTime(Tzival, 12);
DaylightDate = new SYSTEMTIME();
DaylightDate.getSysTime(Tzival, 28);
}


String unUserName = "username";
String pnPassWord = "password";
String dnDomain = "domain";
String snServerName = "servername";
String stStartTime = "08:00:00";
String etEndTime = "18:00:00";

//Deal with Self Signed Certificate Errors
ServicePointManager.ServerCertificateValidationCallback = delegate(Object obj,
X509Certificate certificate, X509Chain chain, SslPolicyErrors errors)
{
return true;
};

DataTable raDataTable = new DataTable();
raDataTable.Columns.Add("Time");
//Define FreeBusy Connection
ExchangeServiceBinding ewsServiceBinding = new ExchangeServiceBinding();
ewsServiceBinding.Credentials = new NetworkCredential(unUserName, pnPassWord ,dnDomain
);
ewsServiceBinding.Url = @"https://" + snServerName + "/EWS/exchange.asmx";
Duration fbDuration = new Duration();
fbDuration.StartTime = DateTime.ParseExact(DateTime.Now.ToString("yyyyMMdd") +
"T" + stStartTime, "yyyyMMddTHH:mm:ss", null);
fbDuration.EndTime = DateTime.ParseExact(DateTime.Now.ToString("yyyyMMdd") + "T"
+ etEndTime , "yyyyMMddTHH:mm:ss", null);
int itIntevalNum = DateTime.Compare(fbDuration.StartTime, fbDuration.EndTime);

//Deal with timeZone in Request
String tzString = @"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\" + TimeZone.CurrentTimeZone.StandardName;
RegistryKey TziRegKey = Registry.LocalMachine;
TziRegKey = TziRegKey.OpenSubKey(tzString);
byte[] Tzival = (byte[])TziRegKey.GetValue("TZI");
REG_TZI_FORMAT rtRegTimeZone = new REG_TZI_FORMAT();
rtRegTimeZone.regget(Tzival);
GetUserAvailabilityRequestType fbRequest = new GetUserAvailabilityRequestType();
fbRequest.TimeZone = new SerializableTimeZone();
fbRequest.TimeZone.DaylightTime = new SerializableTimeZoneTime();
fbRequest.TimeZone.StandardTime = new SerializableTimeZoneTime();
fbRequest.TimeZone.Bias = rtRegTimeZone.Bias;
fbRequest.TimeZone.StandardTime.Bias = rtRegTimeZone.StandardBias;
fbRequest.TimeZone.DaylightTime.Bias = rtRegTimeZone.DaylightBias;
if (rtRegTimeZone.StandardDate.wMonth != 0)
{
fbRequest.TimeZone.StandardTime.DayOfWeek = ((DayOfWeek)rtRegTimeZone.StandardDate.wDayOfWeek).ToString();
fbRequest.TimeZone.StandardTime.DayOrder = (short)rtRegTimeZone.StandardDate.wDay;
fbRequest.TimeZone.StandardTime.Month = rtRegTimeZone.StandardDate.wMonth;
fbRequest.TimeZone.StandardTime.Time = String.Format("{0:0#}:{1:0#}:{2:0#}", rtRegTimeZone.StandardDate.wHour, rtRegTimeZone.StandardDate.wMinute, rtRegTimeZone.StandardDate.wSecond);
}
else
{
fbRequest.TimeZone.StandardTime.DayOfWeek = "Sunday";
fbRequest.TimeZone.StandardTime.DayOrder = 1;
fbRequest.TimeZone.StandardTime.Month = 1;
fbRequest.TimeZone.StandardTime.Time = "00:00:00";

}
if (rtRegTimeZone.DaylightDate.wMonth != 0)
{
fbRequest.TimeZone.DaylightTime.DayOfWeek = ((DayOfWeek)rtRegTimeZone.DaylightDate.wDayOfWeek).ToString();
fbRequest.TimeZone.DaylightTime.DayOrder = (short)rtRegTimeZone.DaylightDate.wDay;
fbRequest.TimeZone.DaylightTime.Month = rtRegTimeZone.DaylightDate.wMonth;
fbRequest.TimeZone.DaylightTime.Time = "00:00:00";
}
else
{
fbRequest.TimeZone.DaylightTime.DayOfWeek = "Sunday";
fbRequest.TimeZone.DaylightTime.DayOrder = 5;
fbRequest.TimeZone.DaylightTime.Month = 12;
fbRequest.TimeZone.DaylightTime.Time = "23:59:59";

}
fbRequest.MailboxDataArray = mbMailboxes;
fbRequest.FreeBusyViewOptions = fbViewOptions;
GetUserAvailabilityResponseType fbResponse = ewsServiceBinding.GetUserAvailability(fbRequest);
System.TimeSpan ftsTimeSpan = fbDuration.EndTime - fbDuration.StartTime;
double frspan = ftsTimeSpan.TotalMinutes / 30;
int tsseg = 0;
for (DateTime htStartTime = fbDuration.StartTime; htStartTime <
fbDuration.EndTime; htStartTime = htStartTime.AddMinutes(30))
{
DataRow drDataRow = raDataTable.NewRow();
drDataRow[0] = htStartTime.ToString("HH:mm");
for (int mbNumCount = 0; mbNumCount < mbMailboxes.Length; mbNumCount++)
{
rvRowValue =
fbResponse.FreeBusyResponseArray[mbNumCount].FreeBusyView.MergedFreeBusy.Substring(tsseg,
1);
if (rvRowValue != "0") {
foreach (CalendarEvent calevent in
fbResponse.FreeBusyResponseArray[mbNumCount].FreeBusyView.CalendarEventArray) {
System.TimeSpan tsTimeSpan = calevent.EndTime - calevent.StartTime;
double rspan = tsTimeSpan.TotalMinutes / 30;
if (htStartTime.ToString("HH:mm") == fbDuration.StartTime.ToString("HH:mm"))
{
if (rspan >= 48)
{
if (calevent.CalendarEventDetails != null)
{
if (calevent.CalendarEventDetails.Subject != "")
{
rvRowValue = frspan + " " + calevent.CalendarEventDetails.Subject;
}
else {
rvRowValue = frspan + " Occupied";
}

}
else
{
rvRowValue = frspan + " Occupied";
}

}
else if (calevent.StartTime < fbDuration.StartTime)
{
System.TimeSpan stTimeSpan = fbDuration.StartTime - calevent.StartTime;
double stspan = stTimeSpan.TotalMinutes / 30;
if (calevent.CalendarEventDetails != null)
{
if (calevent.CalendarEventDetails.Subject != "")
{
rvRowValue = (rspan - stspan) + " " + calevent.CalendarEventDetails.Subject;
}
else {
rvRowValue = (rspan - stspan) + " Occupied";
}
}
else
{
rvRowValue = (rspan - stspan) + " Occupied";
}
}
}
if (htStartTime == calevent.StartTime)
{
if (calevent.CalendarEventDetails != null)
{
if (calevent.CalendarEventDetails.Subject != "")
{
rvRowValue = rspan.ToString() + " " + calevent.CalendarEventDetails.Subject;
}
else {
rvRowValue = rspan.ToString() + " Occupied";
}
}
else {
rvRowValue = rspan.ToString() + " Occupied";
}
}
}
}
drDataRow[mbNumCount + 1] = rvRowValue;
}
raDataTable.Rows.Add(drDataRow);
tsseg++;
}
dgDataGrid.DataSource = raDataTable;
dgDataGrid.DataBind();
}
public void dgDataGrid_RowDataBound(object sender, GridViewRowEventArgs e)
{
if (e.Row.RowType == DataControlRowType.DataRow)
{
e.Row.Cells[0].BackColor = Color.LightGray;
e.Row.Cells[0].Font.Bold = true;
for (int cnColNumber = 1; cnColNumber < e.Row.Cells.Count;cnColNumber++ ){
e.Row.Cells[cnColNumber].Width = 150;
if (e.Row.Cells[cnColNumber].Text.Substring(0,1) != "0") {
if ((cnColNumber % 2) == 0)
{
e.Row.Cells[cnColNumber].BackColor = Color.LightGreen;
}
else {
e.Row.Cells[cnColNumber].BackColor = Color.LightBlue;
}
if (e.Row.Cells[cnColNumber].Text.Length > 2)
{
string rspan = e.Row.Cells[cnColNumber].Text.Substring(0, 2).ToString();
e.Row.Cells[cnColNumber].Text = e.Row.Cells[cnColNumber].Text.Substring(2,
(e.Row.Cells[cnColNumber].Text.Length - 2));
e.Row.Cells[cnColNumber].RowSpan = Convert.ToInt16(rspan);
}
else
{
e.Row.Cells[cnColNumber].Visible = false;
e.Row.Cells[cnColNumber].Text = " ";
}
}
else {e.Row.Cells[cnColNumber].Text = " ";
}
}
}
}