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