htmlasp-classiccdo.message

Passing language specific characters from asp to CDO to HTML template not working


NB! to those who associate this post with:https://stackoverflow.com/questions/31524404/classic-asp-and-utf-8 it does NOT solve the issue, and everything in it has been tested.

I have an ASP Classic form that sends through CDO using an HTML template to send an e-mail.. passing the special language characters (In this case danish characters æ,ø,å) from the form to the ASP page holding CDO code is working OK and displays the characters correctly when making a Response.Write on that page. But, when the e-mail sends the passed characters are "mess-up". However, if I write the characters directly into the HTML template they display correct in the e-mail. All three documents have their charset set to UTF-8 and the ASP pages have CODEPAGE 65001 set. Can anyone see what is going on to cause this behaviour?

This is what happens in the e-mail:

This is what happens in the e-mail

E-mail template (only definition) :

<!DOCTYPE html>
<html>

<head>
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
    <title>Email</title>
    <meta name="viewport" content="width=device-width, initial-scale=1.0" />

    <style type="text/css">
        a[x-apple-data-detectors] {
            color: inherit !important;
        }
    </style>

</head>

<body style="margin: 0; padding: 0;">

 

    
</body>

</html>

sendmail.asp :

<%@Codepage = 65001%>
<%
Option explicit
Response.CodePage = 65001
Response.CharSet = "UTF-8"


    Dim SettingsConn
    Set SettingsConn = Server.CreateObject("ADODB.Connection")
    SettingsConn.ConnectionString="Provider=SQLOLEDB; DATA SOURCE=<SERVER>;UID=<USERNAME>;PWD=<PASSWORD>;DATABASE=<DB>"
    SettingsConn.Open

    Dim SettingsSQL, objSettings

    SettingsSQL = "SELECT SMTPServer,SMTPPort,MailFromName,MailFromEmail,MailCC,MailBCC,EFPVersion FROM EFP_Settings WHERE ID = 1;"

    Set objSettings = SettingsConn.Execute(SettingsSQL)


    dim pde : set pde = createobject("scripting.dictionary")

    function getTextFromFile(path)
        dim fso, f, txt
        set fso = createobject("Scripting.FileSystemObject")
        if not fso.fileexists(path) then
            getTextFromFile = ""
            exit function
        end if
        set f = fso.opentextfile(path,1)
        if f.atendofstream then txt = "" else txt = f.readall
        f.close
        set f = nothing
        set fso = nothing
        getTextFromFile = txt
    end function


    dim redir, mailto, mailfrom, subject, item, body, cc, bcc, message, html, template, usetemplate, testmode
    redir = request.form("redirect")
    mailto = request.form("mailto")
    if pde.exists(mailto) then mailto = pde(mailto)
    cc = objSettings("MailCC")
    bcc = objSettings("MailBCC")
    subject = request.form("subject")
    message = request.form("message")
    template = request.form("template")

    if len(template) > 0 then template = getTextFromFile(server.mappath(template))
    if len(template) > 0 then usetemplate = true else usetemplate = false
    dim msg : set msg = server.createobject("CDO.Message")
    dim smtpServer, yourEmail, yourPassword
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "" & objSettings("SMTPServer") & ""
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = objSettings("SMTPPort")
    msg.Configuration.Fields.Update
    msg.subject = subject
    msg.to = mailto
    msg.from = """" & objSettings("MailFromName") & """ <" & objSettings("MailFromEmail") & ">"
    msg.Sender = """" & objSettings("MailFromName") & """ <" & objSettings("MailFromEmail") & ">"

    if len(cc) > 0 then msg.cc = cc
    if len(bcc) > 0 then msg.bcc = bcc

    if not usetemplate then
        body = body & message & vbcrlf & vbcrlf
    else
        body = template
    end if
    for each item in request.form
        select case item
            case "redirect", "mailto", "cc", "bcc", "subject", "message", "template", "html", "testmode"
            case else
                if not usetemplate then
                    if item <> "mailfrom" then body = body & item & ": " & request.form(item) & vbcrlf & vbcrlf
                else
                    body = replace(body, "[$" & item & "$]", replace(request.form(item),vbcrlf,"<br>"))
                end if
        end select
    next

    if usetemplate then
        dim rx : set rx = new regexp
        rx.pattern = "\[\$.*\$\]"
        rx.global = true
        body = rx.replace(body, "")
    end if

        msg.htmlbody = body

        msg.send

        response.redirect redir

        set msg = nothing
    %>

UPDATE:

Based on the comments below;

I have tried to convert the FSO to ADODB so it looks like the below, but is an error:

Code :

function getTextFromFile(path)
    Dim adoStream, txt
    Set adoStream = CreateObject("Adodb.Stream")
    if not adoStream.FileSystemObject(path) then
        getTextFromFile = ""
        exit function
    end if
    adoStream.Open
    adoStream.Charset = "UTF-8"
    txt = adoStream.ReadText(-1)
    adoStream.LoadFromFile txt
    adoStream.Close
    Set adoStream = Nothing
    getTextFromFile = txt
end function

Latest Update (28-03-2021) - 11:36

Latest sendmail.asp :

<%@Codepage = 65001%>
  <%
    Option explicit
    Response.CodePage = 65001
    Response.CharSet = "UTF-8"

    Dim SettingsConn
    Set SettingsConn = Server.CreateObject("ADODB.Connection")
    SettingsConn.ConnectionString="Provider=SQLOLEDB; DATA SOURCE=<SERVER>;UID=<USERNAME>;PWD=<PASSWORD>;DATABASE=<DATABASE>"
    SettingsConn.Open

    Dim SettingsSQL, objSettings

    SettingsSQL = "SELECT SMTPServer,SMTPPort,MailFromName,MailFromEmail,MailCC,MailBCC,EFPVersion FROM EFP_Settings WHERE ID = 1;"

    Set objSettings = SettingsConn.Execute(SettingsSQL)

    dim redir, mailto, mailfrom, subject, item, body, cc, bcc, html, template, usetemplate, testmode
    redir = request.form("redirect")
    mailto = request.form("mailto")
    cc = objSettings("MailCC")
    bcc = objSettings("MailBCC")
    subject = request.form("subject")
    template = request.form("template")

    Response.Write request.form("template")
    ' Output of request.form("template") is templates/emailtemplate_report_issue.htm
    
    Dim adoStream, getTextFromFile
    Set adoStream = CreateObject("Adodb.Stream")
    adoStream.Type = 2
    adoStream.Open
    adoStream.Charset = "UTF-8"
    adoStream.LoadFromFile server.mappath("" & template & "")
    template = adoStream.ReadText(-1)
    adoStream.Close
    Set adoStream = Nothing
    getTextFromFile = template
    

    dim msg : set msg = server.createobject("CDO.Message")
    dim smtpServer, yourEmail, yourPassword
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "" & objSettings("SMTPServer") & ""
    msg.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = objSettings("SMTPPort")
    msg.Configuration.Fields.Update
    msg.subject = subject
    msg.to = mailto
    msg.from = """" & objSettings("MailFromName") & """ <" & objSettings("MailFromEmail") & ">"
    msg.Sender = """" & objSettings("MailFromName") & """ <" & objSettings("MailFromEmail") & ">"

    if len(cc) > 0 then msg.cc = cc
    if len(bcc) > 0 then msg.bcc = bcc

    body = template
    for each item in request.form
            body = replace(body, "[$" & item & "$]", replace(request.form(item),vbcrlf,"<br>"))
    next

    dim rx : set rx = new regexp
    rx.pattern = "\[\$.*\$\]"
    rx.global = true
    body = rx.replace(body, "")

    msg.htmlbody = body

    msg.send

    response.redirect redir

    set msg = nothing

    %>

Output on e-mail where characters are not displayed as expected (Both variables passed from form and hardcoded)

enter image description here


Solution

  • This is an encoding problem but not specifically with how your Classic ASP is setup. After some extended discussion in the comments, it became clear the issue lies in how the CDO.Message is constructed.

    Although the data in the Classic ASP script is being processed as UTF-8 the message is never told it should be, which can be rectified with this line;

    msg.BodyPart.Charset = "utf-8"
    

    Below is a working example of your code (with some of the SQL configuration elements removed for testability). It simulates the sending of the email using Smtp4Dev which is a fake SMTP Email Server for development and testing (Gist also included).

    HTML Form POST (Encoded as UTF-8)

    <html>
      <head>
        <title>Test 33</title>
      </head>
      <body>
        <form action="test.asp" method="post">
          <input type="hidden" name="template" value="template.htm" />
          <textarea name="message" rows="10" cols="100"></textarea>
          <input type="submit" value="Submit" />
        </form>
      </body>
    </html>
    

    HTML Template (Encoded as UTF-8)

    <!DOCTYPE html>
    <html>
    
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Email</title>
        <meta name="viewport" content="width=device-width, initial-scale=1.0" />
    
        <style type="text/css">
            a[x-apple-data-detectors] {
                color: inherit !important;
            }
        </style>
    
    </head>
    
    <body style="margin: 0; padding: 0;">
      <p>æ,ø,å</p>
      <p>[$message$]</p>
    </body>
    
    </html>
    

    Classic ASP Script (Encoded as UTF-8)

    <%@Language="VBScript" Codepage = 65001%>
    <%
    Option Explicit
    Response.CodePage = 65001
    Response.Charset = "UTF-8"
    
    Dim pde : Set pde = Server.CreateObject("scripting.dictionary")
    
    Function getTextFromFile(path)
        Dim adoStream, txt
        Set adoStream = Server.CreateObject("ADODB.Stream")
        Call adoStream.Open()
        adoStream.Charset = "UTF-8"
        Call adoStream.LoadFromFile(path)
        txt = adoStream.ReadText(-1)
        Call adoStream.Close()
        Set adoStream = Nothing
        getTextFromFile = txt
    End Function
    
    Dim redir, mailto, mailfrom, subject, item, body, cc, bcc, message, html, template, usetemplate, testmode
    redir = Request.Form("redirect")
    mailto = Request.Form("mailto")
    If pde.exists(mailto) Then mailto = pde(mailto)
    
    subject = Request.Form("subject")
    message = Request.Form("message")
    template = Request.Form("template")
    
    If Len(template) > 0 Then template = getTextFromFile(Server.MapPath(template))
    usetemplate = (Len(template) > 0)
    
    Dim msg : Set msg = Server.CreateObject("CDO.Message")
    Dim smtpServer, yourEmail, yourPassword
    
    msg.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    msg.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost"
    msg.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
    Call msg.Configuration.Fields.Update()
    
    msg.Subject = "Test Email"
    msg.To = "someone@example.com"
    msg.From = "theserver@example.com"
    
    If Len(cc) > 0 Then msg.cc = cc
    If Len(bcc) > 0 Then msg.bcc = bcc
    
    If Not usetemplate Then
        body = body & message & vbCrLf & vbCrLf
    Else
        body = template
    End If
    
    For Each item In Request.Form
        Select Case item
        Case "redirect", "mailto", "cc", "bcc", "subject", "message", "template", "html", "testmode"
        Case Else
            If Not usetemplate Then
                If item <> "mailfrom" Then body = body & item & ": " & Request.Form(item) & vbCrLf & vbCrLf
            Else
                body = replace(body, "[$" & item & "$]", Replace(Request.Form(item), vbCrLf, "<br>"))
            End If
        End Select
    Next
    
    If usetemplate Then
        Dim rx : Set rx = New RegExp
        rx.Pattern = "\[\$.*\$\]"
        rx.Global = True
        body = rx.Replace(body, "")
    End If
    
    msg.BodyPart.Charset = "utf-8"
    msg.htmlbody = body
    
    Call msg.Send()
    %>
    

    Resultant Email

    Downloaded from Smtp4Dev as an EML file.

    Thread-Topic: Test Email
    thread-index: AdckzyUf6ZF/uRsTSqG8szy1Ii2tbw==
    From: <theserver@example.com>
    To: <someone@example.com>
    Subject: Test Email
    Date: Mon, 29 Mar 2021 20:10:13 +0100
    Message-ID: <9DB5C085BE5C40D784838A04215C21B9@FIMDLT1337>
    MIME-Version: 1.0
    Content-Type: multipart/alternative;
        boundary="----=_NextPart_000_0000_01D724D7.86E45B00"
    X-Mailer: Microsoft CDO for Windows 2000
    Content-Class: urn:content-classes:message
    Importance: normal
    Priority: normal
    X-MimeOLE: Produced By Microsoft MimeOLE
    
    This is a multi-part message in MIME format.
    
    ------=_NextPart_000_0000_01D724D7.86E45B00
    Content-Type: text/plain;
        charset="utf-8"
    Content-Transfer-Encoding: base64
    
    w6Ysw7gsw6UNCg0K
    
    ------=_NextPart_000_0000_01D724D7.86E45B00
    Content-Type: text/html;
        charset="utf-8"
    Content-Transfer-Encoding: 8bit
    
    <!DOCTYPE html>
    <html>
    
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
        <title>Email</title>
        <meta name="viewport" content="width=device-width, initial-scale=1.0" />
    
        <style type="text/css">
            a[x-apple-data-detectors] {
                color: inherit !important;
            }
        </style>
    
    </head>
    
    <body style="margin: 0; padding: 0;">
      <p>æ,ø,å</p>
      <p></p>
    </body>
    
    </html>
    ------=_NextPart_000_0000_01D724D7.86E45B00--
    
    

    Useful Links