B
bart
Hi all,
I'm trying to read the exchange calendar of people via webdav. This
works fine for the most part, but some users have been migrated from
other departments, and have a different default language, and
therefore a different webdav URL.
What I'm trying to do is the following:
1. try to read http://servername/exchange/emailaddress/agenda/ (dutch
version)
2. If this fails, try to read http://servername/exchange/emailaddress/calendar
What happens is that if the first attempt fails, the second attempt
allways fails. If I change the order (first calendar, then agenda) it
works fine for the english users.
any ideas?
Bart
Sub get_calendar(ByVal struserid As String, ByVal strserver As String,
ByVal strusername As String, ByVal strpassword As String, ByVal
strdomain As String)
Dim dDate As DateTime
dDate = Today
' now get the calendar for this user
Dim strURL As String = "http://" & strserver & "/exchange/" &
struserid & "/agenda/"
'Dim strURL As String = "http://" & strserver & "/exchange/" &
struserid & "/calendar/"
Dim strRequest As String = "<?xml version=""1.0""?>" & _
"<g:searchrequest xmlns:g=""DAV:"">" & _
"<g:sql>SELECT ""urn:schemas:calendar:location"",
""urn:schemas:httpmail:subject"", " & _
"""urn:schemas:calendar:dtstart"",
""urn:schemas:calendar:dtend"", " & _
"""urn:schemas:calendar:meetingstatus"", ""http://
schemas.microsoft.com/exchange/sensitivity"", " & _
"""urn:schemas:httpmail:textdescription"",
""urn:schemas:calendar:alldayevent"", " & _
"""urn:schemas:calendar:busystatus"",
""urn:schemas:calendar:instancetype"" " & _
"FROM Scope('SHALLOW TRAVERSAL OF """ & strURL &
"""') " & _
"WHERE NOT ""urn:schemas:calendar:instancetype"" = 1
" & _
"AND ""DAV:contentclass"" = 'urn:content-
classes:appointment' " & _
"AND ""urn:schemas:calendar:dtstart"" > '" & _
String.Format("{0:yyyy/MM/dd}", dDate.AddDays(-1)) &
" 21:59:00' " & _
"AND ""urn:schemas:calendar:dtend"" < '" & _
String.Format("{0:yyyy/MM/dd}", dDate.AddDays(1)) &
" 00:00:00' " & _
"ORDER BY ""urn:schemas:calendar:dtstart"" ASC" & _
"</g:sql></g:searchrequest>"
Dim strStatusText As String = ""
Dim Status As Integer
Dim ResponseXmlDoc As XmlDocument
ResponseXmlDoc = SendRequest("SEARCH", strURL, strRequest,
strusername, strpassword, strdomain, strStatusText, Status)
Dim tries As Integer = 0
If Status = 7 And tries = 0 Then ' we check for an
unauthorized error, and then try again with the english version...
strURL = "http://" & strserver & "/exchange/" & struserid
& "/calendar/"
tries = 1
strStatusText = ""
Status = 0
ResponseXmlDoc = SendRequest("SEARCH", strURL, strRequest,
strusername, strpassword, strdomain, strStatusText, Status)
End If
xslTransform.DocumentContent = ResponseXmlDoc.InnerXml
xslTransform.TransformSource = Server.MapPath("Calendar.xsl")
'Response.End()
End Sub
Function SendRequest(ByVal strCommand As String, ByVal strURL As
String, ByVal strBody As String, _
ByVal strUsername As String, ByVal strPassword As String, ByVal
strDomain As String, _
ByRef strStatusText As String, ByRef iStatCode As Integer) As
XmlDocument
' Create a new CredentialCache object and fill it with the
network credentials required to access the server.
Dim Username As String = strUsername
Dim Password As String = strPassword
Dim Domain As String = strDomain
Dim myCred As New NetworkCredential(Username, Password,
Domain)
Dim myUri As System.Uri = New System.Uri(strURL)
Dim MyCredentialCache As New CredentialCache
MyCredentialCache.Add(myUri, "NTLM", myCred)
Dim objResponse As HttpWebResponse
' Create the HttpWebRequest object.
Dim objRequest As HttpWebRequest =
CType(WebRequest.Create(strURL), HttpWebRequest)
Try
' Add the network credentials to the request.
objRequest.Credentials = MyCredentialCache
' Specify the method.
objRequest.Method = strCommand
' Set Headers
objRequest.KeepAlive = False
objRequest.Headers.Set("Pragma", "no-cache")
objRequest.ContentType = "text/xml"
objRequest.ProtocolVersion = HttpVersion.Version11
'Set the request timeout to 5 minutes
objRequest.Timeout = 300000
If (strBody.Length > 0) Then
' Store the data in a byte array
Dim ByteQuery() As Byte =
System.Text.Encoding.ASCII.GetBytes(strBody)
objRequest.ContentLength = ByteQuery.Length
Dim QueryStream As Stream =
objRequest.GetRequestStream()
' Write the data to be posted to the Request Stream
QueryStream.Write(ByteQuery, 0, ByteQuery.Length)
QueryStream.Close()
End If
Response.Write("hier2" & myUri.OriginalString & "<br>")
Response.Write("hier2" & strBody & "<br>")
' Send the method request and get the response from the
server.
objResponse = CType(objRequest.GetResponse(),
HttpWebResponse)
' Get the Status code
iStatCode = objResponse.StatusCode
strStatusText = objResponse.StatusDescription
' Get the XML response stream.
Dim ResponseStream As System.IO.Stream =
objResponse.GetResponseStream()
' Create the XmlDocument object from the XML response
stream.
Dim ResponseXmlDoc As New System.Xml.XmlDocument
ResponseXmlDoc.Load(ResponseStream)
' Clean up.
objResponse.Close()
objRequest = Nothing
objResponse = Nothing
myUri = Nothing
myCred = Nothing
MyCredentialCache = Nothing
Return ResponseXmlDoc
Catch ex As WebException
' Catch any exceptions. Any error codes from the method
requests on the server will be caught here, also.
strStatusText = ex.Message
iStatCode = ex.Status
Dim ResponseXmlDoc As New System.Xml.XmlDocument
ResponseXmlDoc.InnerXml = "<?xml version=""1.0""?
End Try
'Return Nothing
End Function
I'm trying to read the exchange calendar of people via webdav. This
works fine for the most part, but some users have been migrated from
other departments, and have a different default language, and
therefore a different webdav URL.
What I'm trying to do is the following:
1. try to read http://servername/exchange/emailaddress/agenda/ (dutch
version)
2. If this fails, try to read http://servername/exchange/emailaddress/calendar
What happens is that if the first attempt fails, the second attempt
allways fails. If I change the order (first calendar, then agenda) it
works fine for the english users.
any ideas?
Bart
Sub get_calendar(ByVal struserid As String, ByVal strserver As String,
ByVal strusername As String, ByVal strpassword As String, ByVal
strdomain As String)
Dim dDate As DateTime
dDate = Today
' now get the calendar for this user
Dim strURL As String = "http://" & strserver & "/exchange/" &
struserid & "/agenda/"
'Dim strURL As String = "http://" & strserver & "/exchange/" &
struserid & "/calendar/"
Dim strRequest As String = "<?xml version=""1.0""?>" & _
"<g:searchrequest xmlns:g=""DAV:"">" & _
"<g:sql>SELECT ""urn:schemas:calendar:location"",
""urn:schemas:httpmail:subject"", " & _
"""urn:schemas:calendar:dtstart"",
""urn:schemas:calendar:dtend"", " & _
"""urn:schemas:calendar:meetingstatus"", ""http://
schemas.microsoft.com/exchange/sensitivity"", " & _
"""urn:schemas:httpmail:textdescription"",
""urn:schemas:calendar:alldayevent"", " & _
"""urn:schemas:calendar:busystatus"",
""urn:schemas:calendar:instancetype"" " & _
"FROM Scope('SHALLOW TRAVERSAL OF """ & strURL &
"""') " & _
"WHERE NOT ""urn:schemas:calendar:instancetype"" = 1
" & _
"AND ""DAV:contentclass"" = 'urn:content-
classes:appointment' " & _
"AND ""urn:schemas:calendar:dtstart"" > '" & _
String.Format("{0:yyyy/MM/dd}", dDate.AddDays(-1)) &
" 21:59:00' " & _
"AND ""urn:schemas:calendar:dtend"" < '" & _
String.Format("{0:yyyy/MM/dd}", dDate.AddDays(1)) &
" 00:00:00' " & _
"ORDER BY ""urn:schemas:calendar:dtstart"" ASC" & _
"</g:sql></g:searchrequest>"
Dim strStatusText As String = ""
Dim Status As Integer
Dim ResponseXmlDoc As XmlDocument
ResponseXmlDoc = SendRequest("SEARCH", strURL, strRequest,
strusername, strpassword, strdomain, strStatusText, Status)
Dim tries As Integer = 0
If Status = 7 And tries = 0 Then ' we check for an
unauthorized error, and then try again with the english version...
strURL = "http://" & strserver & "/exchange/" & struserid
& "/calendar/"
tries = 1
strStatusText = ""
Status = 0
ResponseXmlDoc = SendRequest("SEARCH", strURL, strRequest,
strusername, strpassword, strdomain, strStatusText, Status)
End If
xslTransform.DocumentContent = ResponseXmlDoc.InnerXml
xslTransform.TransformSource = Server.MapPath("Calendar.xsl")
'Response.End()
End Sub
Function SendRequest(ByVal strCommand As String, ByVal strURL As
String, ByVal strBody As String, _
ByVal strUsername As String, ByVal strPassword As String, ByVal
strDomain As String, _
ByRef strStatusText As String, ByRef iStatCode As Integer) As
XmlDocument
' Create a new CredentialCache object and fill it with the
network credentials required to access the server.
Dim Username As String = strUsername
Dim Password As String = strPassword
Dim Domain As String = strDomain
Dim myCred As New NetworkCredential(Username, Password,
Domain)
Dim myUri As System.Uri = New System.Uri(strURL)
Dim MyCredentialCache As New CredentialCache
MyCredentialCache.Add(myUri, "NTLM", myCred)
Dim objResponse As HttpWebResponse
' Create the HttpWebRequest object.
Dim objRequest As HttpWebRequest =
CType(WebRequest.Create(strURL), HttpWebRequest)
Try
' Add the network credentials to the request.
objRequest.Credentials = MyCredentialCache
' Specify the method.
objRequest.Method = strCommand
' Set Headers
objRequest.KeepAlive = False
objRequest.Headers.Set("Pragma", "no-cache")
objRequest.ContentType = "text/xml"
objRequest.ProtocolVersion = HttpVersion.Version11
'Set the request timeout to 5 minutes
objRequest.Timeout = 300000
If (strBody.Length > 0) Then
' Store the data in a byte array
Dim ByteQuery() As Byte =
System.Text.Encoding.ASCII.GetBytes(strBody)
objRequest.ContentLength = ByteQuery.Length
Dim QueryStream As Stream =
objRequest.GetRequestStream()
' Write the data to be posted to the Request Stream
QueryStream.Write(ByteQuery, 0, ByteQuery.Length)
QueryStream.Close()
End If
Response.Write("hier2" & myUri.OriginalString & "<br>")
Response.Write("hier2" & strBody & "<br>")
' Send the method request and get the response from the
server.
objResponse = CType(objRequest.GetResponse(),
HttpWebResponse)
' Get the Status code
iStatCode = objResponse.StatusCode
strStatusText = objResponse.StatusDescription
' Get the XML response stream.
Dim ResponseStream As System.IO.Stream =
objResponse.GetResponseStream()
' Create the XmlDocument object from the XML response
stream.
Dim ResponseXmlDoc As New System.Xml.XmlDocument
ResponseXmlDoc.Load(ResponseStream)
' Clean up.
objResponse.Close()
objRequest = Nothing
objResponse = Nothing
myUri = Nothing
myCred = Nothing
MyCredentialCache = Nothing
Return ResponseXmlDoc
Catch ex As WebException
' Catch any exceptions. Any error codes from the method
requests on the server will be caught here, also.
strStatusText = ex.Message
iStatCode = ex.Status
Dim ResponseXmlDoc As New System.Xml.XmlDocument
ResponseXmlDoc.InnerXml = "<?xml version=""1.0""?
Return ResponseXmlDoc
End Try
'Return Nothing
End Function