Public Function IsGoodBase64Enc(Optional numArrays As Long) As Boolean
' verify correct Base64Enc, returns True if all tests are passed
' checks provided by Guido Beckmann, G.Beckmann@NikoCity.de, 20011204
' update 20021020
    
    Const CHARSETBASE64$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
                           "abcdefghijklmnopqrstuvwxyz" & _
                           "0123456789+/"
    Dim sSrc As String
    Dim abSrc() As Byte, abTrg() As Byte
    Dim c&, d&, i&, sEncode$, sResult$
    
    ReDim abSrc(0 To 2)
    sResult = "****"
    
    i = 0:        GoSub Test
    i = &H11111:  GoSub Test
    i = &H33333:  GoSub Test
    i = &H77777:  GoSub Test
    i = &HBBBBB:  GoSub Test
    i = &H222222: GoSub Test
    i = &H444444: GoSub Test
    i = &H888888: GoSub Test
    i = &HAAAAAA: GoSub Test
    i = &HFFEEDD: GoSub Test

    For c = 4 To 100
        ReDim Preserve abSrc(0 To c)
        GoSub Encode
        
        If Len(sEncode) <> ((c + 3) \ 3) * 4 Then Stop: Exit Function
        
        sResult = Right$("AAA" & String(2 - (c * 4) Mod 3, 61), 3)
        If Right$(sEncode, 3) <> sResult Then Stop: Exit Function
    Next c

    IsGoodBase64Enc = True
    Exit Function

Test:
    For c = i To i + 1000
        
        abSrc(0) = c \ &H10000
        abSrc(1) = c \ &H100 And &HFF
        abSrc(2) = c And &HFF
        
        i = c
        For d = 0 To 3
            Mid$(sResult, 4 - d, 1) = Mid$(CHARSETBASE64, (i Mod 64) + 1, 1)
            i = i \ 64
        Next d
        
        GoSub Encode
        
        If sResult <> sEncode Then Stop: Exit Function
    Next c
    Return
Encode:
    ' replace "Base64Enc03" with the name of your function to test
    Select Case numArrays
    Case 0
      ' function takes one string
      sSrc = StrConv(abSrc(), vbUnicode)
      sEncode = Base64Enc01(sSrc)
    Case 1
      ' function takes one array
      sEncode = Base64Enc03(abSrc())
    Case 2
      ' function takes one array, returns one array
      Base64Enc04 abSrc(), abTrg()
      sEncode = StrConv(abTrg(), vbUnicode)
    End Select
    Return
End Function

Back to Base64Enc