Announcement

Collapse
No announcement yet.

UTF-8 to ASCII

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

  • #21
    Originally posted by Gary Beene View Post
    And, wouldn't you know it , today I ran across a type B encoding ...

    Code:
    From: =?UTF-8?B?UGllciAx?= <[email protected]>
    The links in posts #8 and #11 include Base64 decoding as well as QP decoding routines.

    Comment


    • #22
      Ok, I brought over just the decode quoted printable function from Thomas Gohel in the earlier mentioned thread.

      Since then, PowerBASIC introduced it's own UTFtoChr$ function, so I used it instead of Thomas' custom function.

      Also, I commented out the B decoding for this test.

      At least for the two lines of code it tests, the results came out as expected. Cool beans!

      Now I need to go try out Thomas' B code as well.

      In that case, Dale, is his code supposed to do the same as your code?

      Code:
      'Compilable Example:
      #Compiler PBWin 10
      #Compile Exe
      #Dim All
      %Unicode = 1
      #Include "Win32API.inc"
      
      Enum Equates Singular
         IDC_Button
      End Enum
      
      Global hDlg As Dword
      
      Function PBMain() As Long
         Dialog New Pixels, 0, "PowerBASIC",300,300,200,200, %WS_OverlappedWindow To hDlg
         Control Add Button, hDlg, %IDC_Button,"Push", 50,10,100,20
         Dialog Show Modal hDlg Call DlgProc
      End Function
      
      CallBack Function DlgProc() As Long
         Select Case Cb.Msg
            Case %WM_Command
               Select Case Cb.Ctl
                  Case %IDC_Button
                     ? Get_Qp2Text("From: =?UTF-8?Q?Yahoo?= &lt;[email protected]&gt;")
                     ? Get_Qp2Text("Subject: =?UTF-8?Q?Hi=2Cstay=20connected=20with=20Yahoo=20Mail=20mobile=20app?=")
               End Select
         End Select
      End Function
      
      Function Get_Qp2Text(ByVal EncodedText As String) As String
      
              Dim i            As Local Long        '
              Dim p0           As Local Long        '
              Dim p1           As Local Long        '
              Dim p2           As Local Long        '
              Dim pChar        As Local Long        '
              Dim strText      As Local String      '
              Dim szDest       As Local AsciiZ * 210'
              Dim strRun       As Local String      '
              Dim strTmp       As Local String      '
              Dim Charset      As Local String      '
              Dim Charset_IDs  As Local String      '
              Dim Base64       As Local Long        '
              Dim QuotedPrint  As Local Long        '
              Dim UTF8         As Local Long
              Dim Id           As Local String      '
              Charset_IDs$ = "=?ISO-8859-1? =?ISO-8859-15? =?WINDOWS-1252? =?UTF-8? =?UTF-7?"
      
              ' originale Zeile erstmal umkopieren
              strText = EncodedText
      
              For i& = 1 To ParseCount(Charset_IDs, " ")
                  Charset = Parse$(Charset_IDs, " " , i&)
                  If InStr(UCase$(EncodedText), Charset) > 0 Then
                      ' mehrere einzeln kodierte Zeichen dekodieren
                      p0 = InStr(UCase$(EncodedText), Charset)
                      If p0 > 0 Then
                          Do
                              Id          = ""
                              Base64      = %False
                              QuotedPrint = %False
                              If p0 > 0 Then
                                  ' originale Zeile l÷schen
                                  strText = ""
                                  ' fnhrende unkodierte Zeichen sichern
                                  strRun = Left$(EncodedText, p0 - 1)
                                  p0 = p0 + Len(Charset)
                                  If InStr(p0, UCase$(EncodedText), "Q?") > 0 Then Base64 = %False: Id = "Q?"
                                  If InStr(p0, UCase$(EncodedText), "B?") > 0 Then Base64 = %True : Id = "B?"
                                  If Id <> "" Then
                                      p1 = InStr(p0 - 1, UCase$(EncodedText), Id) + 2
                                      p2 = InStr(p1, EncodedText, "?=") - 1
                                      p0 = InStr(p2, UCase$(EncodedText), Charset)
                                      If p2 < 0 Then p2 = Len(EncodedText)     ' Encoded-String ist defekt, auf echtes Ende setzen
      
                                      If Base64 = %True Then
                                          ? "not supported"
                                      Else
                                          For pChar = p1 To p2
                                              Select Case Mid$(EncodedText, pChar, 1)
                                                  Case "="
                                                      strText = strText & Chr$(Val("&H" & Mid$(EncodedText, pChar + 1, 2)))
                                                      pChar = pChar + 2
                                                  Case "_"
                                                      strText = strText & Chr$(32)
                                                  Case Else
                                                      strText = strText & Mid$(EncodedText, pChar, 1)
                                              End Select
                                          Next pChar
                                      End If
                                     ' Leerzeichen zwischen encoded Words enfernen
                                     p0 = InStr(UCase$(Mid$(EncodedText, p2 + 3)), Charset)
                                     If p0 > 0 Then
                                         strText = strText & Mid$(EncodedText, p0 + p2 + 2)
                                     Else
                                         strText = strText & Mid$(EncodedText, p2 + 3)
                                     End If
                                  Else
                                  End If
                                  strText = strRun + strText
                              Else
                              End If
                              EncodedText = strText
                              ' nochmal justieren
                              p0 = InStr(UCase$(EncodedText), Charset)
                          Loop Until p0 = 0
                          Exit For
                      Else
                      End If
                  Else
                      Charset$ = ""
                  End If
              Next i&
      
              Select Case UCase$(Charset$)
                  Case "=?UTF-8?"
                      strRun = Utf8ToChr$(EncodedText)
                  Case "=?UTF-7?"
                  Case Else
                      ' Zeichensatz auf Console umstricken (blockweise da Zeile sich eventuell nicht
                      ' an RFC-Standard hSlt)
                      ' Hinweis: Es werden auch nicht-kodierte Zeilen per Default umgewandelt, da diverse
                      '          Mail/Newsreader hierbei die Kodierung vergessen
                      strRun       = ""
                      For p1 = 1 To Len(strText) Step 200
                          strTmp = Mid$(strText, p1, 200)
                          CharToOem strTmp + Chr$(0), szDest
                          strRun = strRun + szDest
                      Next p1
              End Select
              Function = strRun
      
      End Function

      Comment


      • #23
        Originally posted by Gary Beene View Post
        In that case, Dale, is his code supposed to do the same as your code?
        Dale's code is simply a UTF-8 to WSTRING function which does the same as the now built in UTF8ToChr$() function.

        It has nothing to do with your requirement to decode a QP string other than you should use UTF8ToChr$() on the output of Get_Qp2Text to convert the UTF-8 string result to a WSTRING.

        Comment


        • #24
          Gary,

          I believe you moved on to another solution, using SocketTools.

          Here is a PowerBasic solution, for those who don't have it. This is a more robust version of Thomas Gohel's code.
          that decodes Q-printable, Base64, and converts UTF-8 to WideString, PowerBasic's implementation of Unicode.

          When decoding email header that have been encoded to RFC2047, you are basically doing 2 Steps
          1. "Q?" change all Q-codes like "=xx" to their chr$(xx) equivalent, or "B?" convert Base64 to String
          2. Convert resulting string after Step 1, from its encoded Character Set "UTF-8" to required Character Set in this case Unicode or Ansi (in PB10 use WString for (Unicode) or String for (Ansi)) MyDecodedText$$ = Utf8toChr$(StringFromStep1)
          Code:
          'Compilable Example:
          #COMPILER PBWIN 10
          #COMPILE EXE
          #DIM ALL
          %Unicode = 1
          #INCLUDE "Win32API.inc"
          
          ENUM Equates SINGULAR
             IDC_Button
          END ENUM
          
          GLOBAL hDlg AS DWORD
          
          FUNCTION PBMAIN() AS LONG
             DIALOG NEW PIXELS, 0, "PowerBASIC",300,300,200,200, %WS_OVERLAPPEDWINDOW TO hDlg
             CONTROL ADD BUTTON, hDlg, %IDC_Button,"Push", 50,10,100,20
             DIALOG SHOW MODAL hDlg CALL DlgProc
          END FUNCTION
          
          CALLBACK FUNCTION DlgProc() AS LONG
          LOCAL wBuff AS WSTRING
          
             SELECT CASE CB.MSG
                CASE %WM_COMMAND
                   SELECT CASE CB.CTL
                      CASE %IDC_Button
                        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?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=FCller?= <[email protected]>") + $CRLF _
                         + Get_Qp2Text("=?ISO-8859-1?Q?Thomas_M=F6ller?= =?ISO-8859-1?Q?_Thomas_M=F6ller?=") + $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: =?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("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
          
                   END SELECT
             END SELECT
          END FUNCTION
          
          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 ]+(=\?)"                                                        ' Remove Spaces CR LF between ?=  =?   
              REGEXPR sMask IN EncodedText TO position, length                                          ' RFC2047 - No Spaces CR LF 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
          
              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
          
          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
                  DIM i            AS LOCAL LONG                                   
                  DIM p0           AS LOCAL LONG                                  
                  DIM p1           AS LOCAL LONG                                                                         
                  DIM p2           AS LOCAL LONG        
                  DIM pChar        AS LOCAL LONG        
                  DIM strText      AS LOCAL wSTRING      
                  DIM strRun       AS LOCAL wSTRING      
                  dim strTmp       AS LOCAL wSTRING
                  DIM Charset      AS LOCAL wSTRING      
                  DIM Charset_IDs  AS LOCAL wSTRING      
                  DIM Base64       AS LOCAL LONG        
                  DIM sIDc         AS LOCAL WSTRING      
                  DIM wBuff        AS LOCAL WSTRING
          
                  Charset_IDs = "=?ISO-8859-1? =?ISO-8859-15? =?WINDOWS-1252? =?UTF-8? =?UTF-7? =?ISO-8859-2? =?US-ASCII?"
          
                  ' copy the original line first
                  strText = EncodedText
                  FOR i = 1 TO PARSECOUNT(Charset_IDs, " ")
                      Charset = PARSE$(Charset_IDs, " " , i)
                      IF INSTR(UCASE$(EncodedText), Charset) > 0 THEN
                          ' decode several individually encoded characters
                          p0 = INSTR(UCASE$(EncodedText), Charset)
                          IF p0 > 0 THEN
                              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 = Get_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
                  SELECT CASE UCASE$(Charset)                 ' so you can deal with "Character Set" specifics  
                      CASE "=?UTF-8?"                         ' convert UTF-8 character set to Unicode character set
                          wBuff = UTF8TOCHR$(EncodedText)     ' wBuff is a Wstring variable, so UTF8toCHR$ handles a greater range of UTF8 characters
                      CASE "=?UTF-7?"                         ' not implimented - Rarely used
                      CASE ELSE                               ' all others
                          wBuff = strText
                  END SELECT
                  FUNCTION = wBuff
          END FUNCTION
          
          '-------------------------------------------------------------------------------------------
          ' Base64 - String decode
          '-------------------------------------------------------------------------------------------
          FUNCTION Get_Base64_Decode(szEncoded AS STRING, iEndOfText AS INTEGER) AS STRING
          
                  DIM icChopMask  AS LOCAL INTEGER  ' Constant 8-bit mask (Faster than using string constants)
                  DIM icBitShift  AS LOCAL INTEGER  ' Constant shift mask (Faster than using string constants)
                  DIM icStartMask AS LOCAL INTEGER  ' Initial mask value  (Faster than using string constants)
                  DIM iRollOver   AS LOCAL INTEGER  ' Decoded Roll over value
                  DIM iHighMask   AS LOCAL INTEGER  ' Mask high bits of each char
                  DIM iShift      AS LOCAL INTEGER  ' Multiplier shift value
                  DIM iLowShift   AS LOCAL INTEGER  ' Mask low bits of each char
                  DIM szAlphabet  AS LOCAL STRING   ' Decode/Encode Lookup Table
                  DIM szTemp      AS LOCAL STRING   ' Working string
                  DIM iPtr        AS LOCAL INTEGER
                  DIM iChar       AS LOCAL INTEGER
                  DIM iCounter    AS LOCAL INTEGER
          
                  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
                      szTemp = ""
                      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
                                  szTemp = szTemp + 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
                              szTemp = szTemp + CHR$(iRollOver)
                          END IF
                      END IF
                      FUNCTION = szTemp
                  END IF
          END FUNCTION

          Comment


          • #25
            Thanks to all who have added their ideas. I don't think I've ever found a more helpful forum in my life. Not only do you answer the original need but you back it up with references on the background. That's impressive.

            One item that occurred to me.. Before I do the decode, I should collect all the lines until I get to the one ending with '='?

            --Ben

            Comment


            • #26
              Originally posted by Ben Conner View Post
              .. Before I do the decode, I should collect all the lines until I get to the one ending with '='?

              --Ben
              Yes you should collect all the lines, But it may not end with '=', one or two or none, equal signs may be used as padding depending on the length of the content.

              Comment

              Working...
              X