Announcement

Collapse
No announcement yet.

Problem with MultiByteToWideChar() function

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

  • #41
    RE:
    Code:
    ...
    #COMPILE EXE
    ....
    FUNCTION GetCodePages() AS LONG
    You could change to
    Code:
    #COMPILE DLL or SLL
    ...
    FUNCTION GetCodePages( c() AS [W]STRING ) [ALIAS   "GetCodePages"  COMMON | EXPORT]  AS LONG
    
       REDIM C (Datacount, 1)
     
    Load up values to C(n, 0) and c (n,1) here.
    
    END FUNCTION
    ...
    Compile to an SLL or DLL. If it's just a lookup table it is not going to change much anyway..

    Alternately you can store this in a file and make it a program resource and load at runtime but that's a little more involved, at least in terms of amount of code to be compiled.

    But I am pretty sure the farthest many of you would go is "#INCLUDE filewiththisfunction"

    In any event.... passing the array as a param eliminates the need to "reserve" the name of a GLOBAL variable (and/or any issues with multithreaded programs accessing the array except that should not be an issue with an array which is only accessed as an unchanging data table.)


    MCM
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #42
      Here is a version incorporating Stuart's GetCodePages function. which turned out to be a poisoned gift.
      I had to figure out why code pages like chinese did not work.

      Let me explain, many code pages can be used as is, just use UCODEPAGE cpnumberhere and any CHR$(byte) will be converted to matching character in the table. But not all code pages are single byte character. This means that you cannot use them with UCODEPAGE, for multi-byte codepages you need to use the default code page UCODEPAGE ANSI and then you need to convert your string using MultiByteToWideChar. (ex: UTF-8, UTF-7, Chinese, Japanese, etc.)

      Changes I made to GetCodePages function:
      1. Added a new column to keep track of Single and Multi code pages
      2. function also returns number of rows read from DATA.
      3. Look ma (MCM) no Global

      In the function where it gets used you only need to call it the first time, and keep it as a static.
      STATIC CodePages() AS STRING
      STATIC
      CodePagesCnt AS LONG

      IF ARRAYATTR(
      CodePages(), 0) = 0 THEN ' array not Dimmed, First time calling function, Load Code pages.
      CodePagesCnt = GetCodePages (CodePages())
      END IF


      Note: I did not check, all code pages, nor Identify all Multi-Byte ones so if you need others, you can add them to DATA or change column 3 to "1"

      '
      Code:
      'Compilable Example:
      #COMPILER PBWIN 10, PBCC 6
      #COMPILE EXE
      #DIM ALL
      %Unicode = 1
      
      #INCLUDE "Win32API.inc"
      
      FUNCTION PBMAIN() AS LONG
      LOCAL wBuff AS WSTRING
      
                    wBuff = Get_Qp2Text("Subject: =?utf-8?Q?=F0=9F=95=92?= TIME to see who's interested in upcoming reunion events") + $CRLF _
                     + Get_Qp2Text("Subject: =?UTF-8?Q?=F0=9F=92=9A_New_Designs_for_your_Family?=") + $CRLF _
                     + Get_Qp2Text("Subject: =?UTF-8?Q?Hi=2Cstay=20connected=20with=20Yahoo=20Mail=20mobile=20app?=") + $CRLF _
                     + Get_Qp2Text("=?UTF-8?Q?Qu=C3=A9bec=20City=20=20The=20value=20is=20=22This=20is=20a=20test=21=22_?= =?UTF-8?B?UGllciAx?=") + $CRLF _
                     + Get_Qp2Text("Rainer =?ISO-8859-1?Q?G=F6rke?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("Subject: =?utf-8?Q?=F0=9F=8E=A5_Movie_Night_is_almost_here!?=") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?Gitte_M=F6rsd=F6rfer?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("=?Windows-1252?Q?Micheltest_M=FCller?= <[email protected]> ") + $CRLF _
                     + Get_Qp2Text("Subject: =?Windows-1252?Q?Re:_Wenn_=22die_gro=DFen=22__Provider_Viren-Mails_l=F6sc?==?Windows-1252?Q?hen_w=FCrden_..._das_w=E4re_das_AUS!=3F?=") + $CRLF _
                     + Get_Qp2Text("Subject: =?ISO-8859-1?Q?Gro=DFe?= Mails") + $CRLF _
                     + Get_Qp2Text("=?iso-8859-15?Q?Peter_M=F6ller?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?Thomas_M=F6ller_=AE?= =?ISO-8859-2?Q?_Thomas_M=F6ller_=AE?=") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?=BC_?= =?ISO-8859-2?Q?=BC_?= =?ISO-8859-15?Q?=BC_?= =?Windows-1252?Q?=87_?=") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?=F0_?= =?ISO-8859-4?Q?=F0_?= =?ISO-8859-13?Q?=F0_?= =?ISO-8859-8?Q?=F0_?==?Windows-1252?Q?=F0_?=") + $CRLF _
                     + Get_Qp2Text("=?iso-8859-15?q?J=FCrgen=20Test?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?Re:Re:_Nikon_F3_empfehlenswert??=") + $CRLF _
                     + Get_Qp2Text("Subject: T-Online f=?ISO-8859-1?B?/A==?=r MAC OS X?") + $CRLF _
                     + Get_Qp2Text("Subject: [spam] =?ISO-8859-1?B?QW1hemluZyBwcm9kdWN0cyBhdCBhIGdyZWF0bHkgcmVkdWNlZCByYXRlIQ==?=") + $CRLF _
                     + Get_Qp2Text("Subject: =?ISO-8859-1?B?QW1hemluZyBwcm9kdWN0cyBhdCBhIGdyZWF0bHkgcmVkdWNlZCByYXRlIQ==?=") + $CRLF _
                     + Get_Qp2Text("=?ISO-8859-1?Q?Versi=F3n 2004 a solo $50.-?=") + $CRLF _
                     + Get_Qp2Text("=?UTF-8?Q?m=C3=B6chten =C3=9Cbersendung z=C3=BCgige F=C3=BCr R=C3=BCckfragen =21 Verf=C3=BCgung?=") + $CRLF _
                     + Get_Qp2Text("=?UTF-8?Q?SUPERSCRIPT LATIN SMALL LETTER =E2=81=BF, PESETA =E2=82=A7, SQUARE =E2=88=9A, Euro =E2=82=AC?=") + $CRLF _
                     + Get_Qp2Text("=?UTF-8?B?PGdvdEBjaGE+?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("=?utf-8?Q?=22B._M=C3=BCller=22?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("Rita =?UTF-8?Q?D=C3=B6rte?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("Zsolt =?UTF-8?B?TMOhc3psw7MgQsOJUkNaRVM=?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("=?Utf-8?B?RW5ubw==?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("Re: =?ISO-8859-15?Q?T-Com_=3D=3FUTF-8=3FB=3F4oKp=3F=3D_-_was_p?=   =?ISO-8859-15?Q?assiert_mit_meinem_Anschluss_bei_Freenet=3F?=") + $CRLF _
                     + Get_Qp2Text("Re: T-Com =?UTF-8?B?4oKp?= - was passiert mit meinem Anschluss bei Freenet?") + $CRLF _
                     + Get_Qp2Text("From: =?US-ASCII?Q?Keith_Moore?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("CC: =?ISO-8859-1?Q?Andr=E9?= Pirard <[email protected]>") + $CRLF _
                     + Get_Qp2Text("Subject: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= " + $CRLF + "=?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=") + $CRLF _
                     + Get_Qp2Text("From: =?ISO-8859-1?Q?Olle_J=E4rnefors?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("From: =?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("From: =?UTF-8?B?UGllciAx?= <[email protected]>") + $CRLF _
                     + Get_Qp2Text("(=?ISO-8859-1?Q?a?=   =?ISO-8859-1?Q?_b?=)") + $CRLF _
                     + Get_Qp2Text("Subject: =?UTF-8?B?8J+PoSBEZXZlbmlyIHVuIE1hw650?=" + $CRLF + "=?UTF-8?B?cmUgVkVOREVVUiAtIENvdXJ0aWVyIEltbW8uIEZvcm1hdGlvbiAxMCBVRkM=?=")+ $CRLF _
                     + Get_Qp2Text("(=?ISO-8859-1?Q?a_?= =?UTF-8?B?x6M=?=)") + $CRLF _
                     + Get_Qp2Text("Subject: =?utf-8?Q?=F0=9F=92=98?= L'amour est dans l'air!") + $CRLF _
                     + Get_Qp2Text("Subject: =?iso-8859-1?Q?Espaces_disponibles_|_Bureaux_et_industriel__|_Available_S?=" + $CRLF + "        =?iso-8859-1?Q?pace_|_Office_&_Industrial_-_F=C9VRIER_/_FEBRUARY_2019?=")+ $CRLF _
                     + Get_Qp2Text("Subject: =?iso-8859-1?Q?Des_m=E9tiers_vont_dispara=EEtre?=") + $CRLF _
                     + Get_Qp2Text("Subject: Rod, planifiez votre menu pour une =?ISO-8859-1?Q?soir=E9e?= sportive =?utf-8?Q?r=C3=A9ussie!?=") + $CRLF _
                     + Get_Qp2Text("=?utf-8?B?QXZpcyBkZSBkw6lww7R0IGQndW5lIGNvbW11bmljYXRpb24gcG91ciBsJ2VudHJlcHJpc2UgZG9udCBsJ29iamV0IGVzdCBBdmlzIGRlIHJlbWJvdXJzZW1lbnQgLSBYWFhYWFg5ODg2IA==?=") + $CRLF _
                     + Get_Qp2Text("(=?ISO-8859-1?Q?a=E9_?= =?UTF-8?Q?=C7=A3_?= =?UTF-8?B?x6M=?=)") + $CRLF _
                     + Get_Qp2Text("=?koi8-r?Q?_=F0=D2=C9=D7=C5=D4 =CD=CF=CA =C4=D2=D5=C7") + $CRLF _
                     + Get_Qp2Text("Subject: =?utf-8?Q?Va=C5=A1?= kolega je =?utf-8?Q?naru=C4=8Dio?= oglas") + $CRLF _
                     + Get_Qp2Text("=?GB18030?Q?=B0=A1=C1=CB,=C4=E3=D2=B2=C3=BB=C1=AA=CF=B5=CE=D2,=D7=EE=BD=FC=CA=C7=B2=BB=CA=C7=BA=DC=C3=A6=B0=A1") + $CRLF _
                     + Get_Qp2Text("=?shift_jis?Q?=82=B1=82=F1=82=C9=82=BF=82=CD=90=A2=8AE") + $CRLF _
                     + Get_Qp2Text("[email protected]=AC=C9") + $CRLF _
                     + Get_Qp2Text("To: =?utf-7?B?TWlsdGVjK0FGOC1XZWJtYXN0ZXI=?= ")  + $CRLF _
                     + Get_Qp2Text("Subject: =?UTF-8?B?cm9kIGlzIHRoZSBiZXN0DQpoZXJlIM6p?=")  + $CRLF _
                     + Get_Qp2Text("=?UTF-7?Q?H+APM-la+ACE-__?= =?utf-7?Q?+vDCy7A-  +wMHQ3A-  +xUy5vA-(+wuTTKA-)?=")+ $CRLF _
                     + Get_Qp2Text("Subject: =?utf-8?Q?Fwd:_An_Amazing_Story___=D7=A1=D7=99=D7=A4=D7=95=D7=A8?=" + $CRLF +" =?utf-8?Q?_=D7=90=D7=9E=D7=99=D7=AA=D7=99_=D7=95=D7=9E=D7=93?=" + $CRLF +" =?utf-8?Q?=D7=94=D7=99=D7=9D?=")
      
                     '? wBuff
                     'CLIPBOARD SET TEXT wBuff
            LOCAL hFnt AS DWORD
            FONT NEW "Arial", 14  TO hFnt
            LOCAL hndl  AS DWORD
            GRAPHIC WINDOW NEW  "Quoted Printable", 0, 0, 1400, 1000 TO hndl
           ' Deal with PBCC not printing stringvars with $CRLF and $tab correctly
             GRAPHIC SET FONT hFnt
             GRAPHIC SET VIRTUAL  1400, 3000
             GRAPHIC COLOR %BLACK, %WHITE
             GRAPHIC CLEAR
             LOCAL lCount, lLoop AS LONG
             LOCAL sTemp2 AS WSTRING
             GRAPHIC PRINT "Quote Printable Examples"
             GRAPHIC PRINT "--------------"
             lCount = PARSECOUNT(wBuff, $CRLF)
             FOR lLoop = 1 TO lCount
                sTemp2 = PARSE$(wBuff,$CRLF,lLoop)
                 GRAPHIC PRINT sTemp2
             NEXT lCount
             GRAPHIC PRINT "Press any Key to continue"
             GRAPHIC PRINT
             GRAPHIC WAITKEY$
      
      END FUNCTION
      
      '---------------------------------------------------------------------------
      ' Get_Qp2Text
      ' Convert Emails Header Info, from Quote Printable to Wstring
      ' RFC2047
      ' Dependencies: Get_EncodeSec
      '---------------------------------------------------------------------------
      FUNCTION Get_Qp2Text(BYVAL EncodedText AS WSTRING) AS WSTRING
      LOCAL sMask AS WSTRING
      LOCAL sTemp, sTemp2 AS WSTRING
      LOCAL position, length AS LONG
          sMask       = "(\?=)[\r\n\t ]+(=\?)"                                                      ' Remove Spaces CR LF Tab between ?=  =?
      'ods (EncodedText)
          REGEXPR sMask IN EncodedText TO position, length                                          ' RFC2047 - No Spaces CR LF Tab allowed if it's the only thing between 2 encoded sections
          WHILE position > 0                                                                        ' ie: "(=?ISO-8859-1?Q?a_?=  =?UTF-8?B?x6M=?=)"
            EncodedText = LEFT$ (EncodedText,position+1) + MID$(EncodedText, Position + Length -2)  '     "(=?ISO-8859-1?Q?a_?==?UTF-8?B?x6M=?=)"
            REGEXPR sMask IN EncodedText TO position, length
          WEND                                                                                      ' loop until no more
      'ods (EncodedText)
          sMask       = "=\?([^ ?]+)\?([BQbq])\?([^ ?]+)\?="                                        ' process each encoded section individually
          REGEXPR sMask IN EncodedText TO position, length                                          ' encoded sections may use different encodings
          WHILE position > 0                                                                        ' ie: "(=?ISO-8859-1?Q?a_?==?UTF-8?B?x6M=?=)"
            sTemp = MID$(EncodedText, position, length)                                             ' "=?ISO-8859-1?Q?a_?="
            sTemp2 = Get_EncodeSec(sTemp)                                                           ' "a "
            REPLACE sTemp WITH sTemp2 IN EncodedText                                                ' "(a =?UTF-8?B?x6M=?=)"
            REGEXPR sMask IN EncodedText TO position, length                                        ' find next =?UTF-8?B?x6M=?=
          WEND                                                                                       ' loop until no more
      FUNCTION = Get_EncodeSec(EncodedText)
      END FUNCTION
      
      '---------------------------------------------------------------------
      ' Get_EncodeSec
      ' Decode a section of Quote printable based on its Character Set, codepage, base64
      '"=?UTF-8? =?ISO-8859-1? =?ISO-8859-2? =?ISO-8859-15? =?WINDOWS-1252? =?US-ASCII? =?UTF-7?"
      '
      'Dependencies  Base64_Decode, GetCodePages, CPtoWide
      '---------------------------------------------------------------------
      FUNCTION Get_EncodeSec(BYVAL EncodedText AS WSTRING) AS WSTRING
      ' Decode a fully formed coded Word ei: =?ISO-8859-1?Q?a_?=
      ' Modified from Thomas Gohel
      ' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/25070-pb-win-quoted-printable-iso8859-15-and-utf-8-decoding-routines-for-mail-news
        LOCAL i            AS LONG
        LOCAL p0           AS LONG
        LOCAL p1           AS LONG
        LOCAL p2           AS LONG
        LOCAL pChar        AS LONG
       ' LOCAL strTextb     AS STRING
        LOCAL strText      AS WSTRING
        LOCAL strRun       AS WSTRING
        LOCAL Charset      AS WSTRING
        LOCAL Charset_IDs  AS WSTRING
        LOCAL Base64       AS LONG
        LOCAL sIDc         AS WSTRING
        LOCAL wBuff        AS WSTRING
        LOCAL DefaultCP    AS LONG
        STATIC CodePages() AS STRING
        STATIC CodePagesCnt AS LONG
        LOCAL  CurrCodePage AS LONG
        LOCAL  AltCodePage AS LONG
      
        IF ARRAYATTR(CodePages(), 0) = 0 THEN  ' First time calling function, Load Code pages.
           CodePagesCnt = GetCodePages (CodePages())
        END IF
        ' copy the original line first
        strText = EncodedText
      '  strTextb = EncodedText
        FOR i = 1 TO CodePagesCnt
            Charset = UCASE$("=?"+CodePages(i,0)+"?")
            IF INSTR(UCASE$(EncodedText), Charset) > 0 THEN
                ' decode several individually encoded characters
                p0 = INSTR(UCASE$(EncodedText), Charset)
                IF p0 > 0 THEN
                    CurrCodePage =  VAL(CodePages(i,1))
                    ' CodePages that are Multi chracters will require MultiByteToWideChar
                    IF CodePages(i,0,1) = "1" THEN AltCodePage = CurrCodePage : CurrCodePage = 0       ' we also need this later
                    UCODEPAGE CurrCodePage TO DefaultCP '
      
                    DO
                        sIDc        = ""
                        Base64      = %False
                        IF p0 > 0 THEN
                            ' delete original line
                            strText = ""
                            ' Secure uncoded characters
                            strRun = LEFT$(EncodedText, p0 - 1)                                         'characters before encoding if any
                            p0 = p0 + LEN(Charset)                                                      'begining of encode string   ie: =?UTF-8?
                            IF INSTR(p0, UCASE$(EncodedText), "Q?") > 0 THEN                            'Q-Printable
                              Base64 = %False: sIDc = "Q?"  ' check if Q coded
                            ELSE                                                                        'Base64
                              Base64 = %True : sIDc = "B?"  ' check if Base64 coded
                            END IF
                            IF sIDc <> "" THEN                                                          ' if its Q? or B? process the encoding
                                p1 = INSTR(p0 - 1, UCASE$(EncodedText), sIDc) + 2                       ' position right after last ? in =?UTF-8?Q?
                                p2 = INSTR(p1, EncodedText, "?=") - 1                                   ' position just before ?= which indicates end of encoded string
                                p0 = INSTR(p2, UCASE$(EncodedText), Charset)
                                IF p2 < 0 THEN p2 = LEN(EncodedText)                                    ' Encoded-String is broken, point end of string
      
                                IF Base64 = %True THEN                                                  ' process B? Base64 ie:  =?UTF-8?B?4oKp?=
                                    strText = Base64_Decode(MID$(EncodedText, p1, p2 - p1 + 1), 0)  ' pass 4oKp  get resulting conversion "WON currecy sign"
                                ELSE                                                                    ' process Q?  Q-Printable ie:  =?UTF-8?Q?D=C3=B6rte?=
                                    FOR pChar = p1 TO p2                                                ' loop encoded string
                                        SELECT CASE MID$(EncodedText, pChar, 1)
                                            CASE "="                                                   ' convert = preceded byte to chr$ equivalent ie: =C3 to chr$(val("&HC3"))
                                                strText = strText & CHR$(VAL("&H" & MID$(EncodedText, pChar + 1, 2)))
                                                pChar = pChar + 2
                                            CASE "_"                                                  ' convert _ to space
                                                strText = strText & CHR$(32)
                                            CASE ELSE
                                                strText = strText & MID$(EncodedText, pChar, 1)       ' keep uncoded character untouched  ei: the D after Q? in =?UTF-8?Q?D=C3=B6rte?=
                                        END SELECT
                                    NEXT pChar
                                END IF
                            END IF
                            strText = strRun + strText
                        END IF
                        EncodedText = strText
                        ' adjust again
                        p0 = INSTR(UCASE$(EncodedText), Charset)
                    LOOP UNTIL p0 = 0
                    EXIT FOR
                END IF
            ELSE
                Charset = ""
            END IF
        NEXT i
           'At this point any Q-Printable or base64 have been processed
           ' so you can deal with "Character Set" specifics
           ' convert UTF-8, UTF-7 and many oriental character set to Unicode character set
           ' wBuff is a Wstring variable, so handles a greater range of Unicode characters
      
            IF AltCodePage = 0 THEN
               wBuff = strText                              ' Codepages that are single character
            ELSE
               wBuff = CPtoWide (EncodedText, AltCodePage)  ' CodePages that are Multi chracters will require MultiByteToWideChar
            END IF
      
        UCODEPAGE DefaultCP                       ' Set Code page back to default
        FUNCTION = wBuff
      END FUNCTION
      
      '-------------------------------------------------------------------------------------------
      ' Base64 - String decoder  +/
      '-------------------------------------------------------------------------------------------
      FUNCTION Base64_Decode(szEncoded AS STRING, OPT BYVAL iEndOfText AS LONG) AS STRING
      
              LOCAL icChopMask  AS INTEGER          ' Constant 8-bit mask (Faster than using string constants)
              LOCAL icBitShift  AS INTEGER          ' Constant shift mask (Faster than using string constants)
              LOCAL icStartMask AS INTEGER          ' Initial mask value  (Faster than using string constants)
              LOCAL iRollOver   AS INTEGER          ' Decoded Roll over value
              LOCAL iHighMask   AS INTEGER          ' Mask high bits of each char
              LOCAL iShift      AS INTEGER          ' Multiplier shift value
              LOCAL iLowShift   AS INTEGER          ' Mask low bits of each char
              LOCAL szAlphabet  AS STRING           ' Decode/Encode Lookup Table
              LOCAL iPtr        AS INTEGER
              LOCAL iChar       AS INTEGER
              LOCAL iCounter    AS INTEGER
              LOCAL sb          AS ISTRINGBUILDERA  ' Working buffer string
              sb = CLASS "StringBuilderA"           ' faster String concatenation  than a$= a$ + whatever$
      
              szAlphabet  = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
              icChopMask  = 255
              icBitShift  = 4
              icStartMask = &H10
              iShift      = icBitShift
              iLowShift   = 0
              iRollOver   = 0
              iHighMask   = -1
      
              ' Check if empty decoded string.
              ' If Empty, return NUL
              IF LEN(szEncoded) = 0 THEN
                  FUNCTION = ""
              ELSE
                  sb.clear
                  FOR iCounter = 1 TO LEN(szEncoded)
                      iChar = ASC(MID$(szEncoded, iCounter, 1)) ' Get next alphabet
                      iPtr = INSTR(szAlphabet, CHR$(iChar)) - 1 ' Get Decoded value
                      IF iPtr >= 0 THEN                         ' Check if character is valid
                          IF iShift = icBitShift THEN           ' Char is valid, process it
                              iRollOver = (iPtr * iShift) AND icChopMask ' 1st char in block of 4, keep high part of character
                              ' Reset masks for next character
                              iHighMask = &H30
                              iLowShift = icStartMask
                              iShift = icStartMask
                          ELSE
                              ' Start saving decoded character
                              sb.add  CHR$(iRollOver OR ((iPtr AND iHighMask) / iLowShift))
                              ' Calculate next mask and shift values
                              iRollOver = (iPtr * iShift) AND icChopMask
                              iShift = iShift * icBitShift
                              iHighMask = (iHighMask \ icBitShift) OR &H30
                              iLowShift = iLowShift / icBitShift
                              IF iShift > 256 THEN
                                  iShift = icBitShift
                                  iLowShift = 0
                              END IF
                          END IF
                      END IF
                  NEXT Counter
                  ' Concat last character if required
                  IF (iShift > icBitShift AND iShift < 256) THEN
                      ' Character remaining in    iRollOver
                      IF iEndOfText THEN
                          ' Last string to decode in file
                          sb.add  CHR$(iRollOver)
                      END IF
                  END IF
                  FUNCTION = sb.string
              END IF
      END FUNCTION
      '------------------------------------------------------------------------
      ' Base64 - String decoder                                             End
      '------------------------------------------------------------------------
      
      
      '--------------------------------------------------------------------------
      ' CPtoWide
      ' using CodePage MultiCharacters to wide converstion
      '__________________________________________________________________________
      #INCLUDE ONCE "Win32API.inc"
      FUNCTION CPtoWide (BYVAL CPStr AS STRING, cp AS LONG) AS WSTRING
       LOCAL ByteCount AS LONG
       LOCAL sMultiByte AS WSTRING
        ByteCount = MultiByteToWideChar(cp, %NULL, BYVAL STRPTR(CPStr), LEN(CPStr), BYVAL 0, 0)  ' call once with last parms null to get byte count required
        sMultiByte = NUL$(ByteCount)                                                             ' Create a buffer to receive
        MultiByteToWideChar(cp, %NULL, BYVAL STRPTR(CPStr),LEN(CPStr), BYVAL STRPTR(sMultiByte), LEN(sMultiByte))  'convert.
       FUNCTION = sMultiByte
      END FUNCTION
      '--------------------------------------------------------------------------
      ' CPtoWide                                                             end
      '--------------------------------------------------------------------------
      
      
      '--------------------------------------------------------------------------
      ' GetCodePages
      ' Load Code PAGES and coresponding value into an empty array
      '--------------------------------------------------------------------------
      '
      FUNCTION GetCodePages(BYREF CodePages() AS STRING) AS LONG
          'List of ".Net Names" from  https://docs.microsoft.com/en-us/windows/win32/intl/code-page-identifiers
          'Not the full set of IANA MIME charset names, but should cover most RFC2047 email headers
          LOCAL x AS LONG
          REDIM Codepages(1 TO DATACOUNT/2,1,1)
          FOR x = 1 TO DATACOUNT/3
               Codepages(x,0,0) = READ$(x*3 -2)
               CodePages(x,1,0) = READ$(x*3-1)
               CodePages(x,0,1) = READ$(x*3)
          NEXT
          FUNCTION = DATACOUNT/3   ' return how many
      ' Name, CodePage, 0 for single, 1 for Multi character
      DATA "ASMO-708","708","0"
      DATA "big5","950","1"
      DATA "cp1025","21025","0"
      DATA "cp866","866","0"
      DATA "cp875","875","0"
      DATA "csISO2022JP","50221","1"
      DATA "DOS-720","720","0"
      DATA "DOS-862","862","0"
      DATA "EUC-CN","51936","1"
      DATA "EUC-JP","51932","1"
      DATA "euc-kr","51949","0"
      DATA "GB18030","54936","1"
      DATA "gb2312","936","1"
      DATA "hz-gb-2312","52936","1"
      DATA "IBM00858","858","0"
      DATA "IBM00924","20924","0"
      DATA "IBM01047","1047","0"
      DATA "IBM01140","1140","0"
      DATA "IBM01141","1141","0"
      DATA "IBM01142","1142","0"
      DATA "IBM01143","1143","0"
      DATA "IBM01144","1144","0"
      DATA "IBM01145","1145","0"
      DATA "IBM01146","1146","0"
      DATA "IBM01147","1147","0"
      DATA "IBM01148","1148","0"
      DATA "IBM01149","1149","0"
      DATA "IBM037","37","0"
      DATA "IBM1026","1026","0"
      DATA "IBM273","20273","0"
      DATA "IBM277","20277","0"
      DATA "IBM278","20278","0"
      DATA "IBM280","20280","0"
      DATA "IBM284","20284","0"
      DATA "IBM285","20285","0"
      DATA "IBM290","20290","0"
      DATA "IBM297","20297","0"
      DATA "IBM420","20420","0"
      DATA "IBM423","20423","0"
      DATA "IBM424","20424","0"
      DATA "IBM437","437","0"
      DATA "IBM500","500","0"
      DATA "ibm737","737","0"
      DATA "ibm775","775","0"
      DATA "ibm850","850","0"
      DATA "ibm852","852","0"
      DATA "IBM855","855","0"
      DATA "ibm857","857","0"
      DATA "IBM860","860","0"
      DATA "ibm861","861","0"
      DATA "IBM863","863","0"
      DATA "IBM864","864","0"
      DATA "IBM865","865","0"
      DATA "ibm869","869","0"
      DATA "IBM870","870","0"
      DATA "IBM871","20871","0"
      DATA "IBM880","20880","0"
      DATA "IBM905","20905","0"
      DATA "IBM-Thai","20838","0"
      DATA "iso-2022-jp","50222","1"
      DATA "iso-2022-jp","50220","1"
      DATA "iso-2022-kr","50225","1"
      DATA "iso-8859-1","28591","0"
      DATA "iso-8859-13","28603","0"
      DATA "iso-8859-15","28605","0"
      DATA "iso-8859-2","28592","0"
      DATA "iso-8859-3","28593","0"
      DATA "iso-8859-4","28594","0"
      DATA "iso-8859-5","28595","0"
      DATA "iso-8859-6","28596","0"
      DATA "iso-8859-7","28597","0"
      DATA "iso-8859-8","28598","0"
      DATA "iso-8859-8-i","38598","0"
      DATA "iso-8859-9","28599","0"
      DATA "Johab","1361","0"
      DATA "koi8-r","20866","0"
      DATA "koi8-u","21866","0"
      DATA "ks_c_5601-1987","949","0"
      DATA "macintosh","10000","0"
      DATA "shift_jis","932","1"
      DATA "unicodeFFFE","1201","0"
      DATA "us-ascii","20127","0"
      DATA "utf-16","1200","0"
      DATA "utf-32","12000","0"
      DATA "utf-32BE","12001","0"
      DATA "utf-7","65000","1"
      DATA "utf-8","65001","1"
      DATA "windows-1250","1250","0"
      DATA "windows-1251","1251","0"
      DATA "windows-1252","1252","0"
      DATA "windows-1253","1253","0"
      DATA "windows-1254","1254","0"
      DATA "windows-1255","1255","0"
      DATA "windows-1256","1256","0"
      DATA "windows-1257","1257","0"
      DATA "windows-1258","1258","0"
      DATA "windows-874","874","0"
      DATA "x_Chinese-Eten","20002","0"
      DATA "x-Chinese_CNS","20000","0"
      DATA "x-cp20001","20001","0"
      DATA "x-cp20003","20003","0"
      DATA "x-cp20004","20004","0"
      DATA "x-cp20005","20005","0"
      DATA "x-cp20261","20261","0"
      DATA "x-cp20269","20269","0"
      DATA "x-cp20936","20936","0"
      DATA "x-cp20949","20949","0"
      DATA "x-cp50227","50227","0"
      DATA "x-EBCDIC-KoreanExtended","20833","0"
      DATA "x-Europa","29001","0"
      DATA "x-IA5","20105","0"
      DATA "x-IA5-German","20106","0"
      DATA "x-IA5-Norwegian","20108","0"
      DATA "x-IA5-Swedish","20107","0"
      DATA "x-iscii-as","57006","0"
      DATA "x-iscii-be","57003","0"
      DATA "x-iscii-de","57002","0"
      DATA "x-iscii-gu","57010","0"
      DATA "x-iscii-ka","57008","0"
      DATA "x-iscii-ma","57009","0"
      DATA "x-iscii-or","57007","0"
      DATA "x-iscii-pa","57011","0"
      DATA "x-iscii-ta","57004","0"
      DATA "x-iscii-te","57005","0"
      DATA "x-mac-arabic","10004","0"
      DATA "x-mac-ce","10029","0"
      DATA "x-mac-chinesesimp","10008","0"
      DATA "x-mac-chinesetrad","10002","0"
      DATA "x-mac-croatian","10082","0"
      DATA "x-mac-cyrillic","10007","0"
      DATA "x-mac-greek","10006","0"
      DATA "x-mac-hebrew","10005","0"
      DATA "x-mac-icelandic","10079","0"
      DATA "x-mac-japanese","10001","0"
      DATA "x-mac-korean","10003","0"
      DATA "x-mac-romanian","10010","0"
      DATA "x-mac-thai","10021","0"
      DATA "x-mac-turkish","10081","0"
      DATA "x-mac-ukrainian","10017","0"
      
      END FUNCTION
      '--------------------------------------------------------------------------
      ' GetCodePages                                                          End
      '--------------------------------------------------------------------------
      
      '==========================================================================
      ' Get_Qp2Text  and Dependencies                                All      End
      '==========================================================================
      '

      Comment

      Working...
      X