' 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.
' 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