Decode special characters in email source code

[Erik Christensen]

' This quick and dirty code allows you to decode email source code text
' with isolated encoded special characters. It can decode special characters
' for the following character sets:
' charset="utf-8" (Unicode up to ASCII code 255), charset=Windows-1252 and
' charset="iso-8859-1"
'
' Please note that only isolated encoded special characters in an otherwise normal
' text can be decoded using this code.
'
' I am sure you can improve the code in various ways according to your needs.
'
' Best regards,
'
' Erik Christensen ---------- October 18, 2008
'
' P.S. Here is a link to a conversion table to ASCII codes:
' http://kellyjones.netfirms.com/webto...f8_table.shtml
'
' Later: I adjusted code to deal with 3 HEX character long Unicodes. These
' are now also being replaced by a dummy character (chr$(128)) for unknown.

#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
'
%IDC_BUTTON1  = 1005
%IDC_BUTTON2  = 1006
%IDC_LABEL1   = 1002
%IDC_LABEL2   = 1004
%IDC_TEXTBOX1 = 1001
%IDC_TEXTBOX2 = 1003
%IDD_DIALOG1  =  101
'
FUNCTION DecodeSpecialTextCharactersInEmails(BYVAL s AS STRING) AS STRING
    ' appears to works with charset="utf-8", charset=Windows-1252 and charset="iso-8859-1"
    LOCAL i AS LONG, j AS LONG, k AS LONG, m AS LONG, n AS LONG, co AS LONG, m2 AS LONG, n2 AS LONG
    DO
        i = INSTR(i+1, s, "=")
        IF i>0 THEN
            ' If "=" is encountered, then check if the next two characters are HEX-code
            j = VERIFY(MID$(s, i+1, 1), "0123456789abdcefABCDEF")
            k = VERIFY(MID$(s, i+2, 1), "0123456789abdcefABCDEF")
            ' If they are, then see if the following character is "="
            IF j = 0 AND k = 0 AND MID$(s, i+3, 1) = "=" THEN
                ' If that is so, then check if the next two characters are HEX-code
                m = VERIFY(MID$(s, i+4, 1), "0123456789abdcefABCDEF")
                n = VERIFY(MID$(s, i+5, 1), "0123456789abdcefABCDEF")
                IF m = 0 AND n = 0 THEN
                    ' If they are, then we are dealing with Unicode (UTF-8) representing ASCII-code > 127
                    ' We should then use the information in both decoded characters as follows:
                    co = 0 ' If first HEX-code is "C2" then the second code can be decoded as ASCII code directly
                           ' If first HEX-code is "C3" then the second code + 64 can be decoded as ASCII code
                    IF MID$(s, i+1, 2) = "C3" THEN co = 64
                    IF VAL("&H"+MID$(s, i+1, 2)) <= 195 THEN ' if code inside normal ASCII range (<256), i.e. first HEX-code="C3" or less
                        ' then replace codes with the ASCII character
                        s = LEFT$(s,i-1) + CHR$(VAL("&H"+MID$(s, i+4, 2))+co) + MID$(s, i+6)
                    ELSE ' outside normal ASCII range. We need to replace codes with a dummy character for unknown, e.g. chr$(128)
                         ' We just need to know how many HEX-characters to replace. Therefore ...
                        IF MID$(s, i+6, 1) = "=" THEN ' look for a third "="
                            m2 = VERIFY(MID$(s, i+7, 1), "0123456789abdcefABCDEF")
                            n2 = VERIFY(MID$(s, i+8, 1), "0123456789abdcefABCDEF")
                            ' If found then check next two characters for HEX-code
                            IF m2 = 0 AND n2 = 0 THEN
                                ' It is HEX-code, but code is too long for normal ASCII decoding. Therefore replace with chr$(128) or something else if you like.
                                s = LEFT$(s,i-1) + CHR$(128) + MID$(s, i+9)
                            END IF
                        ELSE ' code outside normal ASCII range. Therefore replace with chr$(128) or something else.
                            s = LEFT$(s,i-1) + CHR$(128) + MID$(s, i+6)
                        END IF
                    END IF
                END IF
            ELSE ' only one "="
                IF j = 0 AND k = 0 THEN ' If HEX-code, then replace code whith ASCII character
                    s = LEFT$(s,i-1) + CHR$(VAL("&H"+MID$(s, i+1, 2))) + MID$(s, i+3)
                ELSE
                    s = LEFT$(s,i-1) + "-" + MID$(s, i+1) ' Otherwise just replace with a hyphen: "-"
                   ' s = LEFT$(s,i-1) + MID$(s, i+1)       ' Or just remove "="
                END IF
            END IF
        ELSE
            EXIT LOOP
        END IF
    LOOP
    FUNCTION = s
END FUNCTION
'
CALLBACK FUNCTION ShowDIALOG1Proc()

    STATIC txt AS STRING
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            CONTROL SEND CBHNDL, %IDC_TEXTBOX1, %WM_SETFONT, GetStockObject(%ANSI_FIXED_FONT), %TRUE
            CONTROL SEND CBHNDL, %IDC_TEXTBOX2, %WM_SETFONT, GetStockObject(%ANSI_FIXED_FONT), %TRUE

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL

                CASE %IDC_BUTTON1
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        CONTROL GET TEXT CBHNDL, %IDC_TEXTBOX1 TO txt
                        txt = DecodeSpecialTextCharactersInEmails(txt)
                        CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX2, txt
                    END IF

                CASE %IDC_BUTTON2
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL

            END SELECT
    END SELECT
END FUNCTION
'
FUNCTION PBMAIN()
    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD

    DIALOG NEW PIXELS, 0, "Decode Special Text Characters In Emails", , , 737, 478, %WS_POPUP _
        OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
        %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
        OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
        %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 12, 32, 714, 176, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %ES_LEFT OR _
        %ES_MULTILINE OR %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD LABEL,   hDlg, %IDC_LABEL1, "Paste the email source code text below (right click over the textbox):", 12, _
        13, 714, 19, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
        %WS_EX_LTRREADING
    CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "", 12, 240, 714, 176, _
        %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %ES_LEFT _
        OR %ES_MULTILINE OR %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE OR _
        %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD LABEL,   hDlg, %IDC_LABEL2, "Decoded text:", 12, 221, _
        714, 19, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
        %WS_EX_LTRREADING
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "&Decode text", 270, 429, 210, _
        26
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON2, "E&xit", 654, 429, 72, 26
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
END FUNCTION