Option Explicit On 
Option Strict Off
Option Compare Binary


'=============================================================================================================
'
' cCDONTS Class Module
' --------------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://net.TheVBZone.com   ( The VB Zone .net )
'               http://rb.thevbzone.com    ( The VB Zone [RB] )

' Created On  : May 11, 2005
' Last Update : May 11, 2005
'
' VB Versions : VB.NET 1.1 (VS.NET 2003)
'
' Requires    : An SMTP (Simple Mail Transfer Protocol) server... which is specified by the "SmtpServer" property
'               The .NET Framework v1.1
'               Reference System.Web.dll
'
' Description : This class module allows you to easily send Emails via .NET's built in "System.Web.Mail" 
'               namespace.  The "SendEmail" method uses the parameters passed to it to send a simple Email 
'               (doesn't support attachments).  The "SendEmailEx" uses the properties of this class to send a 
'               more complex Emails (supports multiple attachments seperated by PIPE "|" ).  Both "SendEmail"
'               methods support 1 FROM address, and multiple TO/CC/BCC addresses seperated by semi-colon ";".
'
' See Also    : http://msdn.microsoft.com/library/en-us/cpref/html/frlrfSystemWebMail.asp
'               http://msdn.microsoft.com/library/en-us/cpref/html/frlrfSystemWebMailMailMessageClassTopic.asp
'               http://msdn.microsoft.com/library/en-us/cpref/html/frlrfSystemWebMailSmtpMailClassTopic.asp
'
'
'-------------------------------------------------------------------------------------------------------------
' Example #1  :
'-------------------------------------------------------------------------------------------------------------
'
'  Dim MAIL       As cCDONTS
'  Dim lngErrNum  As Integer
'  Dim strErrDesc As String
'
'  Set MAIL = New cCDONTS
'  If MAIL.SendEmail("BillGates@Microsoft.com", _
'                    "Everyone@TheWorld.org", _
'                    "Everyone@TheGovernment.gov", _
'                    vbNullString, _
'                    "ButtHead@Microsoft.com", _
'                    "I'm Sorry", _
'                    "<FONT FACE=" & Chr(34) & "Arial" & Chr(34) & "><B><I>Sorry for all the crappy " & _
'                      "software, here's some money for all the time you wasted dealing with and debugging " & _
'                      "my software.</B></I></FONT>", _
'                    True, CdoHigh, _
'                    lngErrNum, strErrDesc) = False Then
'    MsgBox "Error!" & Chr(13) & Chr(13) & _
'           "Error Number = " & CStr(lngErrNum) & Chr(13) & _
'           "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, "  Error"
'  Else
'    MsgBox "Email Sent!"
'  End If
'  Set MAIL = Nothing
'
'-------------------------------------------------------------------------------------------------------------
' Example #2  :
'-------------------------------------------------------------------------------------------------------------
'
'  Dim MAIL       As cCDONTS
'  Dim lngErrNum  As Integer
'  Dim strErrDesc As String
'
'  Set MAIL = New cCDONTS
'  With MAIL
'    .AddressFROM = "BillGates@Microsoft.com"
'    .AddressTO = "Everyone@TheWorld.org"
'    .AddressCC = "Everyone@TheGovernment.gov"
'    .AddressReplyTo = "ButtHead@Microsoft.com"
'    .Subject = "I'm Sorry"
'    .Body = "Sorry for all the crappy software, here's some money for all the time you wasted " & _
'            "dealing wiht and debugging my software."
'    .BodyIsHTML = False
'    .AttachFile = True
'    .PriorityLevel = CdoLow
'    .AttachmentEncoding = CdoEncodingBase64
'    .AttachmentPath = "C:\BANK_INFO.DOC|C:\INSTRUCTIONS.DOC"
'  End With
'
'  If MAIL.SendEmailEx(lngErrNum, strErrDesc) = False Then
'    MsgBox "Error!" & Chr(13) & Chr(13) & _
'           "Error Number = " & CStr(lngErrNum) & Chr(13) & _
'           "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, "  Error"
'  Else
'    MsgBox "Email Sent!"
'  End If
'  Set MAIL = Nothing
'
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


Imports System
Imports System.Web.Mail
Imports Microsoft
Imports Microsoft.VisualBasic

Public Class cCDO_NET


   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     CLASS PROPERTY DECLARATIONS     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


   ' Specifies the SMTP server to use.  If left blank, "LOCALHOST" is assumed.
   ' NOTE: Port 25 is always used, and you can NOT specify a username/password to log into that SMTP server
   Public SmtpServer As String

   ' Specifies who is sending the Email.  This can not have multiple addresses.
   ' TIP: The following will send both your name and address  "Kevin Wilson <VBZ@thevbzone.com>"
   Public AddressFROM As String

   ' The address that the Email should be sent to when the recipient clicks the REPLY button on the Email.
   ' This can not have multiple addresses.
   ' TIP: The following will send both your name and address  "Kevin Wilson <VBZ@thevbzone.com>"
   Public AddressReplyTo As String

   ' Main recipient(s) of the Email.  If using multiple addresses, seperate them with a semicolon (;)
   ' TIP: The following will send both your name and address  "Kevin Wilson <VBZ@thevbzone.com>"
   Public AddressTO As String

   ' Recipient(s) to "CARBON COPY" the Email to.  If using multiple addresses, seperate them with a semicolon (;)
   ' TIP: The following will send both your name and address  "Kevin Wilson <VBZ@thevbzone.com>"
   Public AddressCC As String

   ' Recipient(s) to "BLIND CARBON COPY" the Email to.  If using multiple addresses, seperate them with a semicolon (;)
   ' TIP: The following will send both your name and address  "Kevin Wilson <VBZ@thevbzone.com>"
   Public AddressBCC As String

   ' This is the subject of the Email
   Public Subject As String

   ' This is the main content of the Email
   Public Body As String

   ' If set to TRUE, the body of the Email will be treated as HTML
   Public BodyIsHTML As Boolean

   ' If the Email is HTML, this specifies the base location/path/URL of all the images or links in the HTML body of the Email
   ' Example = "http://www.MyDomain.com/NewSite/"
   Public HtmlBaseLocation As String

   ' The priority of the Email
   Public PriorityLevel As MailPriority

   ' The format of the Email (ASCII / UTF8 / UTF7 / etc.)
   Public EmailFormat As Text.Encoding

   ' The encoding to use with the Email (Base64 / UUEncode)
   Public AttachmentEncoding As MailEncoding

   ' The full path to one or more attachment files (seperated by the PIPE "|" character)
   Public AttachmentPath As String

   ' If set to true and an attachment path or object is specified, an attachment will be tacked onto the Email
   Public AttachFile As Boolean

   ' This property gets the current version number for CDO (Collaboration Data Objects)
   Public ReadOnly Property CdoVersion() As String
      Get
         Return "Microsoft .NET (System.Web.Mail)"
      End Get
   End Property


   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     CLASS EVENT DECLARATIONS     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


   Public Sub New()

      ' Set initial property values
      Subject = "(none)"
      Body = " "
      PriorityLevel = MailPriority.Normal
      EmailFormat = Text.Encoding.ASCII
      AttachmentEncoding = MailEncoding.Base64

   End Sub


   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     CLASS METHOD DECLARATIONS     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


   ' This function uses the "NewMail" object to send a simple Email based on the parameters passed to it.
   Public Function SendEmail(ByVal strFrom As String, _
                             ByVal strTO As String, _
                             Optional ByVal strCC As String = vbNullString, _
                             Optional ByVal strBCC As String = vbNullString, _
                             Optional ByVal strReplyTo As String = vbNullString, _
                             Optional ByVal strSubject As String = "", _
                             Optional ByVal strBody As String = "", _
                             Optional ByVal blnBodyIsHTML As Boolean = False, _
                             Optional ByVal udtPriorityLevel As MailPriority = MailPriority.Normal, _
                             Optional ByRef Return_ErrNum As Int32 = 0, _
                             Optional ByRef Return_ErrDesc As String = "") As Boolean
      On Error GoTo ErrorTrap

      Dim objServer As SmtpMail
      Dim objNewMail As MailMessage

      ' Clear return variables
      Return_ErrNum = 0
      Return_ErrDesc = ""

      ' Make sure the minimum requirements for sending an Email are met
      If Trim(strFrom) = "" Then
         Return_ErrNum = -1 : Return_ErrDesc = "No FROM Email address specified"
         Exit Function
      ElseIf Trim(strTO) = "" Then
         Return_ErrNum = -1 : Return_ErrDesc = "No TO Email address specified"
         Exit Function
      ElseIf (Trim(strSubject) = "" And Trim(strBody) = "") Then
         Return_ErrNum = -1 : Return_ErrDesc = "No subject nor body specified to send the Email"
         Exit Function
      End If
      If strSubject = "" Then strSubject = "(none)"
      If strBody = "" Then strBody = " "

      ' Initialize the object that sends the Email
      objServer.SmtpServer = SmtpServer
      objNewMail = New MailMessage

      ' Set the Email object's properties
      With objNewMail
         .From = strFrom
         .To = strTO
         If strCC <> "" Then .Cc = strCC
         If strBCC <> "" Then .Bcc = strBCC
         If strReplyTo <> "" Then .Headers.Add("Reply-To", strReplyTo)
         .Subject = strSubject
         .Body = strBody
         If blnBodyIsHTML = True Then
            .BodyFormat = MailFormat.Html
         Else
            .BodyFormat = MailFormat.Text
         End If
         .BodyEncoding = Text.Encoding.ASCII
         .Priority = udtPriorityLevel
      End With

      ' Send the Email
      objServer.Send(objNewMail)

      ' Clean up
      SendEmail = True
      objNewMail = Nothing
      Exit Function

ErrorTrap:

      Return_ErrNum = Err.Number
      Return_ErrDesc = Err.Description
      Err.Clear()
      If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Resume Next
      objNewMail = Nothing

   End Function


   ' This function uses the "NewMail" object to send a complex Email based on the properties set within this class
   Public Function SendEmailEx(Optional ByRef Return_ErrNum As Int32 = 0, _
                               Optional ByRef Return_ErrDesc As String = "") As Boolean
      On Error GoTo ErrorTrap

      Dim objServer As SmtpMail
      Dim objNewMail As MailMessage
      Dim strFileName As String
      Dim strAttachments() As String
      Dim lngAttachCount As Int32
      Dim lngCounter As Int32

      ' Clear return variables
      Return_ErrNum = 0
      Return_ErrDesc = ""

      ' Make sure the minimum requirements for sending an Email are met
      If Trim(AddressFROM) = "" Then
         Return_ErrNum = -1 : Return_ErrDesc = "No FROM Email address specified"
         Exit Function
      ElseIf Trim(AddressTO) = "" Then
         Return_ErrNum = -1 : Return_ErrDesc = "No TO Email address specified"
         Exit Function
      ElseIf (Trim(Subject) = "" And Trim(Body) = "") Then
         Return_ErrNum = -1 : Return_ErrDesc = "No subject nor body specified to send the Email"
         Exit Function
      ElseIf AttachFile = True Then

         ' Get the list of attachments and validate them
         If Trim(AttachmentPath) = "" Then
            AttachFile = False
         Else
            If SplitList(AttachmentPath, strAttachments, lngAttachCount, "|") = False Then
               Return_ErrNum = -1 : Return_ErrDesc = "Could not get the list of attachments for the Email."
               Exit Function
            Else
               If lngAttachCount > 0 Then
                  For lngCounter = 0 To lngAttachCount - 1
                     If IO.File.Exists(strAttachments(lngCounter)) = False Then
                        Return_ErrNum = -1 : Return_ErrDesc = "The file " & Chr(34) & strAttachments(lngCounter) & Chr(34) & " could not be found to attach to the Email"
                        Exit Function
                     End If
                  Next
               Else
                  AttachFile = False
               End If
            End If
         End If

      End If
      If Subject = "" Then Subject = "(none)"
      If Body = "" Then Body = " "

      ' Initialize the object that sends the Email
      objServer.SmtpServer = SmtpServer
      objNewMail = New MailMessage

      ' Set the Email object's properties
      With objNewMail
         .From = AddressFROM
         .To = AddressTO
         If AddressCC <> "" Then .Cc = AddressCC
         If AddressBCC <> "" Then .Bcc = AddressBCC
         If AddressReplyTo <> "" Then .Headers.Add("Reply-To", AddressReplyTo)
         .Subject = Subject
         .Body = Body
         If BodyIsHTML = True Then
            .BodyFormat = MailFormat.Html
         Else
            .BodyFormat = MailFormat.Text
         End If
         .BodyEncoding = EmailFormat
         .Priority = PriorityLevel
         If HtmlBaseLocation <> "" Then .UrlContentBase = HtmlBaseLocation
      End With

      ' Attach the specified attachment to the Email
      If AttachFile = True Then
         If lngAttachCount > 0 Then
            For lngCounter = 0 To lngAttachCount - 1
               objNewMail.Attachments.Add(New MailAttachment(strAttachments(lngCounter), AttachmentEncoding))
            Next
         End If
      End If

      ' Send the Email
      objServer.Send(objNewMail)

      ' Clean up
      SendEmailEx = True
      objNewMail = Nothing
      Exit Function

ErrorTrap:

      Return_ErrNum = Err.Number
      Return_ErrDesc = Err.Description
      Err.Clear()
      If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Resume Next
      objNewMail = Nothing

   End Function


   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     PRIVATE FUNCTION DECLARATIONS     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


   ' This function takes the specified list (seperated by the specified split character) passed in via the
   ' strSplitList parameter and seperates them out.  It returns them as a string array.
   Private Function SplitList(ByVal strSplitList As String, _
                              ByRef Return_Items() As String, _
                              ByRef Return_Count As Int32, _
                              Optional ByVal strSplitChar As String = ";") As Boolean
      On Error Resume Next

      Dim strItem As String
      Dim lngEnd As Int32

      ' Clear the return varaibles
      Return_Count = 0
      Erase Return_Items

      ' Validate the parameter passed
      strSplitChar = Left(strSplitChar, 1)
      strSplitList = Trim(strSplitList)
      If strSplitList = "" Then
         SplitList = True
         Exit Function
      ElseIf InStr(1, strSplitList, strSplitChar, vbTextCompare) = 0 Then
         Return_Count = 1
         ReDim Return_Items(0) 'As String
         Return_Items(0) = strSplitList
         SplitList = True
         Exit Function
      Else
         If Right(strSplitList, 1) <> strSplitChar Then strSplitList = strSplitList & strSplitChar
      End If

      ' Go through the list and get the addresses out
      lngEnd = InStr(1, strSplitList, strSplitChar, vbTextCompare)
      Do While lngEnd > 0
         strItem = Mid(strSplitList, 1, (lngEnd - 1))

         ReDim Preserve Return_Items(Return_Count) 'As String
         Return_Items(Return_Count) = strItem
         Return_Count = Return_Count + 1

         strSplitList = Right(strSplitList, (Len(strSplitList) - Len(strItem)) - 1)
         lngEnd = InStr(1, strSplitList, strSplitChar, vbTextCompare)
      Loop

      SplitList = True

   End Function

End Class