Stefan
Well-Known Member
Mail sent using smtpmail.p should be encoding the subject if it contains 'special' characters.
The following function encodeRFC2047 (and helper function dectohex) does this:
Updated to handle question mark in encoded word.
Updated again to handle space between encoded words.
The following function encodeRFC2047 (and helper function dectohex) does this:
Code:
/*
---------------------------------------------------------------------------
[Name] dectohex
[Function] decimal to hexadecimal with leading =
---------------------------------------------------------------------------
*/
FUNCTION dectohex RETURNS CHARACTER PRIVATE (
i_idec AS INTEGER
):
DEFINE VARIABLE chex AS CHARACTER NO-UNDO.
DEFINE VARIABLE ii AS INTEGER NO-UNDO.
DO WHILE i_idec > 0:
DO ii = 0 TO 1:
ASSIGN
chex = SUBSTRING( "0123456789ABCDEF":u, ( i_idec MODULO 16 ) + 1, 1 ) + chex
i_idec = TRUNCATE( i_idec / 16, 0 )
.
END.
chex = "=":u + chex.
END.
RETURN chex.
END FUNCTION. /* dectohex */
/*
---------------------------------------------------------------------------
[Name] encodeRFC2047 (http://tools.ietf.org/html/rfc2047)
[Function] encodes special characters in subject
=?<codepage>?Q?<word>?=
---------------------------------------------------------------------------
*/
FUNCTION encodeRFC2047 RETURNS CHARACTER PRIVATE (
i_ctext AS CHARACTER
):
DEFINE VARIABLE cencoded AS CHARACTER NO-UNDO.
DEFINE VARIABLE iword AS INTEGER NO-UNDO.
DEFINE VARIABLE cword AS CHARACTER NO-UNDO.
DEFINE VARIABLE cword_encoded AS CHARACTER NO-UNDO.
DEFINE VARIABLE lutf AS LOGICAL NO-UNDO.
DEFINE VARIABLE lprev_utf AS LOGICAL NO-UNDO.
DEFINE VARIABLE ii AS INTEGER NO-UNDO.
DEFINE VARIABLE cc AS CHARACTER NO-UNDO.
DO iword = 1 TO NUM-ENTRIES( i_ctext, " ":u ):
cword = ENTRY( iword, i_ctext, " ":u ).
DO ii = 1 TO LENGTH( cword ):
cc = SUBSTRING( cword, ii, 1 ).
IF ASC( cc ) > 127 THEN DO:
ASSIGN
lutf = TRUE
cc = dectohex( ASC( cc, "utf-8":u ) )
.
END.
cword_encoded = cword_encoded + cc.
END.
IF lutf THEN
ASSIGN
cword_encoded = REPLACE( cword_encoded, "?":u, dectohex( ASC( "?":u ) ) )
cword_encoded = SUBSTITUTE( "=?utf-8?Q?&2&1?=":u, cword_encoded, IF lprev_utf THEN dectohex( ASC( " ":u ) ) ELSE "" )
lprev_utf = TRUE
lutf = FALSE
.
ELSE
lprev_utf = FALSE.
ASSIGN
cencoded = SUBSTITUTE( "&1 &2":u, cencoded, cword_encoded )
cword_encoded = ""
.
END.
RETURN SUBSTRING( cencoded, 2 ).
END FUNCTION. /* encodeRFC2047 */Updated to handle question mark in encoded word.
Updated again to handle space between encoded words.
