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