Imports System.Reflection
Module Module1
Sub Main()
'TODO: Replace with the name of the computer that is running Microsoft Exchange 2000 Server.
Dim strExchSvr As String = "<ExchServerName>"
'TODO: Replace with the alias of the sender.
Dim strAlias As String = "<UserAlias>"
'TODO: Replace with the domain name and the alias of the sender.
Dim strUserName As String = "<UserDomain\UserAlias>"
'TODO: Replace with the sender's password.
Dim strPassWord As String = "<UserPassword>"
Dim sMailUrl As String
sMailUrl = FindSubmissionURL(strExchSvr, strAlias, strUserName, strPassWord)
If (sMailUrl <> "") Then
' TODO: Replace with your mail information.
Dim strFrom As String = "from@example.com"
Dim strTo As String = "to@example.com"
Dim strSubject As String = "Send Using Webdav"
Dim strBody As String = "Hello World"
Dim oXMLHttp As MSXML2.XMLHTTP30 = New MSXML2.XMLHTTP30()
oXMLHttp.open("PUT", sMailUrl, False, strUserName, strPassWord)
Dim mySentTime As DateTime = New DateTime()
Dim sQuery As String
sQuery = "From: " & strFrom & vbNewLine & _
"To: " & strTo & vbNewLine & _
"Subject: " & strSubject & vbNewLine & _
"Date: " & Convert.ToDateTime("9/11/2001 11:45 AM") & vbNewLine & _
"X-Mailer: My DAV mailer" & vbNewLine & _
"MIME-Version: 1.0" & vbNewLine & _
"Content-Type: text/plain" & vbNewLine & _
"Charset = ""iso-8859-1""" & vbNewLine & _
"Content-Transfer-Encoding: 7bit" & vbNewLine & vbNewLine & _
strBody
oXMLHttp.setRequestHeader("Translate", "f")
oXMLHttp.setRequestHeader("Content-Type", "message/rfc822")
oXMLHttp.setRequestHeader("Content-Length", "" & sQuery.Length)
oXMLHttp.send(sQuery)
Console.WriteLine(oXMLHttp.status)
Console.WriteLine(oXMLHttp.statusText)
Console.WriteLine(oXMLHttp.responseText)
oXMLHttp = Nothing
End If
End Sub
Private Function FindSubmissionURL(ByVal strExchSvr As String, ByVal strAlias As String, ByVal strUserName As String, ByVal strPassWord As String) As String
Dim query As String
Dim strURL As String
Dim baseName As String = ""
Dim xmlReq As MSXML2.XMLHTTP30 = New MSXML2.XMLHTTP30()
Dim xmldom As MSXML2.DOMDocument = New MSXML2.DOMDocument()
Dim xmlRoot As MSXML2.IXMLDOMElement
Dim xmlNode As MSXML2.IXMLDOMNode
'Create the DAV PROPFIND request.
strURL = "http://" & strExchSvr & "/exchange/" & strAlias
xmlReq.open("PROPFIND", strURL, False, strUserName, strPassWord)
xmlReq.setRequestHeader("Content-Type", "text/xml")
xmlReq.setRequestHeader("Depth", "0")
query = "<?xml version='1.0'?>"
query = query & "<a:propfind xmlns:a='DAV:'>"
query = query & "<a:prop xmlns:m='urn:schemas:httpmail:'>"
query = query & "<m:sendmsg/>"
query = query & "</a:prop>"
query = query & "</a:propfind>"
xmlReq.send(query)
Console.WriteLine(xmlReq.status)
Console.WriteLine(xmlReq.statusText)
Console.WriteLine(xmlReq.responseText)
' Process the result.
If xmlReq.status >= 200 And xmlReq.status < 300 Then
xmldom.loadXML(xmlReq.responseText)
xmlRoot = xmldom.documentElement
Dim i As Integer
For i = 1 To xmlRoot.attributes.length
xmlNode = xmlRoot.attributes(i)
If xmlNode.text = "urn:schemas:httpmail:" Then
baseName = xmlNode.baseName
Exit For
End If
Next
xmlNode = xmlRoot.selectSingleNode("//" & baseName & ":sendmsg")
Return xmlNode.text
Else
Console.WriteLine("Cannot find mail submission URL")
Return ""
End If
End Function
End Module