<%
Option Explicit
On Error Resume Next

Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
Dim uploader, i, j, xmlElem, getEmailFromReq, fso, fld, upfldPath, filesName, dbPath
Dim xmlObj, fieldsNode, field, parameters, param, successPage, templateNode
Dim smtpNode, result, debug, warnings, referrer, prop, prop1, xmlPath

Dim gPageHasErrors
gPageHasErrors = false
    
referrer = Request.ServerVariables("HTTP_REFERER").Item
getEmailFromReq = true
debug = false
warnings = ""
set filesName = Server.CreateObject("Scripting.Dictionary")

Set Uploader = New FileUploader
Uploader.Upload()


if (Err.number <> 0) then 
    Call Err.Raise(800, "Uploader.Upload", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName))
end if

if ( uploader.Form( "_nof_param_file" ) = "") then 
    Call Err.Raise(800, "noparam", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName))
end if

xmlPath = uploader.Form( "_nof_param_file" )
    
if inStr(1,xmlPath , "\")  = 0 then
    xmlPath = Server.MapPath( xmlPath )
end if

if not fileExists( xmlPath ) then
    Call Err.Raise(601, "ServMpPth", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName))
end if

Err.Clear()
set xmlObj = openXmlFile( xmlPath )
if xmlObj is nothing then
    Call Err.Raise(600, "XmlOp_0", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName, xmlObj))
end if
    
set xmlObj = getNodeByTagName( xmlObj, "formInfo")
if xmlObj is nothing then
    Call Err.Raise(600, "XmlOp_1", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName, xmlObj))
end if

set parameters = getNodeByTagName( xmlObj, "parameters")
if parameters is nothing then
    Call Err.Raise(600, "getNodeByTagName( xmlObj, ""parameters"")", "(" & err.Number & ") " & err.Description)
    Call handleFatalError (Array(uploader, filesName, xmlObj))
end if

'//Get fields list from xml
set fieldsNode = getNodeByTagName( xmlObj, "fields")

'//Get the db name from xml
Err.Clear()
set xmlElem = getXMLElementByProperty(parameters, "id", "filePath")

dbPath = ""
if (not xmlElem is nothing) then
    prop = getProperty(xmlElem, "name")
    if ( prop <> "" ) then
        if inStr(1, prop, "\") = 0 then
            dbPath = Server.MapPath( prop )
        else
            dbPath = prop
        end if
    end if
end if
set xmlElem = nothing
    
'//Get the folder name where the uploaded files will be save
set xmlElem = getXMLElementByProperty(parameters, "id", "fileUploadFld")
upfldPath = ""
if ( not xmlElem is nothing ) then
    prop = getProperty(xmlElem, "name")
    if inStr(1, prop, "\") = 0 then
        upfldPath = Server.MapPath( prop )
    else
        upfldPath = prop
    end if
    
    if ( Right(upfldPath, 1) = "\" ) then upfldPath = Left(upfldPath, Len(upfldPath)-1)
end if
set xmlElem = nothing
    
if ( dbPath <> "" ) then
'// write the info submitted into the DB
    Dim dbHead, rec, val, newVal, mailBody
    
    dbHead = ""
    rec = ""
    for each field in fieldsNode.childNodes
        if field.getAttribute( "name" ) <> "" then
            if ( Len(dbHead) > 0 ) then 
                dbHead = dbHead & ","
            end if    
            dbHead = dbHead & field.getAttribute( "name" )
            if ( Len(rec) > 0 ) then rec = rec & ","
            val = uploader.Form( field.getAttribute( "name" ) )
            if ( VarType(val) = 8 ) then
                if ( val = "" ) then
                    if ( uploader.Files.Count > 0 ) then
                        Dim file
                                
                        for each file in Uploader.Files.Items
                            if ( LCase(File.FormField) = LCase(field.getAttribute( "name" )) ) then
                                '//save the file
                                    
                                val = File.FileName
                                if ( upfldPath <> "" ) then
                                    if not folderExists( upfldPath ) then
                                        Call Err.Raise(701, "folderExists( " & upfldPath & " )", "(" & err.Number & ") " & err.Description)
                                        Call handleWarning()  
                                    else
                                        val = getFileName(upfldPath, File.FileName)
                                        filesName.Add field.getAttribute( "name" ), val
                                                
                                        if ( filesName.Item(field.getAttribute( "name" )) <> "" ) then
                                            Err.Clear()
                                            Call File.SaveToDisk( upfldPath, filesName.Item(field.getAttribute( "name" )) )
                                            If (Err.Number <> 0) Then
                                                Call Err.Raise(Err.Number, "File.SaveToDisk(" & upfldPath & "," & filesName.Item(field.getAttribute( "name" )) & ")", "(" & err.Number & ") " & err.Description)
                                                Call handleWarning()  
                                            End If
                                        else
                                            val = File.FileName
                                        end if
                                    end if
                                end if

                                exit for
                            end if
                        next
                    end if
                end if
                rec = rec & """" & EncodeValue(val) & """"
            else
                newVal = ""
                for i=0 to UBound(val)
                    if ( newVal <> "" ) then newVal = newVal & ","
                    newVal = newVal & val(i)
                next
                rec = rec & """" & EncodeValue(val) & """"
            end if
        end if
    next
            
    if ( fileExists( dbPath ) ) then
    '//check its consistency
        if ( getHeader( dbPath ) <> dbHead ) then
            if not createDB( dbPath, dbHead ) then
                Call Err.Raise(500, "createDB(" & dbPath & ", " & dbHead & ")", "(" & err.Number & ") " & err.Description & ", location: '" & dbPath & "', dbHead: '" & dbHead & "'")
                Call HandleWarning()
            end if
        else
            '//write data into the DB
            if not insert(dbPath, rec) then
                Call Err.Raise(502, "indert(" & dbPath & ", " & rec & ")", "(" & err.Number & ") " & err.Description & ", location: '" & dbPath & "'")
                Call HandleWarning()
            end if
        end if
    else
    '//create it
        if not createDB( dbPath, dbHead ) then
            Call Err.Raise(500, "createDB(" & dbPath & ", " & dbHead & ")", "(" & err.Number & ") " & err.Description & ", location: '" & dbPath & "', dbHead: '" & dbHead & "'")
            Call HandleWarning()
        else
            '//write data into the DB
            if not insert(dbPath, rec) then
                Call Err.Raise(502, "indert(" & dbPath & ", " & rec & ")", "(" & err.Number & ") " & err.Description & ", location: '" & dbPath & "'")
                Call HandleWarning()
            end if
        end if
    end if
            
end if    

    
'//Send the email
Dim mailObj
set mailObj = new CDOMail

if ( not mailObj is nothing ) then

    set smtpNode = getXMLElementByProperty(parameters, "id", "smtpServer")
    set xmlElem = getXMLElementByProperty(parameters, "id", "to")
    if ((not smtpNode is nothing) AND (not xmlElem is nothing)) then
        prop = getProperty(smtpNode, "name")
        if ( prop <> "" ) then
            if ( getEmailFromReq ) then
                mailObj.SmtpServer      = uploader.Form("smtpServer")
                mailObj.EmailTo         = uploader.Form("to")
                mailObj.EmailFrom       = uploader.Form("from")
                mailObj.EmailSubject    = uploader.Form("subject")
            end if

            prop1 = getProperty(xmlElem, "name")
            if ( prop1 <> "" ) then
                mailObj.SmtpServer = prop
                set smtpNode = nothing
           
                mailObj.EmailTo = prop1
                set xmlElem = getXMLElementByProperty(parameters, "id", "from")
                if ( not xmlElem is nothing ) then
                    prop = getProperty(xmlElem, "name")
                    if ( prop <> "" ) then 
                        mailObj.EmailFrom = prop
                     end if
                end if
            
                set xmlElem = getXMLElementByProperty(parameters, "id", "subject")
                if ( not xmlElem is nothing ) then
                    prop = getProperty(xmlElem, "name")
                    if ( prop <> "" ) then
                        mailObj.EmailSubject = prop
                    end if
                end if
                if ( mailObj.EmailSubject = "" ) then
                    mailObj.EmailSubject = "no subject"
                end if
            end if
        end if
    end if
        
    if ( mailObj.EmailTo <> "" AND mailObj.EmailFrom <> "" ) then  
        set templateNode = getNodeByTagName( xmlObj, "template")

        mailBody = ""
        if ( not templateNode is nothing ) then
            if ( templateNode.text <> "" ) then
                Dim fldsToEmail
                mailBody = templateNode.text
                    
                fldsToEmail = getFieldsToSend(mailBody)
                    
                for i=0 to UBound(fldsToEmail)
                    val = uploader.Form( fldsToEmail(i) )
                    if ( VarType(val) = 8 ) then
                        if ( val = "" ) then
                            if ( uploader.Files.Count > 0 ) then
                                for each file in Uploader.Files.Items
                                    if ( LCase(File.FormField) = LCase(fldsToEmail(i)) ) then
                                    val = File.FileName
                                        if ( dbPath = "" ) then
                                            if ( upfldPath <> "" ) then
                                             '//save the file if it was not saved previously
                                                if not folderExists( upfldPath ) then
                                                    Call Err.Raise(701, "folderExists( " & upfldPath & " )", "(" & err.Number & ") " & err.Description)
                                                    Call handleWarning()  
                                                else
                                                    val = getFileName(upfldPath, File.FileName)
                                                    filesName.Add fldsToEmail(i), val
                                                                
                                                    if ( filesName.Item(fldsToEmail(i)) <> "" ) then
                                                        Call File.SaveToDisk( upfldPath, filesName.Item(fldsToEmail(i)) )
                                                        if (Err.Number <> 0) Then
                                                            Call Err.Raise(Err.Number, "File.SaveToDisk(" & upfldPath & "," & filesName.Item(fldsToEmail(i)) & ")", "(" & err.Number & ") " & err.Description)
                                                            Call handleWarning()
                                                        end if
                                                    end if
                                                end if
                                            end if
                                        end if
                                    end if

                                    if fileExists(upfldPath & "\" & val) then mailObj.AttachmentsList = upfldPath & "\" & val

                                    exit for

                                next
                            end if
                        end if

                        newVal = val
                    else
                        newVal = ""
                        for j=0 to UBound(val)
                            if ( newVal <> "" ) then newVal = newVal & ","
                            newVal = newVal & val(j)
                        next
                    end if

                    mailBody = Replace(mailBody,"[" & fldsToEmail(i) & "]", newVal)
                next

            end if
        end if

        set templateNode = nothing
            
        mailObj.EmailBody = mailBody
                
        mailObj.SendMail
        
        if(err.number <> 0) then
            Call handleWarning()
        end if
    end if
        
    if ( dbPath = "" ) then
          for each i in filesName
                set fso = Server.CreateObject("Scripting.FileSystemObject")
                fso.DeleteFile upfldPath & filesName.Item(i)
                set fso = nothing
          next
    end if

end if
set mailObj = nothing
set filesName = nothing

set successPage = getXMLElementByProperty(parameters, "id", "successUrl")
if ( not successPage is nothing ) then
    prop = getProperty(successPage, "name")
    if ( prop <> "" ) then
        if ( not inStr(1,prop,"\") > 0 ) AND fileExists(Server.MapPath(prop)) then
            Call destroyObjects(Array(uploader, filesName, xmlObj, parameters, xmlElem, successPage))
            if (not gPageHasErrors ) then
                Response.Redirect prop
            end if
            
        else
            Call destroyObjects(Array(uploader, filesName, xmlObj, parameters, xmlElem, successPage))
            if (not gPageHasErrors) then
                Response.Redirect referrer
            end if
        end if
        Response.End
    end if
end if
    
Call destroyObjects(Array(uploader, filesName, xmlObj, parameters, xmlElem, successPage))
Response.Redirect referrer
Response.End


'//functions section


Sub handleFatalError(arrObj)
    'Destroy passed objects
    call destroyObjects(arrObj)
    
    Response.Clear()
    Response.Write ("<p>An error occured. Please contact the site administrator.</p><p>Error code: " & err.Number & "</p>")
    
    if (debug) then 
        Response.Write "<p>Debug info: [" & err.Source & "] " & err.Description & "</p>"
    end if    
    
    Response.End()
                
End Sub

Sub handleWarning()
     
    gPageHasErrors = true
    Response.Write "<p>An error occured. Please contact the site administrator.</p><p>Error code: " & err.Number & "</p>"
    
    if (debug) then 
        Response.Write "<p>Debug info: [" & err.Source & "] " & err.Description & "</p>"
    end if  
    
    Err.Clear()
    
End Sub

Sub destroyObjects(arrObj)
    Dim i
    for i=0 to UBound(arrObj)
        if isObject(arrObj(i)) then
            set arrObj(i) = nothing
        end if
    next
end sub


' Loads the xml located on the specified path into an xml object
'
' @return   XML Document object
' @throws   [620] XML File not found
'           [650] XML server object could be created


Public Function openXmlFile(ByVal file)
    
    On Error Resume Next
    
    Dim fso, f, xmlDoc, prefixes, i
    prefixes = Array("Microsoft.XMLDOM","MSXML2.DOMDocument.3.0","MSXML2.DOMDocument.4.0")

    set openXmlFile = nothing 
    set fso = Server.CreateObject("Scripting.FileSystemObject")
    
    if fso.FileExists(file) then
        
        for i=0 to UBound(prefixes)
        set xmlDoc = nothing
            set xmlDoc = Server.CreateObject( prefixes(i) )
            if ( xmlDoc is nothing AND i > 0 ) then
                Err.Clear()
                set xmlDoc = Server.CreateObject( prefixes(i-1) )
            end if
        next

        if (xmlDoc is nothing) then 
            Call Err.Raise(650, "openXmlFile", "")
        else
            set f = fso.OpenTextFile(file, 1)
            dim str
            str = f.ReadAll
            xmlDoc.loadXML(str)
            set f = nothing
        end if    
        
        set openXmlFile = xmlDoc
    else 
        Call Err.Raise(620, "openXmlFile", "File '" & file & "' not found")
    end if
    
End Function

'//return an xml element which is a child of the XmlElement parameter 
'//and has the Property as attribute having the value PropValue
Public Function getXMLElementByProperty(ByVal XmlElement, ByVal Property, ByVal PropValue)
    Dim nodeElem, i
    
    set getXMLElementByProperty = nothing
    
    if not XmlElement is nothing then
        for i=0 to XmlElement.childNodes.length - 1
            set nodeElem = XmlElement.childNodes.Item(i)
            if LCase(Trim(getProperty(nodeElem, Property))) = LCase(PropValue) then
                set getXMLElementByProperty = nodeElem
                exit for
            end if
        next
    end if
End Function

'//returns the value for XmlElement's PropName attribute
'//returns the void string in case attribute PropName is not found
Public Function getProperty(ByVal XmlElement, ByVal PropName)
    
    Dim i    
    if (not XmlElement is Nothing AND not XmlElement.attributes is nothing) then
        for i=0 to XmlElement.attributes.length - 1
            if ( XmlElement.attributes(i).nodeName = PropName ) then
                getProperty = XmlElement.attributes(i).nodeValue
            end if
        next
    else
        getProperty = ""
    end if
End Function

'//returns an array of xml elements with NodeName as name <NodeName
function getNodeByTagName ( ByVal XmlElement, ByVal NodeName )
    Dim e
    
    set getNodeByTagName = nothing
    if ( not XmlElement is nothing ) then
        for each e in XmlElement.ChildNodes
            if ( e.baseName = NodeName ) then
                set getNodeByTagName = e
            end if
        next
    end if
end function

'// FileExist function - check if a file exists and returns true; else returns false
function fileExists(ByVal path)
    Dim fso, f

    Set fso = CreateObject("Scripting.FileSystemObject")
    if fso.FileExists(path) then
        fileExists = true
    else
        fileExists = false
    end if

    set fso = nothing
end function

'// folderExists function - check if a folder exists and returns true; else returns false
function folderExists(ByVal path)
    Dim fso, f

    Set fso = CreateObject("Scripting.FileSystemObject")
    if fso.FolderExists(path) then
        folderExists = true
    else
        folderExists = false
    end if

    set fso = nothing
end function

'// Insert function - insert rec as line in a file
'// returns true in case of success otherwise returns false
function insert(ByVal path, ByVal rec)
   Dim f

   insert = false
   set f = openFile(path, ForAppending)

   if ( not f is nothing ) then
        f.WriteLine rec
        f.Close

        insert = true
   end if
end function

'// createDb function - create a csv file with head parameter as first line
'// returns true in case of success otherwise returns false
function createDB(ByVal path, ByVal head)
    Dim fso, f

    createDB = false
    
    On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")

    if Err.number <> 0 then 
        createDB = false '//Error creating the FileSystemObject object.
    else
        Set f = fso.CreateTextFile(path, True)
        if Err.number <> 0 then 
            createDB = false '//Error creating the file at the location & path.
        else
            f.WriteLine head
            f.Close

            set f = nothing
            
            createDB = true
        end if

        set fso = nothing
    end if
end function

'// getHeader function - return the first line of a file
function getHeader(ByVal path)
   Dim f

   set f = openFile(path, ForReading)

   getHeader = f.ReadLine
   f.Close
   
   set f = nothing
end function

'//opens a file and returns the file object
'//it returns nothing in case of it fails to open the file
function openFile(ByVal path, ByVal oType)
    Dim fso, f

    On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    if Err.number <> 0 then 
        set openFile = nothing '//Error creating the FileSystemObject object.
    else
        Set f = fso.OpenTextFile(path, oType)
        if Err.number <> 0 then 
            set openFile = nothing '//Error write the file at location:" & path 
        else
            set openFile = f
        end if
    
        set fso = nothing
    end if
end function

'// checks if fileName exists in the path location and return a unique name for the fileName
'// returns the file name in case of success and null string in case of error
function getFileName (ByVal path, ByVal fileName)
    Dim fso, fld, f, s, i, extension, newFileName
    
    on error resume next
    
    set fso = Server.CreateObject("Scripting.FileSystemObject")
    set fld = nothing
    s = ""
    
    if fso.FolderExists( path ) then
        set fld = fso.GetFolder( path )
    else
    '//try to create it
        set fld = fso.CreateFolder( path )
        if Err.number <> 0 then 
            set fld = nohting
            Err.Clear
        end if
    end if
                                            
    if ( not fld is nothing ) then
        if ( fso.FileExists(path & "\" &  fileName) ) then
            extension = Mid(fileName, inStrRev(fileName, ".") + 1)
            fileName = Mid(fileName, 1, inStrRev(fileName, ".")-1)

            i = 0
            do while s = ""
                newFileName = fileName & Cstr(i)
                if Len(extension) > 0 then  newFileName = newFileName & "." & extension
                
                if ( not fso.FileExists(path & "\" &  newFileName) ) then s = newFileName
                i = i + 1
            loop
        else
            s = fileName
        end if
        
        set fld = nothing
    end if
                                            
    set fso = nothing
    
    getFileName = s
end function

'//returns the str having the new lines replace with space and double quotes replace with single quotes
function EncodeValue(ByVal str)
    Dim regEx, Match, Matches
    Set regEx = New RegExp
    regEx.Pattern = """"
    regEx.IgnoreCase = True
    regEx.Global = True
    EncodeValue = regEx.Replace(str,"'")

    regEx.Pattern = "\r\n"
    regEx.IgnoreCase = True
    regEx.Global = True
    EncodeValue = regEx.Replace(EncodeValue, " ")
    set regEx = nothing
end function

'//returns an array with all the fields name from the email body
function getFieldsToSend( ByVal str)
    dim re, match, matches, flds
    
    redim flds(0)
    flds(0) = ""
    
    On Error Resume Next
    
    set re = New RegExp
    re.Pattern = "\[([^\]]+)\]"
    re.IgnoreCase = True
    re.Global = True
    set matches = re.Execute(str)
    for each match in matches
        if flds(0) <> "" then ReDim Preserve flds(Ubound(flds)+1)
        flds(UBound(flds)) = match.SubMatches(0)
    next
    
    set re = nothing
    
    getFieldsToSend = flds
end function

%>

<%
CLASS CDOMail
    Private smtp
    Private smtpBck
    Private cdoObj
    Private errMsg
    Private customErrMsg
    Private fromEmail
    Private toEmail
    Private ccEmail
    Private bccEmail
    Private subject
    Private bodyType
    Private body
    Private smtpAuth    'sets if smtp server require authenticaion or not [0|1]
    Private smtpUName
    Private smtpPass
    Private attachArray
    Private iBodyParts
    
    'class constructor
    Private Sub Class_Initialize()
        errMsg = ""
        On Error Resume Next
        set cdoObj = Server.CreateObject("CDO.Message")
        if Err.Number <> 0 then
            errMsg = "Could not intialize the 'CDO.Message' object." & vbCrLf & "<br>Reason: " & Err.Description
            customErrMsg = "Could not intialize the 'CDO.Message' object."
            Err.Clear
            set cdoObj = nothing
        end if
        toEmail =""
        fromEmail = ""
        ccEmail = ""
        bccEmail = ""
        smtp = "localhost"
        smtpBck = "localhost"
        subject = ""
        bodyType = "text"
        body = ""
        smtpAuth = 0
        ReDim attachArray(0)
        attachArray(0) = ""
        ReDim iBodyParts(0)
        iBodyParts(0) = ""
    End Sub
    
    'class destructor
    Private Sub Class_Terminate()
        set cdoObj = nothing
    End Sub

    Public function AddAttachment(ByVal fileContent, ByVal CType, ByVal FileName)
        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 function SendMail()
        Dim configurationObj, fieldsObj, i

        On Error Resume Next
        if isNotEmailAddress(toEmail) then
            errMsg = "The 'To' is not a valid email address."
            customErrMsg = "The 'To' which is '" & toEmail & "' is not a valid email address."
            Call Err.Raise(202, customErrMsg, "(" & err.Number & ") " & err.Description)
            Err.Clear()
            exit function
        end if
        
        if Trim(fromEmail) = "" then
            errMsg = "The 'From' cannot be empty."
            customErrMsg = "The 'From' cannot be empty."
            Call Err.Raise(202, customErrMsg, "(" & err.Number & ") " & err.Description)
            Err.Clear()
            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") = 25
            .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
                select case LCase(Trim(bodyType))
                case "text"
                    .TextBody = body
                case "html"
                    .HtmlBody = body
                case else
                    .HtmlBody = body
                end select

                for i=0 to UBound(attachArray)
                    if attachArray(i) <> "" then
                        .AddAttachment(attachArray(i))
                        if Err.number <> 0 then Err.Clear
                    end if
                next

                .Send
                if ( Err.Number <> 0 ) then
                    errMsg = "the error occured trying to sent the email through this server: " _
                        & smtp & vbCrLf & "<BR>Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description
                    customErrMsg = "An error occured trying to send the email."
                    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") = 25
                        .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
                        'errMsg = "the error occured trying to sent the email through this server: " _
                        '    & smtp & vbCrLf & "<BR>Error Number: " & Err.Number & vbCrLf & "<BR>Error Description: " & Err.Description
                        customErrMsg = "An error occured trying to send the email."
                        SendMail = false
                        Call Err.Raise(201, customErrMsg, "(" & err.Number & ") " & err.Description)
                        set configurationObj = nothing
                        exit function
                    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 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 EmailBodyType()
        EmailBodyType = bodyType
    End Property
    Public Property Let EmailBodyType(ByVal s)
        bodyType = s
    End Property
    Public Property Get EmailBody()
        EmailBody = body
    End Property
    Public Property Let EmailBody(ByVal s)
        body = 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
%>

<%
Class FileUploader
    Public  Files
    Private mcolFormElem
    Private scriptTimeout
    Private sessionTimeout

    Private Sub Class_Initialize()
        Set Files = Server.CreateObject("Scripting.Dictionary")
        Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
        scriptTimeout = Server.ScriptTimeout
        sessionTimeout = Session.TimeOut
        Server.ScriptTimeout = 1450
        Session.TimeOut = 30
    End Sub
    
    Private Sub Class_Terminate()
        If IsObject(Files) Then
            Files.RemoveAll()
            Set Files = Nothing
        End If
        If IsObject(mcolFormElem) Then
            mcolFormElem.RemoveAll()
            Set mcolFormElem = Nothing
        End If
        Server.ScriptTimeout = scriptTimeout
        Session.TimeOut = sessionTimeout
    End Sub

    Public Property Get FormItems()
        FormItems = mcolFormElem.Keys
    End Property
    
    Public Property Get FormObj()
        set FormObj = mcolFormElem
    End Property
    
    Public Property Get Form(sIndex)
        Form = ""
        If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
    End Property

    Public Default Sub Upload()
        Dim biData, sInputName, tmpData
        Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
        Dim nPosFile, nPosBound

        biData = Request.BinaryRead(Request.TotalBytes)
        nPosBegin = 1
        nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

        If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
         
        vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
        nDataBoundPos = InstrB(1, biData, vDataBounds)
        
        Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
            
            nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
            nPos = InstrB(nPos, biData, CByteString("name="))
            nPosBegin = nPos + 6
            nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
            sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
            nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
            nPosBound = InstrB(nPosEnd, biData, vDataBounds)
            
            If nPosFile <> 0 And  nPosFile < nPosBound Then
                Dim oUploadFile, sFileName
                Set oUploadFile = New UploadedFile
                
                oUploadFile.FormField = sInputName
                nPosBegin = nPosFile + 10
                nPosEnd =  InstrB(nPosBegin, biData, CByteString(Chr(34)))
                sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
                oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
                oUploadFile.FileExtension = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "."))

                nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
                nPosBegin = nPos + 14
                nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
                
                oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
                
                nPosBegin = nPosEnd+4
                nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
                oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
                
                If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
            Else
                nPos = InstrB(nPos, biData, CByteString(Chr(13)))
                nPosBegin = nPos + 4
                nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
                sInputName = Replace(sInputName,"[]","")
                If Not mcolFormElem.Exists(LCase(sInputName)) Then 
                    mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
                else
                    tmpData = mcolFormElem(LCase(sInputName))
                    mcolFormElem.Remove(LCase(sInputName))
                    
                    if isArray(tmpData) then
                        ReDim Preserve tmpData(UBound(tmpData) + 1)
                        
                        tmpData(UBound(tmpData)) = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
                        mcolFormElem.Add LCase(sInputName), tmpData
                    else
                        mcolFormElem.Add LCase(sInputName), Array(tmpData, CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin)))
                    end if
                end if
            End If

            nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
        Loop
    End Sub

    'String to byte string conversion
    Private Function CByteString(sString)
        Dim nIndex
        For nIndex = 1 to Len(sString)
           CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
        Next
    End Function

    'Byte string to string conversion
    Private Function CWideString(bsString)
        Dim nIndex
        CWideString =""
        For nIndex = 1 to LenB(bsString)
           CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1))) 
        Next
    End Function
End Class

Class UploadedFile
    Public ContentType
    Public FormField
    Public FileName
    Public FileExtension
    Public FileData
    
    Public Property Get FileSize()
        FileSize = LenB(FileData)
    End Property
    
    Public Function GetFileDate()
        Dim nIndex, sData
        
        For nIndex = 1 to LenB(FileData)
            sData = sData & Chr(AscB(MidB(FileData,nIndex,1)))
        Next
        
        GetFileDate = sData
    End Function

    Public Function SaveToDisk(sPath, sFileName)
        
        Dim oFS, oFile
        Dim nIndex
        
        On Error Resume Next
                       
        If sFileName = "" Then sFileName = FileName
        
        If sPath = "" Or sFileName = "" Then
            Err.Raise 700
            Exit Function
        end If
        If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
        
        Set oFS = Server.CreateObject("Scripting.FileSystemObject")
        If Not oFS.FolderExists(sPath) Then
            Err.Raise 701
            Exit Function
        end If
        
        Set oFile = oFS.CreateTextFile(sPath & sFileName, True)
        If not isObject(oFile) Then
            Err.Raise 702
            Exit Function
        end If
        
        For nIndex = 1 to LenB(FileData)
            oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
        Next
        oFile.Close
        Set oFile = nothing 
        
    End Function
    
    Public Sub SaveToDatabase(ByRef oField)
        If LenB(FileData) = 0 Then Exit Sub
        
        If IsObject(oField) Then
            oField.AppendChunk FileData
        End If
    End Sub

End Class
%>