Function EncodeStr64(sInput)
*!*	' Return radix64 encoding of string of binary values
*!*	' Does not insert CRLFs. Just returns one long string,
*!*	' so it's up to the user to add line breaks or other formatting.
*!*	' Version 4: Use Byte array and StrConv - much faster
* Converted From VB code at: http://www.di-mgt.com.au/crypto.html#Base64

  PRIVATE aEncTab
  aEncTab = [ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/]

  LOCAL lcOut, nLen, iIndex, lcPart, i, j, nQuants, sLast
    lcOut = ""
    nLen = Len(sInput)
    nQuants = int(len(sInput) / 3)
    If (nQuants > 0) Then

        *' Now start reading in 3 bytes at a time
        For i = 0 To nQuants - 1
          lcPart = ''
          For j = 0 To 2
            lcPart = lcPart + SubStr(sInput, (i*3) + j + 1, 1)
          Next
          lcPart = ThIS.EncodeQuantumB( lcPart )
          lcOut = lcOut + lcPart
        Next
        *EncodeStr64 = StrConv(abOutput, vbUnicode)
        lcOut = StrConv(lcOut, 1) && singlebyte -> Dbl
        lcOut = StrConv(lcOut, 5) && DblBye -> Unicode
    EndIf

    *' Cope with odd bytes
    *' (no real performance hit by using strings here)
    do case
      case nLen%2=0
        sLast = ""
      case nLen%2=1
        sLast = SubStr(sInput, nLen, 1)+chr(0)+chr(0)
        sLast = THIS.EncodeQuantumB(sLast)
*        sLast = StrConv(b(, vbUnicode)
        sLast = StrConv(sLast,1)
        sLast = StrConv(sLast,5)
        *' Replace last 2 with =
        sLast = Left(sLast, 2) + "=="
      case nLen%2=2
        sLast = SubStr(sInput, nLen - 1, 1)+SubStr(sInput, nLen, 1))+chr(0)
        sLast = THIS.EncodeQuantumB(sLast)
*        sLast = StrConv(b(), vbUnicode)
        sLast = StrConv(sLast,1)
        sLast = StrConv(sLast,5)
        *' Replace last with =
        sLast = Left(sLast, 3) + "="
    Endcase

    RETURN lcOut+sLast
ENDFUNC

*!*	Public Function DecodeStr64(sEncoded As String) As String
*!*	' Return string of decoded binary values given radix64 string
*!*	' Ignores any chars not in the 64-char subset
*!*	' Version 4: Use Byte array and StrConv - much faster
*!*	    Dim abDecoded() As Byte 'Version 4: Now a Byte array
*!*	    Dim d(3) As Byte
*!*	    Dim C As Integer        ' NB Integer to catch -1 value
*!*	    Dim di As Integer
*!*	    Dim i As Long
*!*	    Dim nLen As Long
*!*	    Dim iIndex As Long
*!*	
*!*	    nLen = Len(sEncoded)
*!*	    If nLen < 4 Then
*!*	        Exit Function
*!*	    End If
*!*	    ReDim abDecoded(((nLen \ 4) * 3) - 1) 'Version 4: Now base zero
*!*	
*!*	    iIndex = 0  ' Version 4: Changed to base 0
*!*	    di = 0
*!*	    Call MakeDecTab
*!*	    ' Read in each char in turn
*!*	    For i = 1 To Len(sEncoded)
*!*	        C = CByte(Asc(Mid(sEncoded, i, 1)))
*!*	        C = aDecTab(C)
*!*	        If C >= 0 Then
*!*	            d(di) = CByte(C)    ' Version 3.1: add CByte()
*!*	            di = di + 1
*!*	            If di = 4 Then
*!*	                abDecoded(iIndex) = SHL2(d(0)) Or (SHR4(d(1)) And &H3)
*!*	                iIndex = iIndex + 1
*!*	                abDecoded(iIndex) = SHL4(d(1) And &HF) Or (SHR2(d(2)) And &HF)
*!*	                iIndex = iIndex + 1
*!*	                abDecoded(iIndex) = SHL6(d(2) And &H3) Or d(3)
*!*	                iIndex = iIndex + 1
*!*	                If d(3) = 64 Then
*!*	                    iIndex = iIndex - 1
*!*	                    abDecoded(iIndex) = 0
*!*	                End If
*!*	                If d(2) = 64 Then
*!*	                    iIndex = iIndex - 1
*!*	                    abDecoded(iIndex) = 0
*!*	                End If
*!*	                di = 0
*!*	            End If
*!*	        End If
*!*	    Next i
*!*	    ' Convert to a string
*!*	    DecodeStr64 = StrConv(abDecoded(), vbUnicode)
*!*	    ' Remove any unwanted trailing chars
*!*	    DecodeStr64 = Left(DecodeStr64, iIndex)
*!*	ENDFUNC

FUNCTION EncodeQuantumB( strIn )
*' Expects at least 4 bytes in b, i.e. Dim b(3) As Byte
LOCAL b0,b1,b2,b3
    b0 =        BitAnd( THIS.SHR2(asc(strIn)), 0x3F )
    b1 = BitOr( BitAnd( THIS.SHL4(ASC(StrIn)), 0x03 ),          BitAnd(THIS.SHR4(ASC(SubStr(strIn,2))),  0x0F ) )
    b2 = BitOr( THIS.SHL2( BitAnd(ASC(SubStr(StrIn,2)),0x0F) ), BitAnd(THIS.SHR6(Asc(SubStr(strIn,3))), 0x03 ) )
    b3 =        BitAnd( Asc(Substr(strIn,3)), 0x3F )
    RETURN Substr(aEncTab,b0,1)+Substr(aEncTab,b1,1)+Substr(aEncTab,b2,1)+Substr(aEncTab,b3,1)
EndFunc


*!*	Private Function MakeDecTab()
*!*	' Set up Radix 64 decoding table
*!*	    Dim t As Integer
*!*	    Dim C As Integer
*!*	    For C = 0 To 255
*!*	        aDecTab(C) = -1
*!*	    Next
*!*	    t = 0
*!*	    For C = Asc("A") To Asc("Z")
*!*	        aDecTab(C) = t
*!*	        t = t + 1
*!*	    Next
*!*	    For C = Asc("a") To Asc("z")
*!*	        aDecTab(C) = t
*!*	        t = t + 1
*!*	    Next
*!*	    For C = Asc("0") To Asc("9")
*!*	        aDecTab(C) = t
*!*	        t = t + 1
*!*	    Next
*!*	    C = Asc("+")
*!*	    aDecTab(C) = t
*!*	    t = t + 1
*!*	    C = Asc("/")
*!*	    aDecTab(C) = t
*!*	    t = t + 1
*!*	    C = Asc("=")    ' flag for the byte-deleting char
*!*	    aDecTab(C) = t  ' should be 64
*!*	ENDFUNC


*' Version 3: ShiftLeft and ShiftRight functions improved.
Function SHL2(bytValue)
*' Shift 8-bit value to left by 2 bits
*' i.e. VB equivalent of "bytValue << 2" in C
  RETURN BitAnd(bytValue * 0x04, 0xFF)
EndFunc

Function SHL4(bytValue)
*' Shift 8-bit value to left by 4 bits
*' i.e. VB equivalent of "bytValue << 4" in C
  RETURN BitAnd(bytValue * 0x10, 0xFF )
EndFunc

Function SHL6(bytValue )
*' Shift 8-bit value to left by 6 bits
*' i.e. VB equivalent of "bytValue << 6" in C
  ReTURN BitAnd(bytValue * 0x40, 0xFF)
EndFunc

Function SHR2(bytValue )
*' Shift 8-bit value to right by 2 bits
*' i.e. VB equivalent of "bytValue >> 2" in C
  RETURN INT( bytValue / 0x04 )
EndFunc

Function SHR4(ByVal )
*' Shift 8-bit value to right by 4 bits
*' i.e. VB equivalent of "bytValue >> 4" in C
  RETURN INT( bytValue / 0x10 )
ENDFUNC

Function SHR6(ByVal bytValue )
*' Shift 8-bit value to right by 6 bits
*' i.e. VB equivalent of "bytValue >> 6" in C
  RETURN INT( bytValue / 0x40 )
ENDFUNC

Not talking about STRCONV() here. Here's a shorter version that performs base64 encoding and decoding using Cryptography API Functions:

DECLARE INTEGER CryptBinaryToString IN Crypt32;
	STRING @pbBinary, LONG cbBinary, LONG dwFlags,;
	STRING @pszString, LONG @pcchString

DECLARE INTEGER CryptStringToBinary IN crypt32;
	STRING @pszString, LONG cchString, LONG dwFlags,;
	STRING @pbBinary, LONG @pcbBinary,;
	LONG pdwSkip, LONG pdwFlags

FUNCTION ToBase64(cSrc)
	LOCAL nFlags, nBufsize, cDst
	nFlags=1  && base64

	nBufsize=0
	= CryptBinaryToString(@cSrc, LEN(cSrc),;
		m.nFlags, NULL, @nBufsize)

	cDst = REPLICATE(CHR(0), m.nBufsize)
	IF CryptBinaryToString(@cSrc, LEN(cSrc), m.nFlags,;
		@cDst, @nBufsize) = 0
		RETURN ""
	ENDIF
RETURN cDst

FUNCTION FromBase64(cSrc)
	LOCAL nFlags, nBufsize, cDst
	nFlags=1  && base64

	nBufsize=0
	= CryptStringToBinary(@cSrc, LEN(m.cSrc),;
		nFlags, NULL, @nBufsize, 0,0)

	cDst = REPLICATE(CHR(0), m.nBufsize)
	IF CryptStringToBinary(@cSrc, LEN(m.cSrc),;
		nFlags, @cDst, @nBufsize, 0,0) = 0
		RETURN ""
	ENDIF
RETURN m.cDst

-- Anatoliy Mogylevets

Here's some compact, base64 implementation using native VFP7 functions:
(note: requires input strings to be encoded in 8bit format):

FUNCTION base64_encode(S as String)
    LOCAL i,j,k,q,ch,s2,buf,basechars
    basechars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
    buf = 0
    s2 = ''
    j = 0
    k = LEN(s)
    FOR i = 1 TO k
        ch = ASC(SUBSTR(s,i,1))
        q = (BITAND(BITRSHIFT(ch,6),3)) + BITLSHIFT(BITAND(BITRSHIFT(ch,4),3),2) + ;
             BITLSHIFT(BITAND(BITRSHIFT(ch,2),3),4) + BITLSHIFT(BITAND(ch,3),6)
        buf = BITOR(BITLSHIFT(q,j),buf)
        j = j + 8
        DO WHILE (j >= 6) OR ((i = k) AND (j > 0))
            q = 1 + BITLSHIFT(BITAND(buf,3),4) + BITLSHIFT(BITAND(BITRSHIFT(buf,2),3),2) + ;
                   (BITAND(BITRSHIFT(buf,4),3))
            ch = SUBSTR(basechars,q,1)
            s2 = s2 + ch
            buf = BITRSHIFT(buf,6)
            j = j - 6
        ENDDO
    ENDFOR
    s2 = s2 + IIF(LEN(s2) % 4 > 0,REPLICATE('=',4 - (LEN(s2) % 4)),'')
    RETURN s2
ENDFUNC

FUNCTION base64_decode(S as String)
    LOCAL i,j,j,k,q,ch,s2,buf,tmpc
    tmpc = 0
    j = 0
    buf = 0
    s2 = ''
    k = LEN(s)
    FOR i = 1 TO k
        ch = ASC(SUBSTR(s,i,1))
        q = IIF((ch >= 97 AND ch <=122),25+ch-96,IIF((ch >= 65 AND ch <=90),ch-65,;
            IIF((ch >= 48 AND ch <=57),ch+4,IIF(ch = 47,63,-1))))
        IF q < 0 THEN
            RETURN IIF(ch = 61,s2,'')
        ENDIF
        buf = BITOR(BITLSHIFT(buf,6),q)
        j = j + 6
        IF j >= 8 THEN
            j = j - 8
            tmpc = CHR(BITAND(BITRSHIFT(buf,j),255))
            buf = BITAND(buf,BITLSHIFT(1,j) -1)
            s2 = s2 + tmpc
        ENDIF
    ENDFOR
    RETURN s2
ENDFUNC

-- Ricardo Garcia

---

See also: Encoding Algorithms

---

Category Code Samples Category UDF