<%
CLASS ss_CDOMail

    Private smtp            'ip or a valid DNS host name [string] - "localhost"
    Private smtpBck         'ip or a valid DNS host name [string] - ""
    Private smtpPrt         'smtp server port [string] - "25"
    Private cdoObj          'cdo.message object [object]
    Private errMsg          'detailed error message [string]
    Private customErrMsg    'custom error message [string]
    Private fromEmail       'from email address [sting]
    Private toEmail         'to email address [string]
    Private ccEmail         'cc email address [string]
    Private bccEmail        'bcc email address [string]
    Private subject         'email subject [string]
    Private smtpAuth        'used if smtp server requires authenticaion or not [0|1]
    Private smtpUName       'user name for smtp server [string]
    Private smtpPass        'password for smtp server [string]
    Private attachArray
    Private htmlBody        'the html part of the email [string]
    Private textBody        'the text part of the body [string]
    
    Private cdoRefTypeId
    Private cdoRefTypeLocation
    
    'Class constructor
    '@throws    [910] Could not create {CDO.Message} object
    Private Sub Class_Initialize()
        
        On Error Resume Next
        
        errMsg = ""
        
        Set cdoObj = Server.CreateObject("CDO.Message")
        if Err.Number <> 0 then
            Err.Raise 910, "ss_cdo_mail.class_initialize.10", ssGetLocaleString("Error.910", Array("CDO.Message"))
            Exit Sub
        end if
        
        toEmail =""
        fromEmail = ""
        ccEmail = ""
        bccEmail = ""
        smtp = "localhost"
        smtpBck = ""
        smtpPrt = "25"
        subject = ""
        smtpAuth = 0
        ReDim attachArray(0)
        attachArray(0) = ""
        cdoRefTypeId = 0
        cdoRefTypeLocation = 1
    End Sub
    
    'class destructor
    Private Sub Class_Terminate()
        set cdoObj = nothing
    End Sub
    

    Public Function AddAttachment(ByVal fileContent, ByVal CType, ByVal FileName)
    
        On Error Resume Next
        
        Dim iBp, flds, stm, s, s1
        
        set iBp  = cdoObj.Attachments.Add
        Set flds = iBp.Fields

        with flds
            .Item("urn:schemas:mailheader:content-type")                  = CType & "; name=" & FileName
            if ( CType = "text/plain" ) then
                .Item("urn:schemas:mailheader:content-transfer-encoding") = "7bit"
            elseif ( inStr(1,Ctype, "text/") ) then
                .Item("urn:schemas:mailheader:content-transfer-encoding") = "quoted-printable"
            else
                .Item("urn:schemas:mailheader:content-transfer-encoding") = "base64"
            end if
            
            .Item("urn:schemas:mailheader:content-disposition") = "attachment; fileName=" & FileName

            .Update
        end with
        set flds = nothing
        
        if ( inStr(1, CType, "text/") ) then
            set stm = iBp.GetDecodedContentStream
        else
            set stm = iBp.GetEncodedContentStream
            fileContent = Base64Encode(fileContent)
        end if

        stm.WriteText fileContent
        stm.Position = 0
        s = stm.ReadText(20)
        
        stm.Flush
        set Stm = Nothing
    End function
    
    Public sub AddEmbeddedImage(ByVal url, ByVal id)
        cdoObj.AddRelatedBodyPart url, id, cdoRefTypeLocation
    End sub

    Public function SendMail()
        Dim configurationObj, fieldsObj, i
        dim iBp, flds, strm

        On Error Resume Next
        if isNotEmailAddress(toEmail) then
            Err.Raise 200, "ss_cdo_mail.SendMail.10", ssGetLocaleString("Error.200", Null)
            SendMail = false
            exit function
        end if
        
        if Trim(fromEmail) = "" then
            Err.Raise 202, "ss_cdo_mail.SendMail.10", ssGetLocaleString("Error.202", Null)
            SendMail = false
            exit function
        end if
        
        Set configurationObj =  CreateObject("CDO.Configuration")
        Set fieldsObj = configurationObj.Fields
        With fieldsObj
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpPrt
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtp
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
            if ( smtpAuth ) then
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = smtpUName
                .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = smtpPass
            end if
            .Update
        End With
        Set fieldsObj = nothing

        if not cdoObj is nothing then
            
            With cdoObj
                set .Configuration = configurationObj
                .From = fromEmail
                .To = toEmail
                if ( Trim(ccEmail) <> "") then .CC = ccEmail
                if ( Trim(bccEmail) <> "") then .BCC = bccEmail
                .Subject = subject

                if textBody <> "" then
                    Set iBp = .BodyPart.AddBodyPart
                    Set flds = iBp.Fields
                    flds("urn:schemas:mailheader:content-type") = "text/plain"
                    flds.Update
                    Set strm = iBp.GetDecodedContentStream
                    strm.WriteText textBody
                    strm.Flush
                end if

                if htmlBody <> "" then
                    Set iBp = .BodyPart.AddBodyPart
                    Set flds = iBp.Fields
                    flds("urn:schemas:mailheader:content-type") = "text/html"
                    flds.Update
                    Set strm = iBp.GetDecodedContentStream
                    strm.WriteText htmlBody
                    strm.Flush
                    
                    '//sets the mime type for the email
                    Set flds = cdoObj.Fields
                    flds("urn:schemas:mailheader:content-type") = "multipart/alternative"
                    flds.Update
                end if

                for i=0 to UBound(attachArray)
                    if attachArray(i) <> "" then
                        .AddAttachment(attachArray(i))
                        if Err.number <> 0 then Err.Clear
                    end if
                next
                
                Err.Clear()
                .Send
                if (Err.Number <> 0 ) then
                
                    Err.Raise 201, "ss_cdo_mail.SendMail.55", ssGetLocaleString("Error.201", Array(toEmail, fromEmail, smtp))
                    SendMail = False
                     
                    if smtpBck <> "" then
                        Err.Clear()

                        Set fieldsObj = configurationObj.Fields
                        With fieldsObj
                            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpPrt
                            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpBck
                            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
                            if ( smtpAuth ) then
                                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = smtpUName
                                .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = smtpPass
                            end if
                            .Update
                        End With
                        Set fieldsObj = nothing

                        Set .Configuration = configurationObj

                        .Send()
                        if ( Err.Number <> 0 ) then
                            Err.Raise 201, "ss_cdo_mail.SendMail.65", ssGetLocaleString("Error.201", Array(toEmail, fromEmail, smtpBck))
                            SendMail = False
                            set configurationObj = nothing
                            exit function
                        end if
                    else
                        set configurationObj = nothing
                        SendMail = false
                    end if
                end if
                
            End With
        end if
        
        set configurationObj = nothing
        SendMail = true
    End function
    
    Private function isNotEmailAddress(str)
        isNotEmailAddress = false
        if ( isNull(str) or isEmpty(str) or Trim(str) = "" ) then isNotEmailAddress = true
    End function

    ' Functions for encoding string to Base64
    Function Base64Encode(inData)
      Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
      Dim cOut, sOut, I
      
      'For each group of 3 bytes
      For I = 1 To Len(inData) Step 3
        Dim nGroup, pOut, sGroup
        
        'Create one long from this 3 bytes.
        nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
          &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
        
        'Oct splits the long To 8 groups with 3 bits
        nGroup = Oct(nGroup)
        
        'Add leading zeros
        nGroup = String(8 - Len(nGroup), "0") & nGroup
        
        'Convert To base64
        pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
        
        'Add the part To OutPut string
        sOut = sOut + pOut
        
        'Add a new line For Each 76 chars In dest (76*3/4 = 57)
        'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
      Next
      Select Case Len(inData) Mod 3
        Case 1: '8 bit final
          sOut = Left(sOut, Len(sOut) - 2) + "=="
        Case 2: '16 bit final
          sOut = Left(sOut, Len(sOut) - 1) + "="
      End Select
      Base64Encode = sOut
    End Function

    Function MyASC(OneChar)
      If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
    End Function
    
'   Get/Let properties
    Public Property Get SmtpServer()
        SmtpServer = smtp
    End Property
    Public Property Let SmtpServer(ByVal s)
        smtp = s
    End Property
    Public Property Get SmtpBackupServer()
        SmtpBackupServer = smtpBck
    End Property
    Public Property Let SmtpBackupServer(ByVal s)
        smtpBck = s
    End Property
    Public Property Get SmtpPort()
        SmtpPort = smtpPrt
    End Property
    Public Property Let SmtpPort(ByVal s)
        smtpPrt = s
    End Property
    Public Property Get EmailFrom()
        EmailFrom = fromEmail
    End Property
    Public Property Let EmailFrom(ByVal s)
        fromEmail = s
    End Property
    Public Property Get EmailTo()
        EmailTo = toEmail
    End Property
    Public Property Let EmailTo(ByVal s)
        toEmail = s
    End Property
    Public Property Get EmailCC()
        EmailCC = ccEmail
    End Property
    Public Property Let EmailCC(ByVal s)
        ccEmail = s
    End Property
    Public Property Get EmailBCC()
        EmailBCC = bccEmail
    End Property
    Public Property Let EmailBCC(ByVal s)
        bccEmail = s
    End Property
    Public Property Get EmailSubject()
        EmailSubject = subject
    End Property
    Public Property Let EmailSubject(ByVal s)
        subject = s
    End Property
    Public Property Get AddHtmlBody()
        AddHtmlBody = htmlBody
    End Property
    Public Property Let AddHtmlBody(ByVal s)
        htmlBody = s
    End Property
    Public Property Get AddTextBody()
        AddTextBody = textBody
    End Property
    Public Property Let AddTextBody(ByVal s)
        textBody = s
    End Property
    Public Property Get SMTPAuthenticate()
        SMTPAuthenticate = smtpAuth
    End Property
    Public Property Let SMTPAuthenticate(ByVal b)
        smtpAuth = CLng(b)
    End Property
    Public Property Get SMTPUserName()
        SMTPUserName = smtpUName
    End Property
    Public Property Let SMTPUserName(ByVal s)
        smtpUName = s
    End Property
    Public Property Get SMTPPassword()
        SMTPPassword = smtpPass
    End Property
    Public Property Let SMTPPassword(ByVal s)
        smtpPass = s
    End Property
    Public Property Get AttachmentsList()
        AttachmentsList = attachArray
    End Property
    Public Property Let AttachmentsList(ByVal s)
        if attachArray(UBound(attachArray)) <> "" then
            ReDim Preserve attachArray( UBound(attachArray) + 1 )
        end if
        attachArray(UBound(attachArray)) = s
    End Property

    Public Property Get ErrorMessage()
        ErrorMessage = errMsg
    End Property
    Public Property Get CustomErrorMessage()
        CustomErrorMessage = customErrMsg
    End Property
    
END CLASS
%>