When recently building an Intranet portal site I needed a way of retrieving a user's Outlook calendar (which were stored on the Microsoft Exchange server). Due to infrastructure reasons it seemed the best way for me to get to this information was to use Exchange ActiveSync.
Exchange ActiveSync allows over-the-air syncing termed "AirSync" and is used mainly by mobile devices. It uses HTTP POST (with or without SSL) to send/receive data (see:
[MS-ASHTTP]) and consists of several commands (see:
[MS-ASCMD]) which use WBXML encoded XML body content to convey data (see: [
MS-ASWBXML]).
There are many other accompanying documents which expand on various parts of the protocol, which can be found on the MSDN website under
Exchange Server Protocol Documents.
Because this is mainly used in mobile development there is very little information or examples of how to use the protocol in a .NET environment, so I thought it would be useful to share my code here for future reference.
I wrote an AirSyncHelper class which can be instantiated with server details and credentials to then send and receive XML data with your chosen ActiveSync command:
Namespace Email.Exchange.AirSync
Public Class AirSyncHelper
Public Const AirSyncSupportedVersion As String = "2.5"
Private _asCodePages As Dictionary(Of Integer, EncodingHelpers.WBXML.WbXmlCodepage)
Private ReadOnly Property ASCodePages() As Dictionary(Of Integer, EncodingHelpers.WBXML.WbXmlCodepage)
Get
If _asCodePages Is Nothing Then
InitAirSyncCodepages()
End If
Return _asCodePages
End Get
End Property
Private _asHostAddress As String
Private Property ASHostAddress() As String
Get
Return _asHostAddress
End Get
Set(ByVal value As String)
_asHostAddress = value
If _asHostAddress.EndsWith("/") Then _asHostAddress = _asHostAddress.Substring(0, _asHostAddress.Length - 1)
End Set
End Property
Private _asUsername As String
Private Property ASUsername() As String
Get
Return _asUsername
End Get
Set(ByVal value As String)
_asUsername = value
End Set
End Property
Private _loginUsername As String
Private Property LoginUsername() As String
Get
Return _loginUsername
End Get
Set(ByVal value As String)
_loginUsername = value
End Set
End Property
Private _loginDomain As String
Private Property LoginDomain() As String
Get
Return _loginDomain
End Get
Set(ByVal value As String)
_loginDomain = value
End Set
End Property
Private _loginPassword As String
Private Property LoginPassword() As String
Get
Return _loginPassword
End Get
Set(ByVal value As String)
_loginPassword = value
End Set
End Property
Private _policyKey As String = ""
Private Property PolicyKey() As String
Get
Return _policyKey
End Get
Set(ByVal value As String)
_policyKey = value
End Set
End Property
Private ReadOnly Property ActiveSyncBaseAddress() As String
Get
Return _asHostAddress & "/Microsoft-Server-ActiveSync/"
End Get
End Property
Public Sub New(ByVal hostAddress As String, ByVal username As String, ByVal password As String, ByVal domain As String)
ASHostAddress = hostAddress
ASUsername = username
LoginUsername = username
LoginDomain = domain
LoginPassword = password
End Sub
Public Function IsVersionCompatible() As Boolean
Dim optReq As System.Net.HttpWebRequest = GetAirSyncWebRequest("")
optReq.Method = "OPTIONS"
Dim optResp As System.Net.HttpWebResponse = CType(optReq.GetResponse(), System.Net.HttpWebResponse)
If optResp.StatusCode = 200 Then
Dim msAsProtocolVersions As String = optResp.Headers("MS-ASProtocolVersions")
If Not String.IsNullOrEmpty(msAsProtocolVersions) Then
Dim supportedVersions As String() = msAsProtocolVersions.Split(","c)
If supportedVersions.Contains(AirSyncSupportedVersion) Then
Return True
End If
End If
End If
Return False
End Function
Public Sub ObtainPolicyKey()
Dim policyType As String = ""
If CDbl(AirSyncSupportedVersion) >= 12 Then
policyType = "MS-EAS-Provisioning-WBXML"
Else
policyType = "MS-WAP-Provisioning-XML"
End If
Dim opkXml As String = <?xml version="1.0" encoding="utf-8"?>
<Provision xmlns="Provision:" xmlns:settings="Settings:">
<Policies>
<Policy>
<PolicyType>{PolicyType}</PolicyType>
</Policy>
</Policies>
</Provision>.ToString().Replace("{PolicyType}", policyType)
Dim opkResult As System.Xml.XmlDocument = ExecuteAirSyncCommand("Provision", opkXml)
If opkResult IsNot Nothing Then
Dim opkNsMgr As New Xml.XmlNamespaceManager(opkResult.NameTable)
opkNsMgr.AddNamespace("dflt", Codepages.Provision_14.Instance.XmlNs)
opkNsMgr.AddNamespace(Codepages.Settings_18.Instance.XmlPrefix, Codepages.Settings_18.Instance.XmlNs)
Dim pkNode As System.Xml.XmlNode = opkResult.SelectSingleNode("dflt:Provision/dflt:Policies/dflt:Policy/dflt:PolicyKey", opkNsMgr)
If pkNode IsNot Nothing Then PolicyKey = pkNode.InnerText
End If
End Sub
Public Function ExecuteAirSyncCommand(ByVal command As String, ByVal xmlBody As String) As System.Xml.XmlDocument
Dim commandQuery As String = String.Format("?User={0}&DeviceId=CwWebDevice1234&DeviceType=PocketPC&Cmd={1}", ASUsername, command)
Dim execReq As System.Net.HttpWebRequest = GetAirSyncWebRequest(commandQuery)
execReq.Method = "POST"
execReq.Headers("MS-ASProtocolVersion") = AirSyncSupportedVersion
execReq.ContentType = "application/vnd.ms-sync.wbxml"
Dim transportData() As Byte = GetWbxmlFromXml(xmlBody)
execReq.ContentLength = transportData.Length
Dim requestStream As IO.Stream = execReq.GetRequestStream()
requestStream.Write(transportData, 0, transportData.Length)
requestStream.Close()
Dim execResp As System.Net.HttpWebResponse = CType(execReq.GetResponse(), System.Net.HttpWebResponse)
If execResp.StatusCode = 200 Then
Dim wbxmlRespDoc As New EncodingHelpers.WBXML.WbXmlDocument(ASCodePages)
wbxmlRespDoc.Load(execResp.GetResponseStream())
Return wbxmlRespDoc
Else
Throw New Exception("Status from server was not 200 (" & execResp.StatusCode & ")")
End If
End Function
Private Function GetAirSyncWebRequest(ByVal queryString As String) As System.Net.HttpWebRequest
Dim fullUrl As String = ActiveSyncBaseAddress & CStr(IIf(Not String.IsNullOrEmpty(queryString), queryString, ""))
Dim asReq As System.Net.HttpWebRequest = CType(System.Net.WebRequest.Create(fullUrl), System.Net.HttpWebRequest)
asReq.Credentials = New System.Net.NetworkCredential(LoginUsername, LoginPassword, LoginDomain)
asReq.UserAgent = "Microsoft-Server-AirSyncClient/2.5+(CraigW)"
asReq.KeepAlive = True
If Not String.IsNullOrEmpty(PolicyKey) Then asReq.Headers("X-MS-PolicyKey") = PolicyKey
Return asReq
End Function
Private Function GetWbxmlFromXml(ByVal xml As String) As Byte()
Dim wbxmlReqDoc As New EncodingHelpers.WBXML.WbXmlDocument(ASCodePages)
wbxmlReqDoc.LoadXml(xml)
Return wbxmlReqDoc.GetBytes()
End Function
Private Sub InitAirSyncCodepages()
_asCodePages = New Dictionary(Of Integer, EncodingHelpers.WBXML.WbXmlCodepage)
_asCodePages.Add(Codepages.AirSync_0.Instance.Codepage, Codepages.AirSync_0.Instance)
_asCodePages.Add(Codepages.Contacts_1.Instance.Codepage, Codepages.Contacts_1.Instance)
_asCodePages.Add(Codepages.Calendar_4.Instance.Codepage, Codepages.Calendar_4.Instance)
_asCodePages.Add(Codepages.FolderHierarchy_7.Instance.Codepage, Codepages.FolderHierarchy_7.Instance)
_asCodePages.Add(Codepages.Provision_14.Instance.Codepage, Codepages.Provision_14.Instance)
_asCodePages.Add(Codepages.AirSyncBase_17.Instance.Codepage, Codepages.AirSyncBase_17.Instance)
_asCodePages.Add(Codepages.Settings_18.Instance.Codepage, Codepages.Settings_18.Instance)
End Sub
End Class
End Namespace
As you will see the code relies on an encoder helper for the WBXML format. The WBXML format is, again, not well supported for .NET framework, however I did find a
C# sample by Tamir Khason on CodeProject. This example was a good starting point, as I was working in VB.NET on this project I first converted the code to VB.NET and (after fixing some issues caused by the converter) began modifying the code as, by the authors own admission, the code is not fully finished.
My changes are noted in the comments at the top of and throughout the code.
The new version of the class is shown below:
Imports System.Collections.Generic
Imports System.Text
Imports System.Xml
Imports System.IO
Imports System.Text.RegularExpressions
Namespace EncodingHelpers.WBXML
Friend Class WbXmlDocument
Inherits XmlDocument
Public VersionNumber As String = "1.3"
Public Charset As Encoding
Private GlobalTokens As Dictionary(Of Byte, String)
Private LocalAttributes As Dictionary(Of Integer, Dictionary(Of Byte, String))
Private LocalTokens As Dictionary(Of Integer, WbXmlCodepage)
Public Sub New()
MyBase.New()
initGlobalTokens()
End Sub
Public Sub New(ByVal tokens As Dictionary(Of Integer, WbXmlCodepage))
MyBase.New()
initGlobalTokens()
LocalTokens = tokens
LocalAttributes = New Dictionary(Of Integer, Dictionary(Of Byte, String))
End Sub
Public Sub New(ByVal tokens As Dictionary(Of Integer, WbXmlCodepage), ByVal attributes As Dictionary(Of Integer, Dictionary(Of Byte, String)))
MyBase.New()
initGlobalTokens()
LocalTokens = tokens
LocalAttributes = attributes
End Sub
Private Sub New(ByVal imp As XmlImplementation)
MyBase.New(imp)
End Sub
Private Sub New(ByVal nt As XmlNameTable)
MyBase.New(nt)
End Sub
Private Sub initGlobalTokens()
GlobalTokens = New Dictionary(Of Byte, String)()
Dim vals As String() = [Enum].GetNames(GetType(GlobalToken))
For i As Integer = 0 To vals.Length - 1
GlobalTokens.Add(CByte(CType([Enum].Parse(GetType(GlobalToken), vals(i)), GlobalToken)), vals(i))
Next
LocalTokens = New Dictionary(Of Integer, WbXmlCodepage)()
End Sub
Private Enum GlobalToken
SWITCH_PAGE = &H0
[END] = &H1
ENTITY = &H2
STR_I = &H3
LITERAL = &H4
EXT_I_0 = &H40
EXT_I_1 = &H41
EXT_I_2 = &H42
PI = &H43
LITERAL_C = &H44
EXT_T_0 = &H80
EXT_T_1 = &H81
EXT_T_2 = &H82
STR_T = &H83
LITERAL_A = &H84
EXT_0 = &HC0
EXT_1 = &HC1
EXT_2 = &HC2
OPAQUE = &HC3
LITERAL_AC = &HC4
End Enum
Private currentCodePage As Integer = 0
Public Overrides Sub Load(ByVal inStream As Stream)
Using reader As New StreamReader(inStream)
Load(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
reader.Close()
End Using
End Sub
Public Overloads Sub Load(ByVal WBXmlData As Byte())
Dim waitForAttr As Boolean = False
Dim waitForContent As Boolean = False
Dim openXmlTags As New Stack(Of String)
Dim codepagesUsed As New List(Of Integer)
If WBXmlData Is Nothing Then
Return
End If
Dim builder As New StringBuilder()
If WBXmlData.Length > 3 Then
VersionNumber = String.Format("1.{0}", WBXmlData(0))
Try
Charset = Encoding.GetEncoding(WBXmlData(2))
Catch
Charset = Encoding.UTF8
End Try
Dim stringTableLenght As Integer = WBXmlData(3)
For i As Integer = 4 To 4 + (stringTableLenght - 1)
Console.WriteLine()
Next
Dim carret As Integer = 4 + stringTableLenght
While carret < WBXmlData.Length
If GlobalTokens.ContainsKey(WBXmlData(carret)) Then
Select Case CType(WBXmlData(carret), GlobalToken)
Case GlobalToken.SWITCH_PAGE
carret += 1
If carret >= WBXmlData.Length Then
Exit Select
End If
currentCodePage = WBXmlData(carret)
If Not LocalTokens.ContainsKey(WBXmlData(carret)) Then
Throw New XmlException(String.Format("Code page {0} was not loaded", WBXmlData(carret)))
End If
carret += 1
Exit Select
Case GlobalToken.STR_I
carret += 1
If carret >= WBXmlData.Length Then
Exit Select
End If
Dim str As New List(Of Byte)()
While WBXmlData(carret) <> &H0
str.Add(WBXmlData(System.Math.Min(System.Threading.Interlocked.Increment(carret), carret - 1)))
If carret >= WBXmlData.Length Then
Exit While
End If
End While
builder.Append("<![CDATA[" & UTF8Encoding.UTF8.GetString(str.ToArray()) & "]]>")
carret += 1
Exit Select
Case GlobalToken.[END]
If waitForAttr Then
builder.Append(If(waitForContent, ">", "/>"))
waitForAttr = False
Else
builder.AppendFormat("</{0}>", openXmlTags.Pop)
End If
carret += 1
Exit Select
Case GlobalToken.OPAQUE
Dim opLenght As Byte = WBXmlData(System.Math.Min(System.Threading.Interlocked.Increment(carret), carret - 1))
builder.Append(BitConverter.ToString(WBXmlData, carret, opLenght))
Exit Select
End Select
ElseIf LocalTokens(currentCodePage).CodepageTags.ContainsKey(CByte(WBXmlData(carret) And &H3F)) Then
Dim tagFromToken As String = LocalTokens(currentCodePage).CodepageTags(CByte(WBXmlData(carret) And &H3F))
If Not codepagesUsed.Contains(currentCodePage) Then
codepagesUsed.Add(currentCodePage)
End If
If Not currentCodePage = codepagesUsed(0) Then
tagFromToken = LocalTokens(currentCodePage).XmlPrefix & ":" & tagFromToken
End If
Dim hasAttrs As Boolean = CByte(WBXmlData(carret) And &H80) = &H80
Dim hasContent As Boolean = CByte(WBXmlData(carret) And &H40) = &H40
builder.AppendFormat("{2}{0}{1}", tagFromToken, If(hasAttrs, " ", (If(Not hasContent, "/>", ">"))), If(Not waitForAttr, "<", ""))
waitForAttr = hasAttrs
waitForContent = hasContent
If waitForContent Then openXmlTags.Push(tagFromToken)
carret += 1
Else
carret += 1
If carret >= WBXmlData.Length Then
Exit While
End If
End If
End While
End If
Try
Dim fullXml As String = builder.ToString()
Dim defaultCodepage As Integer = codepagesUsed(0)
Dim prefixShebang As String = String.Format(" xmlns=""{0}""", LocalTokens(defaultCodepage).XmlNs)
For i As Integer = 1 To codepagesUsed.Count - 1
prefixShebang &= String.Format(" xmlns:{0}=""{1}""", LocalTokens(codepagesUsed(i)).XmlPrefix, LocalTokens(codepagesUsed(i)).XmlNs)
Next
codepagesUsed.Clear()
fullXml = fullXml.Insert(fullXml.IndexOf(">"c), prefixShebang)
MyBase.LoadXml(fullXml)
Catch xex As XmlException
Throw xex
Catch ex As Exception
Throw ex
End Try
End Sub
Private Function lookupLocalTokens(ByVal value As String, ByRef dicID As Integer) As Byte
dicID = currentCodePage
If value.Contains(":") Then
Dim parts() As String = value.Split(":"c)
Dim prefix As String = parts(0)
value = parts(1)
For Each key As Integer In LocalTokens.Keys
If LocalTokens(key).XmlPrefix = prefix Then
dicID = key
End If
Next
End If
If LocalTokens.ContainsKey(dicID) Then
For Each b As Byte In LocalTokens(dicID).CodepageTags.Keys
If LocalTokens(dicID).CodepageTags(b) = value Then
Return b
End If
Next
End If
For Each key As Integer In LocalTokens.Keys
For Each b As Byte In LocalTokens(key).CodepageTags.Keys
If LocalTokens(key).CodepageTags(b) = value Then
dicID = key
Return b
End If
Next
Next
Return Byte.MinValue
End Function
Private Function lookupLocalAttrs(ByVal value As String, ByRef dicID As Integer) As Byte
dicID = currentCodePage
If LocalAttributes.ContainsKey(dicID) Then
For Each b As Byte In LocalAttributes(dicID).Keys
If LocalAttributes(dicID)(b) = value Then
Return b
End If
Next
End If
For Each key As Integer In LocalAttributes.Keys
For Each b As Byte In LocalAttributes(key).Keys
If LocalAttributes(key)(b) = value Then
dicID = key
Return b
End If
Next
Next
Return Byte.MinValue
End Function
Public Function GetBytes() As Byte()
Dim resp As New List(Of Byte)()
resp.Add(If(VersionNumber <> String.Empty, Byte.Parse(VersionNumber.Replace("1.", String.Empty)), CByte(&H0)))
resp.Add(&H1)
resp.Add(&H6A)
resp.Add(0)
Using reader As XmlReader = New XmlNodeReader(Me.DocumentElement)
reader.MoveToFirstAttribute()
resp.AddRange(readNode(reader))
End Using
Return resp.ToArray()
End Function
Private Overloads Function readNode(ByVal root As XmlReader) As Byte()
Dim tmpBytes As New List(Of Byte)()
Dim depth As Integer = root.Depth
While root.Read()
If root.EOF Then
Return tmpBytes.ToArray()
ElseIf root.IsStartElement() Then
Dim dicID As Integer = currentCodePage
Dim tk As Byte = lookupLocalTokens(root.Name, dicID)
If tk <> Byte.MinValue Then
tmpBytes.AddRange(addSwitch(dicID))
Dim tagByte As Byte = CByte(tk + CByte(If(Not root.IsEmptyElement, &H40, &H0)))
If root.HasAttributes Then
While root.MoveToNextAttribute()
tk = lookupLocalAttrs(root.Name, dicID)
If tk <> Byte.MinValue Then
tagByte += CByte(&H80)
tmpBytes.Add(tagByte)
tmpBytes.AddRange(addSwitch(dicID))
tmpBytes.Add(tk)
tmpBytes.Add(CByte(GlobalToken.[END]))
Else
tmpBytes.Add(tagByte)
End If
End While
Else
tmpBytes.Add(tagByte)
End If
End If
If root.NodeType = XmlNodeType.Text AndAlso root.ValueType Is GetType(String) Then
tmpBytes.Add(CByte(GlobalToken.STR_I))
tmpBytes.AddRange(Encoding.UTF8.GetBytes(root.Value))
tmpBytes.Add(&H0)
ElseIf root.Depth > depth Then
tmpBytes.AddRange(readNode(root))
End If
ElseIf root.NodeType = XmlNodeType.Text AndAlso root.ValueType Is GetType(String) Then
tmpBytes.Add(CByte(GlobalToken.STR_I))
tmpBytes.AddRange(Encoding.UTF8.GetBytes(root.Value))
tmpBytes.Add(&H0)
ElseIf root.NodeType = XmlNodeType.EndElement Then
tmpBytes.Add(CByte(GlobalToken.[END]))
End If
End While
Return tmpBytes.ToArray()
End Function
Private Function addSwitch(ByVal dicId As Integer) As Byte()
Dim bts As Byte() = New Byte(-1) {}
If dicId <> currentCodePage Then
bts = New Byte(1) {}
bts(0) = CByte(GlobalToken.SWITCH_PAGE)
bts(1) = CByte(dicId)
End If
currentCodePage = dicId
Return bts
End Function
End Class
End Namespace
My strongly typed WbXmlCodepage class is as follows:
Namespace EncodingHelpers.WBXML
Public Class WbXmlCodepage
Private _xmlns As String
Public Property XmlNs() As String
Get
Return _xmlns
End Get
Set(ByVal value As String)
_xmlns = value
End Set
End Property
Private _xmlPrefix As String
Public Property XmlPrefix() As String
Get
Return _xmlPrefix
End Get
Set(ByVal value As String)
_xmlPrefix = value
End Set
End Property
Private _codePage As Integer
Public Property Codepage() As Integer
Get
Return _codePage
End Get
Set(ByVal value As Integer)
_codePage = value
End Set
End Property
Private _codepageTags As Dictionary(Of Byte, String)
Public Property CodepageTags() As Dictionary(Of Byte, String)
Get
Return _codepageTags
End Get
Set(ByVal value As Dictionary(Of Byte, String))
_codepageTags = value
End Set
End Property
End Class
End Namespace
Finally, I seperated out the implementations of each AirSync codepage into a seperate class file. This will make it easier in future as I begin to use more codepages to maintain the code, or if you wish to use a codepage simply create another class and add it to 'InitAirSyncCodepages()'. I only needed those 7 codepages for the calendar sync.
To give an example of how to use the class to download the calendar items, a simple implementation in ASP.NET UserControl is as follows:
<%@ Control Language="vb" AutoEventWireup="false" CodeBehind="OutlookCalendarWidget.ascx.vb" Inherits="UserControls.OutlookCalendarWidget" %>
<div id="ConnectToActiveSync">
<asp:Panel ID="pnlSetUserContext" runat="server" Visible="false" DefaultButton="btnSetUserContext">
Exchange User: <asp:TextBox ID="txtUsername" runat="server"></asp:TextBox>
<asp:Button ID="btnSetUserContext" runat="server" Text="Begin" />
</asp:Panel>
<asp:Panel ID="pnlSubmitExchangePw" runat="server" Visible="false" DefaultButton="btnSubmitExchangePass">
In order to connect to Exchange, you will need to provide your login password:
<asp:TextBox ID="txtExchangePass" runat="server" TextMode="Password"></asp:TextBox>
<asp:Button ID="btnSubmitExchangePass" runat="server" Text="Continue" />
</asp:Panel>
<asp:Panel ID="pnlEpicFail" runat="server" visible="false">
Could not connect to Exchange server. Check connectivity.
</asp:Panel>
</div>
<asp:Panel ID="pnlOutlookCalendar" runat="server" Visible="false">
<asp:Panel ID="pnlNotAuth" runat="server" visible="false">
Not authorised, has your password changed? <asp:Button ID="btnResetPassword" runat="server" Text="Reset Password"/>
</asp:Panel>
<asp:Label ID="lblActiveSyncErrorMessage" runat="server"></asp:Label>
<asp:Repeater ID="rptCalendarItemGroups" runat="server">
<ItemTemplate>
<div class="calender-group-title"><%# Container.DataItem%></div>
<div class="calendar-group-items">
<asp:Repeater id="rptCalendarEvents" runat="server" OnItemDataBound="rptCalendarEvents_ItemDataBound">
<ItemTemplate>
<asp:Panel ID="pnlCalenderItem" CssClass="calendar-item" runat="server">
<div class="calendar-date"><%# IIf(Eval("GroupName") <> "Next Week", IIf(Eval("IsAllDay"), "All day", CDate(Eval("StartTime")).ToString("HH:mm")), CDate(Eval("StartTime")).ToString("ddd"))%></div>
<div class="calendar-subject"><%# Eval("Subject")%></div>
<div class="calendar-duration"><%# IIf(Not Eval("IsAllDay"), Eval("TimespanString"), "")%></div>
<div class="calendar-location"><span title='<%# Eval("AttendeesList") %>'><%# IIf(Eval("Location") <>"", "(" & Eval("Location") & ")" , "")%></span></div>
</asp:Panel>
</ItemTemplate>
</asp:Repeater>
</div>
</ItemTemplate>
</asp:Repeater>
</asp:Panel>
Codebehind:
Namespace UserControls
Public Class OutlookCalendarWidget
Inherits System.Web.UI.UserControl
Private Const _activeSyncServer As String = "https://webmail.yourdomain.com/"
Private _calendarItems As List(Of CalendarItem)
Protected Class CalendarItem
Public Class Attendee
Public Property Name As String
Public Property Email As String
End Class
Public Property IsAllDay As Boolean
Public Property StartTime As DateTime
Public Property EndTime As DateTime
Public Property Subject As String
Public Property Location As String
Public Property Attendees As New List(Of Attendee)
Private _groupName As String
Public ReadOnly Property GroupName As String
Get
If String.IsNullOrEmpty(_groupName) Then
Dim daysFromToday As TimeSpan = StartTime.Date.Subtract(Today.Date)
Select Case daysFromToday.Days
Case Is < 0
_groupName = "Past"
Case Is = 0
_groupName = "Today"
Case Is <= 7
_groupName = StartTime.ToString("dddd")
Case Is <= 14
_groupName = "Next Week"
Case Else
_groupName = "Rest of Year"
End Select
End If
Return _groupName
End Get
End Property
Public ReadOnly Property TimespanString As String
Get
Dim format As String = ""
Dim elapsed As TimeSpan = EndTime.Subtract(StartTime)
If elapsed.Days > 0 Then format &= "d'days'"
If elapsed.Hours > 0 Then format &= CStr(IIf(format <> "", "\ ", "")) & "h'hrs'"
If elapsed.Minutes > 0 Then format &= CStr(IIf(format <> "", "\ ", "")) & "m'mins'"
Return elapsed.ToString(format)
End Get
End Property
Public ReadOnly Property AttendeesList As String
Get
Return String.Join(", ", From a In Attendees Select a.Name)
End Get
End Property
End Class
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not IsPostBack Then
MessageLoop()
End If
End Sub
Private Function GetUsername() As String
If HttpContext.Current.User IsNot Nothing AndAlso HttpContext.Current.User.Identity IsNot Nothing AndAlso Not String.IsNullOrEmpty(HttpContext.Current.User.Identity.Name) Then
Return HttpContext.Current.User.Identity.Name
Else
Return txtUsername.Text
End If
End Function
Private Function GetPassword() As String
Return txtExchangePass.Text
End Function
Private Sub SyncCalendar()
Try
Dim fullUsername As String = GetUsername()
Dim username As String = ""
Dim domain As String = ""
Dim pw As String = GetPassword()
If fullUsername.Contains("\") Then
Dim parts() As String = fullUsername.Split("\"c)
domain = parts(0)
username = parts(1)
Else
username = fullUsername
End If
Dim asHelper As New Email.Exchange.AirSync.AirSyncHelper(_activeSyncServer, username, pw, domain)
If asHelper.IsVersionCompatible() Then
Dim initFolderSyncResult As System.Xml.XmlDocument = GetFolderSyncResult(asHelper, "0")
Dim initFolderSyncNsMgr As New System.Xml.XmlNamespaceManager(initFolderSyncResult.NameTable)
initFolderSyncNsMgr.AddNamespace("dflt", Email.Exchange.AirSync.Codepages.FolderHierarchy_7.Instance.XmlNs)
Dim statusNode As System.Xml.XmlNode = initFolderSyncResult.SelectSingleNode("dflt:FolderSync/dflt:Status", initFolderSyncNsMgr)
If statusNode IsNot Nothing AndAlso statusNode.InnerText = "1" Then
Dim folderSyncSyncKeyNode As System.Xml.XmlNode = initFolderSyncResult.SelectSingleNode("dflt:FolderSync/dflt:SyncKey", initFolderSyncNsMgr)
If folderSyncSyncKeyNode IsNot Nothing Then
GetFolderSyncResult(asHelper, folderSyncSyncKeyNode.InnerText)
Dim calendarFolderNode As System.Xml.XmlNode = initFolderSyncResult.SelectSingleNode("dflt:FolderSync/dflt:Changes/dflt:Add[dflt:DisplayName = ""Calendar""]", initFolderSyncNsMgr)
If calendarFolderNode IsNot Nothing Then
Dim calendarFolderServerId As String = calendarFolderNode("ServerId").InnerText
Dim initialCalendarSyncResult As System.Xml.XmlDocument = GetSyncResult(asHelper, calendarFolderServerId, "Calendar", "0")
Dim initCalSyncNsMgr As New System.Xml.XmlNamespaceManager(initialCalendarSyncResult.NameTable)
initCalSyncNsMgr.AddNamespace("dflt", Email.Exchange.AirSync.Codepages.AirSync_0.Instance.XmlNs)
Dim calendarSyncKeyNode As System.Xml.XmlNode = initialCalendarSyncResult.SelectSingleNode("dflt:Sync/dflt:Collections/dflt:Collection/dflt:SyncKey", initCalSyncNsMgr)
If calendarSyncKeyNode IsNot Nothing Then
Dim calendarSyncKey As String = calendarSyncKeyNode.InnerText
Dim juicyCalendarSyncResult As System.Xml.XmlDocument = GetSyncResult(asHelper, calendarFolderServerId, "Calendar", calendarSyncKey)
_calendarItems = ParseCalender(juicyCalendarSyncResult)
If _calendarItems IsNot Nothing AndAlso _calendarItems.Count > 0 Then
rptCalendarItemGroups.DataSource = (From ci In _calendarItems Order By ci.StartTime Ascending Where ci.StartTime.Date >= Today.Date And ci.StartTime.Date <= Today.Date.AddDays(14) Group ci By ci.GroupName Into g = Group Select g.First().GroupName)
rptCalendarItemGroups.DataBind()
If rptCalendarItemGroups.Items.Count = 0 Then lblActiveSyncErrorMessage.Text = "You have no calendar items to display"
Else
lblActiveSyncErrorMessage.Text = "Could not do sync the calendar folder. "
Dim statusNsMgr As New System.Xml.XmlNamespaceManager(juicyCalendarSyncResult.NameTable)
statusNsMgr.AddNamespace("dflt", Email.Exchange.AirSync.Codepages.AirSync_0.Instance.XmlNs)
Dim juicyStatusNode As System.Xml.XmlNode = juicyCalendarSyncResult.SelectSingleNode("dflt:Sync/dflt:Collections/dflt:Collection/dflt:Status", statusNsMgr)
If juicyStatusNode IsNot Nothing Then lblActiveSyncErrorMessage.Text &= " ActiveSync status: " & juicyStatusNode.InnerText
End If
Else
lblActiveSyncErrorMessage.Text = "Could not do initial sync on the calendar folder."
End If
Else
lblActiveSyncErrorMessage.Text = "There is no calendar folder found in the initial folder sync."
End If
Else
lblActiveSyncErrorMessage.Text = "Could not find SyncKey in FolderSync response."
End If
Else
lblActiveSyncErrorMessage.Text = "Initial FolderSync did not complete."
If statusNode IsNot Nothing Then lblActiveSyncErrorMessage.Text &= " ActiveSync status: " & statusNode.InnerText
End If
Else
Throw New Exception("Server does not support the correct verion of AirSync. Required version: " & Email.Exchange.AirSync.AirSyncHelper.AirSyncSupportedVersion)
End If
Catch wEx As Net.WebException
If wEx.Message.Contains("401") Then
pnlNotAuth.Visible = True
Else
Throw wEx
End If
Catch ex As Exception
lblActiveSyncErrorMessage.Text = "Could not connect to ActiveSync. " & ex.Message
End Try
End Sub
Private Function GetFolderSyncResult(ByVal asHelper As Email.Exchange.AirSync.AirSyncHelper, ByVal syncKey As String) As System.Xml.XmlDocument
Dim xmlRequestData As String = <?xml version="1.0" encoding="utf-8"?>
<FolderSync xmlns="FolderHierarchy:">
<SyncKey>{SyncKey}</SyncKey>
</FolderSync>.ToString().Replace("{SyncKey}", syncKey)
Return asHelper.ExecuteAirSyncCommand("FolderSync", xmlRequestData)
End Function
Private Function GetSyncResult(ByVal asHelper As Email.Exchange.AirSync.AirSyncHelper, ByVal collectionId As String, ByVal className As String, ByVal syncKey As String) As System.Xml.XmlDocument
Dim xmlRequestData As String
If syncKey = "0" Then
xmlRequestData = <?xml version="1.0" encoding="utf-8"?>
<Sync xmlns="AirSync:">
<Collections>
<Collection>
<Class>{ClassName}</Class>
<SyncKey>{SyncKey}</SyncKey>
<CollectionId>{CollectionId}</CollectionId>
</Collection>
</Collections>
</Sync>.ToString().Replace("{SyncKey}", syncKey).Replace("{CollectionId}", collectionId).Replace("{ClassName}", className)
Else
xmlRequestData = <?xml version="1.0" encoding="utf-8"?>
<Sync xmlns="AirSync:">
<Collections>
<Collection>
<Class>{ClassName}</Class>
<SyncKey>{SyncKey}</SyncKey>
<CollectionId>{CollectionId}</CollectionId>
<DeletesAsMoves/>
<GetChanges/>
</Collection>
</Collections>
</Sync>.ToString().Replace("{SyncKey}", syncKey).Replace("{CollectionId}", collectionId).Replace("{ClassName}", className)
End If
Return asHelper.ExecuteAirSyncCommand("Sync", xmlRequestData)
End Function
Private Sub rptCalendarItemGroups_ItemDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.RepeaterItemEventArgs) Handles rptCalendarItemGroups.ItemDataBound
If e.Item.ItemType = ListItemType.Item Or e.Item.ItemType = ListItemType.AlternatingItem Then
Dim rptCalendarEvents As Repeater = CType(e.Item.FindControl("rptCalendarEvents"), Repeater)
rptCalendarEvents.DataSource = From ci In _calendarItems Where ci.GroupName = CStr(e.Item.DataItem) Order By ci.StartTime Ascending Select ci
rptCalendarEvents.DataBind()
End If
End Sub
Protected Sub rptCalendarEvents_ItemDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.RepeaterItemEventArgs)
If e.Item.ItemType = ListItemType.Item Or e.Item.ItemType = ListItemType.AlternatingItem Then
If DirectCast(e.Item.DataItem, CalendarItem).EndTime < Now Then
Dim pnlCalenderItem As Panel = CType(e.Item.FindControl("pnlCalenderItem"), Panel)
pnlCalenderItem.CssClass &= " strikeout"
End If
End If
End Sub
Private Function ParseCalender(ByVal juicyCalendarSyncResult As System.Xml.XmlDocument) As List(Of CalendarItem)
Dim cItems As List(Of CalendarItem) = Nothing
Dim juicyCalSyncNsMgr As New System.Xml.XmlNamespaceManager(juicyCalendarSyncResult.NameTable)
juicyCalSyncNsMgr.AddNamespace("dflt", Email.Exchange.AirSync.Codepages.AirSync_0.Instance.XmlNs)
juicyCalSyncNsMgr.AddNamespace(Email.Exchange.AirSync.Codepages.Calendar_4.Instance.XmlPrefix, Email.Exchange.AirSync.Codepages.Calendar_4.Instance.XmlNs)
Dim juicyStatusNode As System.Xml.XmlNode = juicyCalendarSyncResult.SelectSingleNode("dflt:Sync/dflt:Collections/dflt:Collection/dflt:Status", juicyCalSyncNsMgr)
If juicyStatusNode IsNot Nothing AndAlso juicyStatusNode.InnerText = "1" Then
cItems = New List(Of CalendarItem)
For Each node As System.Xml.XmlNode In juicyCalendarSyncResult.SelectNodes("dflt:Sync/dflt:Collections/dflt:Collection/dflt:Commands/dflt:Add/dflt:ApplicationData", juicyCalSyncNsMgr)
Dim ci As New CalendarItem
ci.StartTime = DateTime.ParseExact(node("StartTime", "Calendar:").InnerText, "yyyyMMdd'T'HHmmss'Z'", Globalization.CultureInfo.CurrentCulture)
ci.EndTime = DateTime.ParseExact(node("EndTime", "Calendar:").InnerText, "yyyyMMdd'T'HHmmss'Z'", Globalization.CultureInfo.CurrentCulture)
ci.Subject = node("Subject", "Calendar:").InnerText
ci.IsAllDay = (node("AllDayEvent", "Calendar:") IsNot Nothing AndAlso node("AllDayEvent", "Calendar:").InnerText = "1")
If node("Location", "Calendar:") IsNot Nothing Then
ci.Location = node("Location", "Calendar:").InnerText
End If
If node("Attendees", "Calendar:") IsNot Nothing Then
Dim attendees As System.Xml.XmlNodeList = node.SelectNodes("calendar:Attendees/calendar:Attendee", juicyCalSyncNsMgr)
For Each attendee As System.Xml.XmlNode In attendees
If attendee("AttendeeStatus", "Calendar:") Is Nothing OrElse attendee("AttendeeStatus", "Calendar:").InnerText <> "4" Then
ci.Attendees.Add(New CalendarItem.Attendee() With {
.Name = attendee("Attendee_Name", "Calendar:").InnerText,
.Email = attendee("Attendee_Email", "Calendar:").InnerText})
End If
Next
If node("Organizer_Name", "Calendar:") IsNot Nothing Then
Dim organiserName As String = node("Organizer_Name", "Calendar:").InnerText
If Not ci.AttendeesList.Contains(organiserName) Then
ci.Attendees.Add(New CalendarItem.Attendee() With {
.Name = organiserName,
.Email = node("Organizer_Email", "Calendar:").InnerText})
End If
End If
End If
cItems.Add(ci)
Next
End If
Return cItems
End Function
Private Sub btnSetUserContext_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSetUserContext.Click
MessageLoop()
End Sub
Private Sub MessageLoop()
pnlEpicFail.Visible = False
pnlOutlookCalendar.Visible = False
pnlSetUserContext.Visible = False
pnlSubmitExchangePw.Visible = False
If GetUsername() = "" Then
pnlSetUserContext.Visible = True
ElseIf GetPassword() = "" Then
pnlSubmitExchangePw.Visible = True
Else
pnlOutlookCalendar.Visible = True
SyncCalendar()
End If
End Sub
Private Sub btnSubmitExchangePass_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSubmitExchangePass.Click
MessageLoop()
End Sub
Private Sub btnResetPassword_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnResetPassword.Click
pnlNotAuth.Visible = False
pnlOutlookCalendar.Visible = False
pnlSubmitExchangePw.Visible = True
End Sub
End Class
End Namespace
I have managed to raise emails and audible warnings before this happens, but there seems to be latency issues in getting any response. Sometimes I have to deal with this manually :(