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
'class was written based on AS2.5 specification
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
'host address endpoint where exchange webmail is hosted
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
'this could be used to have a different mailbox name to the domain login
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
'domain login credentials (HTTP Auth)
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
'ActiveSync policy key
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
'base address (with the active sync folder)
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
'get the options from the server to get the AS Version
Dim optReq As System.Net.HttpWebRequest = GetAirSyncWebRequest("")
optReq.Method = "OPTIONS"
Dim optResp As System.Net.HttpWebResponse = CType(optReq.GetResponse(), System.Net.HttpWebResponse)
'200 OK?
If optResp.StatusCode = 200 Then
'check server versions
Dim msAsProtocolVersions As String = optResp.Headers("MS-ASProtocolVersions")
If Not String.IsNullOrEmpty(msAsProtocolVersions) Then
Dim supportedVersions As String() = msAsProtocolVersions.Split(","c)
'must support AirSyncTargetVersion
If supportedVersions.Contains(AirSyncSupportedVersion) Then
Return True
End If
End If
End If
Return False
End Function
Public Sub ObtainPolicyKey()
'in AirSync version 12 the policy type was changed from MS-WAP-Provisioning-XML to MS-EAS-Provisioning-WBXML
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)
'since XPATH v1 doesnt support default namespace, add our own prefix
opkNsMgr.AddNamespace("dflt", Codepages.Provision_14.Instance.XmlNs)
opkNsMgr.AddNamespace(Codepages.Settings_18.Instance.XmlPrefix, Codepages.Settings_18.Instance.XmlNs)
'this may not have a key, for e.g if their are no policies applied
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
'TODO: this might need to reply to the server in future to confirm policy settings, but not for now...
End If
End Sub
Public Function ExecuteAirSyncCommand(ByVal command As String, ByVal xmlBody As String) As System.Xml.XmlDocument
'create a command query with some dummy device data
Dim commandQuery As String = String.Format("?User={0}&DeviceId=CwWebDevice1234&DeviceType=PocketPC&Cmd={1}", ASUsername, command)
'create a request to execute the command
Dim execReq As System.Net.HttpWebRequest = GetAirSyncWebRequest(commandQuery)
execReq.Method = "POST"
execReq.Headers("MS-ASProtocolVersion") = AirSyncSupportedVersion
execReq.ContentType = "application/vnd.ms-sync.wbxml"
'convert the xml to wbxml
Dim transportData() As Byte = GetWbxmlFromXml(xmlBody)
execReq.ContentLength = transportData.Length
'transfer the bytes
Dim requestStream As IO.Stream = execReq.GetRequestStream()
requestStream.Write(transportData, 0, transportData.Length)
requestStream.Close()
'get response
Dim execResp As System.Net.HttpWebResponse = CType(execReq.GetResponse(), System.Net.HttpWebResponse)
If execResp.StatusCode = 200 Then
'convert the wbxml to xml
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)
'BASIC: optReq.Headers("Authorization") = "Basic " & Convert.ToBase64String(Encoding.UTF8.GetBytes(domain & "\" & username & ":" & password))
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()
'create new converter with our code pages
Dim wbxmlReqDoc As New EncodingHelpers.WBXML.WbXmlDocument(ASCodePages)
'load the xml source
wbxmlReqDoc.LoadXml(xml)
'return the bytes
Return wbxmlReqDoc.GetBytes()
End Function
Private Sub InitAirSyncCodepages()
_asCodePages = New Dictionary(Of Integer, EncodingHelpers.WBXML.WbXmlCodepage)
'AirSync - 0
_asCodePages.Add(Codepages.AirSync_0.Instance.Codepage, Codepages.AirSync_0.Instance)
'Contacts - 1
_asCodePages.Add(Codepages.Contacts_1.Instance.Codepage, Codepages.Contacts_1.Instance)
'Calendar - 4
_asCodePages.Add(Codepages.Calendar_4.Instance.Codepage, Codepages.Calendar_4.Instance)
'FolderHierarchy - 7
_asCodePages.Add(Codepages.FolderHierarchy_7.Instance.Codepage, Codepages.FolderHierarchy_7.Instance)
'Provision - 14
_asCodePages.Add(Codepages.Provision_14.Instance.Codepage, Codepages.Provision_14.Instance)
'AirsyncBase - 17
_asCodePages.Add(Codepages.AirSyncBase_17.Instance.Codepage, Codepages.AirSyncBase_17.Instance)
'Settings - 18
_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:
'CONVERTED FROM ORIGINAL C# CLASS:
' This class is released under restrictive CPL
' You can use this code or code, derived from this code in either
' open source, free or commercial application, however,
' you should clearly provide my name "Tamir Khason"
' and link to my blog http://blogs.microsoft.co.il/blogs/tamir/
' or my private web site http://khason.biz within any distribution of the software.
' For more information, contact me at tamir@khason.biz
' Some additional changes were made to give better XML compatibility, (to make compatible for use with AirSync)
' This includes:
' - fixed the way tags are closed (using a stack instead of searching the text)
' - added XML namespace compatibility
' -to switch codepages based on xml prefix, not first token found, when encoding XML -> WBXML
' - also to encode the namespaces back into the XML output when decoding WBXML -> XML
' - added extra logic for inclusion of the attriubute wbxml flag (only if token exists)
' - defined a strongly typed codepage/tags class to define the required extra data (xml namespace/prefix)
' - added CDATA tags around XML content to prevent xml parser issues
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"
'temp
Public Charset As Encoding
Private GlobalTokens As Dictionary(Of Byte, String)
'change this to be strongly typed codepages with additional XML info
'Private LocalTokens As Dictionary(Of Integer, 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
' Change the code page for the current token state. Followed by a single u_int8 indicating the new code page number.
[END] = &H1
' Indicates the end of an attribute list or the end of an element.
ENTITY = &H2
' A character entity. Followed by a mb_u_int32 encoding the character entity number.
STR_I = &H3
'Inline string. Followed by a termstr.
LITERAL = &H4
' An unknown tag or attribute name. Followed by an mb_u_int32 that encodes an offset into the string table.
EXT_I_0 = &H40
' Inline string document-type-specific extension token. Token is followed by a termstr.
EXT_I_1 = &H41
' Inline string document-type-specific extension token. Token is followed by a termstr.
EXT_I_2 = &H42
' Inline string document-type-specific extension token. Token is followed by a termstr.
PI = &H43
' Processing instruction.
LITERAL_C = &H44
' Unknown tag, with content.
EXT_T_0 = &H80
' Inline integer document-type-specific extension token. Token is followed by a mb_uint_32.
EXT_T_1 = &H81
' Inline integer document-type-specific extension token. Token is followed by a mb_uint_32.
EXT_T_2 = &H82
' Inline integer document-type-specific extension token. Token is followed by a mb_uint_32.
STR_T = &H83
' String table reference. Followed by a mb_u_int32 encoding a byte offset from the beginning of the string table.
LITERAL_A = &H84
' Unknown tag, with attributes.
EXT_0 = &HC0
' Single-byte document-type-specific extension token.
EXT_1 = &HC1
' Single-byte document-type-specific extension token.
EXT_2 = &HC2
' Single-byte document-type-specific extension token.
OPAQUE = &HC3
' Opaque document-type-specific data.
LITERAL_AC = &HC4
' Unknown tag, with content and attributes.
End Enum
Private currentCodePage As Integer = 0
'fix for MS 1;
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
'first byte -> version number
VersionNumber = String.Format("1.{0}", WBXmlData(0))
'second byte -> public identifier. Void it.
'third byte -> charset (IANA)
Try
Charset = Encoding.GetEncoding(WBXmlData(2))
Catch
Charset = Encoding.UTF8
End Try
'forth byte -> string table
Dim stringTableLenght As Integer = WBXmlData(3)
For i As Integer = 4 To 4 + (stringTableLenght - 1)
'read string table (if exist
Console.WriteLine()
Next
'4 + stringTableLenght byte and up -> token structs;
Dim carret As Integer = 4 + stringTableLenght
While carret < WBXmlData.Length
If GlobalTokens.ContainsKey(WBXmlData(carret)) Then
'global token;
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
'fix from Max to Min (incorrect conversion from c# carret++ operator into VB.NET)
str.Add(WBXmlData(System.Math.Min(System.Threading.Interlocked.Increment(carret), carret - 1)))
If carret >= WBXmlData.Length Then
Exit While
End If
End While
'put inside CDATA tags so it doesnt break the parser
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
'change this to fix problem tags, just use a stack...
'Dim lastUnclosed As String = findLastUnclosed(builder.ToString())
builder.AppendFormat("</{0}>", openXmlTags.Pop)
End If
carret += 1
Exit Select
Case GlobalToken.OPAQUE
'fix from Max to Min (incorrect conversion from c# carret++ operator into VB.NET)
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
'local tocken;
Dim tagFromToken As String = LocalTokens(currentCodePage).CodepageTags(CByte(WBXmlData(carret) And &H3F))
'remember which codepages are being used so we know which namspaces to add to the XML
If Not codepagesUsed.Contains(currentCodePage) Then
codepagesUsed.Add(currentCodePage)
End If
'if its not the default namespace, we need to encode the tag
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
'nothing
carret += 1
If carret >= WBXmlData.Length Then
Exit While
End If
End If
End While
End If
Try
Dim fullXml As String = builder.ToString()
'we need to insert the xmlns prefixes in the root node
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()
'inject the namespaces
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
'DEPRECATED - now using a stack to track open tags
'Private Function findLastUnclosed(ByVal p As String) As String
' Dim allTagsRX As String = "<(/)?([a-z]+)[^>]*?(/)?>"
' Dim rx As New Regex(allTagsRX, RegexOptions.Compiled Or RegexOptions.IgnoreCase Or RegexOptions.Singleline)
' Dim matches As MatchCollection = rx.Matches(p)
' Dim tags As New List(Of String)()
' For Each m As Match In matches
' If m.Groups(1).Value = String.Empty Then
' tags.Add(m.Groups(2).Value)
' Else
' tags.Remove(m.Groups(2).Value)
' End If
' If m.Groups(3).Value <> String.Empty Then
' tags.Remove(m.Groups(2).Value)
' End If
' Next
' If tags.Count = 0 Then
' Return String.Empty
' Else
' Return tags(tags.Count - 1)
' End If
'End Function
Private Function lookupLocalTokens(ByVal value As String, ByRef dicID As Integer) As Byte
dicID = currentCodePage
'make sure we are on the right codepage (using xmlprefix)
'so we can identify codepage changes in creating WBXML AirSync request.
If value.Contains(":") Then
Dim parts() As String = value.Split(":"c)
Dim prefix As String = parts(0)
value = parts(1)
'find the codepage to which this namespace belongs
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
'if we did not find it then mustnt be namespaced, this is the original code which will find the first codepage with a matching token
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)()
'version
resp.Add(If(VersionNumber <> String.Empty, Byte.Parse(VersionNumber.Replace("1.", String.Empty)), CByte(&H0)))
'public identifier
resp.Add(&H1)
'encoding (UTF8)
resp.Add(&H6A)
'string table length
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))
'test for attributes seperately, if no token we dont wanna encode this
Dim tagByte As Byte = CByte(tk + CByte(If(Not root.IsEmptyElement, &H40, &H0)))
'has content & attributes;
If root.HasAttributes Then
While root.MoveToNextAttribute()
tk = lookupLocalAttrs(root.Name, dicID)
If tk <> Byte.MinValue Then
'advise we are putting an attribute
tagByte += CByte(&H80)
'put the tag byte
tmpBytes.Add(tagByte)
'now add the attribute
tmpBytes.AddRange(addSwitch(dicID))
tmpBytes.Add(tk)
tmpBytes.Add(CByte(GlobalToken.[END]))
Else
'just add the tag byte
tmpBytes.Add(tagByte)
End If
End While
Else
'just add the tag byte
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
'the xml namespace associated with this codepage
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
'this xml prefix for the associated namespace
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
'codepage number
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
'the codepage tags
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 and you can
download the class files here.
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
'categorize this calendar entry into a group
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)
'any days?
If elapsed.Days > 0 Then format &= "d'days'"
'hours?
If elapsed.Hours > 0 Then format &= CStr(IIf(format <> "", "\ ", "")) & "h'hrs'"
'mins?
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
'domain logged in - get the username
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()
'check for domain login
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
'make sure the policy key is populated (if applicable) - not required for this version
'asHelper.ObtainPolicyKey()
'do an initial folder sync for the user (resets the sync on the server)
Dim initFolderSyncResult As System.Xml.XmlDocument = GetFolderSyncResult(asHelper, "0")
'use a namespace manager for FolderSync
Dim initFolderSyncNsMgr As New System.Xml.XmlNamespaceManager(initFolderSyncResult.NameTable)
'since XPATH 1 doesnt support default namespaces, we will have to invent our own
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
'use the sync key to start a sync session on the server to complete the foldersync cycle
GetFolderSyncResult(asHelper, folderSyncSyncKeyNode.InnerText)
'do a sync on the calendar folder by using the server Id of the calendar from the initial sync
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")
'use a namespace manager for Sync
Dim initCalSyncNsMgr As New System.Xml.XmlNamespaceManager(initialCalendarSyncResult.NameTable)
'since XPATH 1 doesnt support default namespaces, we will have to invent our own
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
'now we can do a second sync to get the juicy stuff
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
'bind the groups in date order (dont include items from the past)
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
'couldnt do it - after all that!!
lblActiveSyncErrorMessage.Text = "Could not do sync the calendar folder. "
'see if there was a status from AS
'use a namespace manager for FolderSync
Dim statusNsMgr As New System.Xml.XmlNamespaceManager(juicyCalendarSyncResult.NameTable)
'since XPATH 1 doesnt support default namespaces, we will have to invent our own
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
'initial sync has different body content
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 isAlt As Boolean = False
'Protected Function GetCalendarRowIsAlt() As Boolean
' 'remember current row
' Dim thisOneIsAlt As Boolean = isAlt
' 'invert for next call
' isAlt = Not isAlt
' Return thisOneIsAlt
'End Function
Private Function ParseCalender(ByVal juicyCalendarSyncResult As System.Xml.XmlDocument) As List(Of CalendarItem)
Dim cItems As List(Of CalendarItem) = Nothing
'use a namespace manager for Calendar Sync
Dim juicyCalSyncNsMgr As New System.Xml.XmlNamespaceManager(juicyCalendarSyncResult.NameTable)
'since XPATH 1 doesnt support default namespaces, we will have to invent our own + register the calendar prefix
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
'we can bindings to repeaterings
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
'get all the accepted attendees
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
'accepted? (or not specified)
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
'organizer is attending
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
'check we have a username/password and then sync
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
'show the password entry screen
pnlNotAuth.Visible = False
pnlOutlookCalendar.Visible = False
pnlSubmitExchangePw.Visible = True
End Sub
End Class
End Namespace