Monday, November 22, 2004

Setting the Appointment Label Text Programmatically

Last week I blogged this Appointment label Colour Changing Event Sink and I mentioned that the appointment label text is located in the property in an undocumented binary form. Well I had a crack at working out what that format is this week and I've come up with the following sample.

Before I start though I must give the following warning, the following piece of code and method is completely unsupported and completely untested. Playing around with binary properties is very unwise unless you really have a good enough grasp to be able to undo any damage you may do trying to set them. The third and last bit is that this will only work if your using the ASCII character set. If you're using other types of character sets (eg a lot of Asian character sets) this wont work.

Because this property is stored in a binary format to work with this in VBS we need something that can read binary and convert it to a hex string which makes it usable. For this I've used Arrayconvert out of this KB article. This library works well and it free and easy to use, the only thing it doesn't do is convert directly a string to hex but you can do this indirectly by first converting the sting to binary and then to hex.

So when no customizations have been made to the labels this property is set to a hex value of 44 Zero's (I know this is not a proper explanation of binary). Or as I'm going to deal with it in the script its 11 groups of "0000". As we have 10 labels then 10 of these groups represent a spacer for each label and the lasts group represents the padding to begin. These groups of 0's are constants in this property they only change in location in relation to the text that's being inserted into the labels.

So the major task that this script does is builds the hex string to be inserted into the property. The first thing it does is sets up a 10 element array to hold all the spacer values for each label. (We already know that this property is going to start with "0000"). The next thing it does is setups up a 10 element array to hold the values for all the customized label texts.

The next part of code then loops through the spacer array and checks to see if any text is going to be inserted from the corresponding label array. If text has been set in that label array element it then first converts the text to a hex string (by way of converting it to binary then back to hex). Then because each character is given 4 digits for storage and USASCII only uses the first 2 digits the hex string is split apart and each hex character representation is padded with "00".

So what we end up with is a hex string representing all the values and spacers that need to be set. Some Exoledb/ADO code is then used to set the x36DC0102 property using the arrayconvert library to convert this hex string into the octent Variant Array of bytes needed for this property.

Thats it as I said you should view this code as experimental and highly suspect. I've posted a downloadable copy of the code here. In my example I'm only setting the two values for blue and green to Internal and External. Eg.

dim objspcarray(9)
dim objlabelarray(9)
set rec = createobject("ADODB.Record")
Set cnvt = CreateObject("ADs.ArrayConvert")
objspcarray(0) = "0000"
objspcarray(1) = "0000"
objspcarray(2) = "0000"
objspcarray(3) = "0000"
objspcarray(4) = "0000"
objspcarray(5) = "0000"
objspcarray(6) = "0000"
objspcarray(7) = "0000"
objspcarray(8) = "0000"
objspcarray(9) = "0000"
objlabelarray(0) = ""
objlabelarray(1) = "External"
objlabelarray(2) = "Internal"
objlabelarray(3) = ""
objlabelarray(4) = ""
objlabelarray(5) = ""
objlabelarray(6) = ""
objlabelarray(7) = ""
objlabelarray(8) = ""
objlabelarray(9) = ""
dstring = "0000"
for i = lbound(objspcarray) to ubound(objspcarray)
if objlabelarray(i) <> "" then
objtooct = cnvt.CvStr2vOctetStr(objlabelarray(i))
objtohex = cnvt.CvOctetStr2vHexStr(objtooct)
for h = 1 to len(objtohex)/2
dstring = dstring & mid(objtohex,((h*2)-1),2) & "00"
end if
dstring = dstring & objspcarray(i)
wscript.echo dstring "file://./backofficestorage/domain/mbx/mailbox/calendar",,3
rec.fields("").Value = cnvt.CvHexStr2vOctetStr(dstring)

Monday, November 15, 2004

Appointment label Colour Changing Event Sink

[2/2/2005 updated this post and script to use named property instead the custom Mapi prop]

One of the cool features that was implemented in Outlook 2002 was the ability to change the colour of appointment labels to help distinguish between different types of appointments. (see for a good description of this feature). But because of the laziness factor I find that I rarely use this feature because I usually forget to set it. One of the things that I really wanted this to do also was be able to show me at a glace which meetings in my calendar where internal meeting (only contained internal attendees) and which meeting contained external attendees (this can be usefull in the morning). Putting this into an event sink turned out to be a really easy solution. All I needed was some code that would go though the attendees collection of a appointment object when the appointment was created and check each of the address's of the attendees to see if they where local address's or external. I leaned on the side of low tech and just decided to go for a match against one local domain. The property that controls the appointment colour is{00062002-0000-0000-C000-000000000046}/0x8214 and there are 10 integers (data type needs to be long) you can pass to it representing the different colours available in Outlook. I decided to go for blue for external meeting and green for internal meeting. The other check the code performs is to check the number of attendees in the appointment this is because I only wanted it to work on meeting or appointments where someone else other then me was attending. NOTE: I’ve restricted this sink so it only takes action on newly created appointments this is because a sink that updates properties on an existing message can be pretty dangerous. If you look at the logic when the sink fires it updates properties on the message and saves that message which then causes the sink to fire again and again and before you know it your transaction logs are full and the store is dismounted (Doh!)

The appointment label text provides a bit more of a challenge its located in the property in an undocumented binary form, although on first look it doesn’t appear that daunting it looks like its just in byte format padded with a few zeros but this is a challenge for another day.
The code for the sink looks like this, Ive posted a copy up here


Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

Const EVT_NEW_ITEM = 1

If (lFlags And EVT_IS_DELIVERED) Or (lFlags And EVT_NEW_ITEM) Then

chgappt = 0
LocalSearchdomain = ""
set apptobj = createobject("CDO.Appointment") bstrURLItem,,3
cval = apptobj.fields("{00062002-0000-0000-C000-000000000046}/0x8214")
if apptobj.Attendees.count > 1 then
for each attend in apptobj.Attendees
if instr(lcase(attend.address),LocalSearchdomain) = 0 then
chgappt = 1
end if
if chgappt = 1 then
if cavl <> 2 then
apptobj.fields("{00062002-0000-0000-C000-000000000046}/0x8214") = clng(2)
end if
if cavl <> 3 then
apptobj.fields("{00062002-0000-0000-C000-000000000046}/0x8214") = clng(3)
end if
end if
end if
apptobj = nothing

end if

End Sub


Monday, November 08, 2004

Deleting old email with a Exoledb Script

This question pops up now and again from people who want to be able to scheduled a script that will delete mail in a folder that was received more then say 30 days ago. Typically this could be used on a postmaster mailbox (hopefully people are reading these mails before they get deleted) or on a mailbox that is doing auto replies when you want to keep the original emails for a period of time. Going about this is quite simple in Exoeldb all you really need to do is query on the desired folder for all the mail where the urn:schemas:httpmail:datereceived is older then 30 days. Once you have all these mails in a record set you can loop though the recordset and delete the email. The thing to remember when you are deleting mail this way is that the deleted mail goes into the dumpster of whatever folder you are deleting them from

mailboxurl = "file://./backofficestorage/yourdomain/MBX/mailbox/inbox"
set Rec = CreateObject("ADODB.Record")
set Rs = CreateObject("ADODB.Recordset")
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
SSql = "SELECT ""DAV:href"", ""DAV:contentclass"" FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE (""urn:schemas:httpmail:datereceived"" < CAST(""" & isodateit(now()-31) & """ as 'dateTime')) AND ""DAV:isfolder"" = false"
SSql = SSql & " AND ""DAV:contentclass"" = 'urn:content-classes:message'"
Rs.CursorLocation = 2 'adUseServer = 2, adUseClient = 3 SSql, rec.ActiveConnection, 3
while not rs.eof
rs.delete 1

function isodateit(datetocon)
strDateTime = year(datetocon) & "-"
if (Month(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime & Month(datetocon) & "-"
if (Day(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime & Day(datetocon) & "T" & formatdatetime(datetocon,4) & ":00Z"
isodateit = strDateTime
end function

If you want to go a step further with the script and crawl each folder in a mailbox to delete old content then you can combine this with one of the scripts from;en-us;320071 which gives you a method of enumerating every folder in a mailbox. Then you just call out an archive sub for each folder. This script gets a bit lengthy I’ve put an example of this as well as the other script from the article up here. As these scripts delete things great care should be always taken when using and testing scripts of this nature. Make sure you have adequately configured Deleted item retention rates and working backups, if you’re not sure what either of these things are don’t use the scripts (and seek help).

Monday, November 01, 2004

Finding what Resources are being used from a Meeting Request

I've blogged about resources in meetings before but this question came up last week about how do you tell which resources have been booked from a calendar request message(meeting invitation). When someone creates a meeting the resources that are booked (or attempting to be booked) with the meeting get stored in the BCC field of the appointment object. In the calendar request messages (invitations) that go out to the users (and resource mailboxes if your using some sort of auto accept system) the resources aren't included in the calendar request message (not even in the recipients collection even when the resource mailbox is receiving the calendar request). If you use Outlook to do the booking it does copy the resources display name into the location property but with OWA the location field is left blank unless the user specifically enters something . So from a calendar request message you received from a meeting organized by OWA how could you tell which resources where being booked with that meeting.

Here are a couple of methods that may help

The Mapi property 0x8167001E lists all the displaynames of attendees of a meeting and this seems to include all the resources as well. So what you can do is grab this property do a split on it to get the entries into an array. Loop though the array and check if each address is in the To or CC field of the appointment and if its not then its a resource. eg

Set iCalMsg = CreateObject("CDO.Message") "itemurl"
recplist =
recparray = split(recplist,";",-1,1)
for i = lbound(recparray) to ubound(recparray)
if instr(iCalMsg.fields(""),recparray(I)) then
if instr(iCalMsg.fields(""),recparray(I)) then
wscript.echo recparray(I)
end if
end if

Another method you can use is if you loop though the attendees collection of the appointment associated with the calendar request you can find the organizer of the appointment. Once you know the organizer of the appointment you can then use this along with the urn:schemas:calendar:uid field which uniquely identifies each appointment to call the GetAssociatedItem method of the calendar item. This will (if you have the rights to) connect to the organizers mailbox and then retrieve the master appointment object which will contain resources in the attendees collection . This all uses CDOEX and CDOEXM and the file URL scheme so for this to work the resource mailbox and organizers mailbox has have be on the same server.

Set iCalMsg = CreateObject("CDO.CalendarMessage") "itemurl"
For Each iCalPart In iCalMsg.CalendarParts
Set iAppt = iCalPart.GetUpdatedItem
cuid1 = iAppt.fields("urn:schemas:calendar:uid")
for each attend in iAppt.Attendees
if attend.IsOrganizer <> 0 then
Set Person = CreateObject("CDO.Person")
strURL = attend.address
Person.DataSource.Open strURL
Set Mailbox = Person.GetInterface("IMailbox")
set iAppt1 = iCalPart.GetAssociatedItem(Mailbox.calendar)
for each attend1 in iAppt1.Attendees
 wscript.echo attend1.address
 wscript.echo attend1.role
 wscript.echo attend1.status
 wscript.echo attend1.type
end if

If you wanted to use the second method but the mailboxes are on separate servers then something similar can be done using three webDAV queries and some ADSI. The following example first grabs the calendar message using a WebDAV GET and parses the organizer of the meeting out of the vCalendar body part and also the calendar UID. An ADSI query is then performed using the SMTP address of the organizer to retrieve the msExchHomeServerName property which tells you which server the mailbox is on. A second WebDAV search is then done of the organizers calendar based on the Calender UID of the appointment. This should then locate the original appointment which is then retrieved using a WebDAV GET. The resource mailbox (or mailbox's) SMTP address's are then parsed out of the vCalendar body part.
I've posted a copy of all the scripts from this post here

set Req = createobject("Microsoft.XMLHTTP") "GET","http://server/exchange/mailbox/inbox/calandermessage.EML",false
Req.setRequestHeader "Translate","f"
attendeearry = split(req.responsetext,"ORGANIZER;",-1,1)
for i = 1 to ubound(attendeearry)
string1 = vbcrlf & " "
stparse = replace(attendeearry(i),string1,"")
attaddress = mid(stparse,(instr(stparse,"MAILTO:")+7),instr(stparse,chr(13)))
attaddress = mid(attaddress,1,(instr(attaddress,vbcrlf)-1))
uidarry = mid(req.responsetext,instr(req.responsetext,"UID:")+3,len(req.responsetext))
string1 = vbcrlf & " "
stparse = replace(uidarry,string1,"")
uidprop = mid(stparse,2,instr(stparse,vbcrlf))
uidprop = replace(uidprop,vbcrlf,"")
CUserID = replace(attaddress," ","")
Set objDNS = CreateObject("ADSystemInfo")
DomainName = LCase(objDNS.DomainDNSName)
Set oRoot = GetObject("LDAP://" & DomainName & "/rootDSE")
strDefaultNamingContext = oRoot.get("defaultNamingContext")
GALQueryFilter = "(&(&(&(& (mailnickname=*) (|
)))(objectCategory=user)(mail=" & CUserID & ")))"
strQuery = "<LDAP://" & DomainName & "/" & strDefaultNamingContext & ">;" &
GALQueryFilter &
Set oConn = CreateObject("ADODB.Connection") 'Create an ADO Connection
oConn.Provider = "ADsDSOOBJECT" ' ADSI OLE-DB provider
oConn.Open "ADs Provider"

Set oComm = CreateObject("ADODB.Command") ' Create an ADO Command
oComm.ActiveConnection = oConn
oComm.Properties("Page Size") = 1000
oComm.CommandText = strQuery

Set rs = oComm.Execute

server =
mailbox = attaddress
strURL = "http://" & server & "/exchange/" & mailbox & "/calendar/"
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""DAV:href"" FROM scope('shallow traversal
of """
strQuery = strQuery & strURL & """') Where ""urn:schemas:calendar:uid"" = '" &
uidprop & "'</D:sql></D:searchrequest>"
set req = createobject("microsoft.xmlhttp") "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
For i = 0 To (oNodeList.length -2)
set oNode = oNodeList.nextNode
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
wscript.echo "Response text: " & req.responsetext
End If

sub proccalmess(objhref) "GET", objhref, false
Req.setRequestHeader "Translate","f"
attendeearry = split(req.responsetext,"ATTENDEE;",-1,1)
for i = 1 to ubound(attendeearry)
string1 = vbcrlf & " "
stparse = replace(attendeearry(i),string1,"")
attaddress = mid(stparse,(instr(stparse,"MAILTO:")+7),instr(stparse,chr(13)))
attaddress = mid(attaddress,1,instr(attaddress,vbcrlf))
if instr(stparse,"=RESOURCE") then
wscript.echo attaddress
end if

end sub