Quote Originally Posted by Elroy View Post
It's been forever since I've messed with this, but just something else in my "junk drawer":

Code:
Option Explicit
'
Private Const Equals As Byte = 61     ' Asc("=")
'
Private Const Mask1 As Byte = 3       ' 00000011
Private Const Mask2 As Byte = 15      ' 00001111
Private Const Mask3 As Byte = 63      ' 00111111
Private Const Mask4 As Byte = 192     ' 11000000
Private Const Mask5 As Byte = 240     ' 11110000
Private Const Mask6 As Byte = 252     ' 11111100
'
Private Const Shift2 As Byte = 4
Private Const Shift4 As Byte = 16
Private Const Shift6 As Byte = 64
'
Private Base64Lookup() As Byte
Private Base64Reverse() As Byte
'

Public Function bFileExists(fle As String) As Boolean
    On Error GoTo FileExistsError
    ' If no error then something existed.
    bFileExists = (GetAttr(fle) And vbDirectory) = 0
    Exit Function
FileExistsError:
    bFileExists = False
    Exit Function
End Function

Public Property Let StringToAsciiFile(sFileSpec As String, sStr As String)
    ' If file exists, this will fail.
    Dim iFle As Long
    '
    If bFileExists(sFileSpec) Then Exit Property
    iFle = FreeFile
    On Error Resume Next
    Open sFileSpec For Output As iFle
    If Err <> 0 Then Close iFle: Exit Property
    On Error GoTo 0
    Print #iFle, sStr;
    Close iFle
End Property

Public Function AsciiFileToString(sFileSpec As String) As String
    Dim iFle As Long
    '
    If Not bFileExists(sFileSpec) Then Exit Function
    iFle = FreeFile
    On Error Resume Next
    Open sFileSpec For Binary As iFle
    If Err <> 0 Then Close iFle: Exit Function
    On Error GoTo 0
    If Len(iFle) = 0 Then Close iFle: Exit Function
    '
    ' For variable length strings, the number of bytes read equals the number of characters already in the string.
    AsciiFileToString = Space(LOF(iFle))
    Get iFle, 1, AsciiFileToString
    Close iFle
End Function

Public Function EncodeString(Text As String) As String
    Dim Data() As Byte
    '
    Initialize
    Data = StrConv(Text, vbFromUnicode)
    EncodeString = EncodeByteArray(Data)
End Function

Public Function EncodeByteArray(Data() As Byte) As String
    Dim EncodedData() As Byte
    Dim DataLength As Long
    Dim EncodedLength As Long
    Dim Data0 As Long
    Dim Data1 As Long
    Dim Data2 As Long
    Dim l As Long
    Dim m As Long
    Dim Index As Long
    Dim CharCount As Long
    '
    Initialize
    DataLength = UBound(Data) + 1
    '
    EncodedLength = (DataLength \ 3) * 4
    If DataLength Mod 3 > 0 Then EncodedLength = EncodedLength + 4
    EncodedLength = EncodedLength + ((EncodedLength \ 76) * 2)
    If EncodedLength Mod 78 = 0 Then EncodedLength = EncodedLength - 2
    ReDim EncodedData(EncodedLength - 1)
    '
    m = (DataLength) Mod 3
    '
    For l = 0 To UBound(Data) - m Step 3
        Data0 = Data(l)
        Data1 = Data(l + 1)
        Data2 = Data(l + 2)
        EncodedData(Index) = Base64Lookup(Data0 \ Shift2)
        EncodedData(Index + 1) = Base64Lookup(((Data0 And Mask1) * Shift4) Or (Data1 \ Shift4))
        EncodedData(Index + 2) = Base64Lookup(((Data1 And Mask2) * Shift2) Or (Data2 \ Shift6))
        EncodedData(Index + 3) = Base64Lookup(Data2 And Mask3)
        Index = Index + 4
        CharCount = CharCount + 4
        '
        If CharCount = 76 And Index < EncodedLength Then
            EncodedData(Index) = 13
            EncodedData(Index + 1) = 10
            CharCount = 0
            Index = Index + 2
        End If
    Next l
    '
    If m = 1 Then
        Data0 = Data(l)
        EncodedData(Index) = Base64Lookup((Data0 \ Shift2))
        EncodedData(Index + 1) = Base64Lookup((Data0 And Mask1) * Shift4)
        EncodedData(Index + 2) = Equals
        EncodedData(Index + 3) = Equals
        Index = Index + 4
    ElseIf m = 2 Then
        Data0 = Data(l)
        Data1 = Data(l + 1)
        EncodedData(Index) = Base64Lookup((Data0 \ Shift2))
        EncodedData(Index + 1) = Base64Lookup(((Data0 And Mask1) * Shift4) Or (Data1 \ Shift4))
        EncodedData(Index + 2) = Base64Lookup((Data1 And Mask2) * Shift2)
        EncodedData(Index + 3) = Equals
        Index = Index + 4
    End If
    '
    EncodeByteArray = StrConv(EncodedData, vbUnicode)
End Function

Public Function DecodeToString(EncodedText As String) As String
    Dim Data() As Byte
    '
    Initialize
    Data = DecodeToByteArray(EncodedText)
    DecodeToString = StrConv(Data, vbUnicode)
End Function

Public Function DecodeToByteArray(EncodedText As String) As Byte()
    Dim Data() As Byte
    Dim EncodedData() As Byte
    Dim DataLength As Long
    Dim EncodedLength As Long
    Dim EncodedData0 As Long
    Dim EncodedData1 As Long
    Dim EncodedData2 As Long
    Dim EncodedData3 As Long
    Dim l As Long
    Dim m As Long
    Dim Index As Long
    Dim CharCount As Long
    '
    Initialize
    ' Remove CRLF and "=" characters.
    EncodedData = StrConv(Replace$(Replace$(EncodedText, vbCrLf, ""), "=", ""), vbFromUnicode)
    '
    EncodedLength = UBound(EncodedData) + 1
    DataLength = (EncodedLength \ 4) * 3
    '
    m = EncodedLength Mod 4
    If m = 2 Then
        DataLength = DataLength + 1
    ElseIf m = 3 Then
        DataLength = DataLength + 2
    End If
    '
    ReDim Data(DataLength - 1)
    '
    For l = 0 To UBound(EncodedData) - m Step 4
        EncodedData0 = Base64Reverse(EncodedData(l))
        EncodedData1 = Base64Reverse(EncodedData(l + 1))
        EncodedData2 = Base64Reverse(EncodedData(l + 2))
        EncodedData3 = Base64Reverse(EncodedData(l + 3))
        Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
        Data(Index + 1) = ((EncodedData1 And Mask2) * Shift4) Or (EncodedData2 \ Shift2)
        Data(Index + 2) = ((EncodedData2 And Mask1) * Shift6) Or EncodedData3
        Index = Index + 3
    Next l
    '
    Select Case ((UBound(EncodedData) + 1) Mod 4)
    Case 2
        EncodedData0 = Base64Reverse(EncodedData(l))
        EncodedData1 = Base64Reverse(EncodedData(l + 1))
        Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
    Case 3
        EncodedData0 = Base64Reverse(EncodedData(l))
        EncodedData1 = Base64Reverse(EncodedData(l + 1))
        EncodedData2 = Base64Reverse(EncodedData(l + 2))
        Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
        Data(Index + 1) = ((EncodedData1 And Mask2) * Shift4) Or (EncodedData2 \ Shift2)
    End Select
    '
    DecodeToByteArray = Data
End Function

Private Sub Initialize()
    Dim l As Long
    Static bInitialized As Boolean
    '
    If bInitialized Then Exit Sub
    ReDim Base64Reverse(255)
    Base64Lookup = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
    For l = 0 To 63
        Base64Reverse(Base64Lookup(l)) = l
    Next l
    bInitialized = True
End Sub
p.s. The name of the module was Base64MimeCoding.bas.
Hi,
how can use the functions in the module?
I've .pdf file to encode in base64.

thank you
Patty