Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Decode special characters in email source code

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Decode special characters in email source code

    ' 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.
    Code:
    #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
    Last edited by Erik Christensen; 18 Oct 2008, 02:18 PM. Reason: I adjusted code to deal with 3 HEX character long Unicodes
Working...
X