Codificar para base64

Código para codificar uma string para base64 (retirado de http://www.pstruh.cz/). Para codificar dados binários, faça:

Base64EncodeBinary = Base64Encode(BinaryToString(inData))

No entanto, não deve ser usada para conversão de sequencias grandes (acima de 100kb).

Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
 
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
   
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
   
    'Oct splits the long to 8 groups with 3 bits
    nGroup = Oct(nGroup)
   
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
   
    'Convert to base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
   
    'Add the part to output string
    sOut = sOut + pOut
   
    'Add a new line for each 76 chars in dest (76*3/4 = 57)
    If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

Esta matéria foi postada originalmente no ASP4Developers por Rubens N. Farias (site), que na época era "pós-graduado em análise de sistemas orientados a objetos, MCP, MCSD, MCAD, MCSD.NET e consultor em TI, além de idealizador do projeto ASP4Developers. Desenvolve sistemas sob medida, focados na satisfação do usuário, com qualidade e custo realista.". Hoje, vai saber...