base64编码 vba_如何在vba中编写实现base64编码的函数？

base64编码是将一个8位字节序列拆散为6位的片段，并为每个6位的片段分配一个字符。

6位字节序列转化为对应的10进制值，然后根据下表找到对应的字符。

由于二进制序列流有时不能正好平均分成6位的块，在这种情况下，就在二进制序列末尾填充位数，使二进制序列的长度成为24的倍数(6和8的最小公倍数)。对已填充的二进制串进行编码时，任何完全填充(不包含原始数据中的位)的6位组都由特殊的第65个符号“=”表示。如果6位组是部分填充的，就将填充位设置为0。

比如数据”a:aa”的填充二进制位为“011000 010011 101001 100001 011000 01xxxx xxxxxx xxxxxx”

其中01xxxx是部分填充的，把填充位都设置为0，也就是变成了010000，最后2个6位组是完全填充的，用符号”=”编码，从而得出”a:aa”的base64编码为YTphYQ==。

基于以上的原理分析，可以使用如下的函数对任意的字符串进行base64编码。

Visual Basic

Function Byte2Base64(arrByte() As Byte)

'定义一个存放3个8位字节的数组

Dim Bits8(1 To 3) As Byte

'顶一个一个存放4个6位字节的数组

Dim Bits6(1 To 4) As Byte

'Base64字符表

Const Base64Char As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

Dim arrBase64Char() As Byte

'把字符表转换为编码表

arrBase64Char = VBA.StrConv(Base64Char, vbFromUnicode)

' Dim arrByte() As Byte

' '要转换的字节序列

' arrByte = VBA.StrConv("上网", vbFromUnicode)

Dim bSize As Long

bSize = UBound(arrByte) + 1

For n = 1 To bSize Step 3

'lLen变量为实际转换的6位字节数组的个数

For i = 1 To 3

If i + n - 1 <= bSize Then

Bits8(i) = arrByte(i - 1 + n - 1)

lLen = 4

Else

'如果不够24的倍数，则填充0

Bits8(i) = 0

lLen = lLen - 1

End If

Next i

'将任意连续的3个8位字节序列转换为4个6位的字节序列

Bits6(1) = (Bits8(1) And &HFC) \ 4

Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10

Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40

Bits6(4) = Bits8(3) And &H3F

'通过Base64编码表把4个6位的字节序列转换为字符

For j = 1 To lLen

sEncoded = sEncoded & Chr(arrBase64Char(Bits6(j)))

Next

'根据lLen的值，判断尾部添加几个"="号。

Select Case lLen

Case 2

sEncoded = sEncoded & "=="

Case 3

sEncoded = sEncoded & "="

End Select

Debug.Print sEncoded

Next

Byte2Base64 = sEncoded

End Function

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

FunctionByte2Base64(arrByte()AsByte)

'定义一个存放3个8位字节的数组

DimBits8(1To3)AsByte

'顶一个一个存放4个6位字节的数组

DimBits6(1To4)AsByte

'Base64字符表

ConstBase64CharAsString="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

DimarrBase64Char()AsByte

'把字符表转换为编码表

arrBase64Char=VBA.StrConv(Base64Char,vbFromUnicode)

'    Dim arrByte() As Byte

'    '要转换的字节序列

'    arrByte = VBA.StrConv("上网", vbFromUnicode)

DimbSizeAsLong

bSize=UBound(arrByte)+1

Forn=1TobSizeStep3

'lLen变量为实际转换的6位字节数组的个数

Fori=1To3

Ifi+n-1<=bSizeThen

Bits8(i)=arrByte(i-1+n-1)

lLen=4

Else

'如果不够24的倍数，则填充0

Bits8(i)=0

lLen=lLen-1

EndIf

Nexti

'将任意连续的3个8位字节序列转换为4个6位的字节序列

Bits6(1)=(Bits8(1)And&HFC)\4

Bits6(2)=(Bits8(1)And&H3)*&H10+(Bits8(2)And&HF0)\&H10

Bits6(3)=(Bits8(2)And&HF)*4+(Bits8(3)And&HC0)\&H40

Bits6(4)=Bits8(3)And&H3F

'通过Base64编码表把4个6位的字节序列转换为字符

Forj=1TolLen

sEncoded=sEncoded&Chr(arrBase64Char(Bits6(j)))

Next

'根据lLen的值，判断尾部添加几个"="号。

SelectCaselLen

Case2

sEncoded=sEncoded&"=="

Case3

sEncoded=sEncoded&"="

EndSelect

Debug.PrintsEncoded

Next

Byte2Base64=sEncoded

EndFunction

如果是一般的非中文字符，我们可以使用如下的代码进行Base64编码：

Visual Basic

Sub QQ1722187970()

Dim str1 As String

str1 = "asd"

Debug.Print Byte2Base64(VBA.StrConv(str1, vbFromUnicode))

End Sub

1

2

3

4

5

SubQQ1722187970()

Dimstr1AsString

str1="asd"

Debug.PrintByte2Base64(VBA.StrConv(str1,vbFromUnicode))

EndSub

当涉及中文字符时，用以上的代码进行编码获得的是gb2312的Base64编码，由于网站经常使用的是utf-8，为此还需要通过以下的代码把unicode字符转换为utf-8编码，以免出现乱码。

Visual Basic

Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, _

ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _

ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, _

ByVal lpUsedDefaultChar As Long) As Long

Public Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, _

ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _

ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Public Const CP_UTF8 = 65001

Public Const CP_ACP = 0

Sub QQ1722187970()

'unicode 转 utf-8

'定义要转换的字符串变量

Dim str1 As String

str1 = "我和你"

'定义一个变量存储接收实际转换后的字符的字节数

Dim bByte As Long

'先调用WideCharToMultiByte函数获取缓冲区字节数

bByte = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str1), Len(str1), 0, 0, 0, 0)

Debug.Print bByte

'定义一个字节数组变量存储转换后的字符字节

Dim arr() As Byte

ReDim arr(bByte - 1)

'再次调用WideCharToMultiByte函数填充字节到arr数组中

WideCharToMultiByte CP_UTF8, 0, StrPtr(str1), Len(str1), VarPtr(arr(0)), bByte, 0, 0

Debug.Print Byte2Base64(arr)

' '遍历字节验证16进制值,可以将字符输入文本文件另存为UTF-8，用二进制查看器打开验证对比

' For k = 0 To UBound(arr)

' Debug.Print VBA.Hex(arr(k))

' Next k

End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

PublicDeclareFunctionWideCharToMultiByteLib"kernel32"(ByValCodePageAsLong,_

ByValdwFlagsAsLong,ByVallpWideCharStrAsLong,ByValcchWideCharAsLong,_

ByVallpMultiByteStrAsLong,ByValcchMultiByteAsLong,ByVallpDefaultCharAsLong,_

ByVallpUsedDefaultCharAsLong)AsLong

PublicDeclareFunctionMultiByteToWideCharLib"kernel32.dll"(ByValCodePageAsLong,_

ByValdwFlagsAsLong,ByVallpMultiByteStrAsLong,ByValcchMultiByteAsLong,_

ByVallpWideCharStrAsLong,ByValcchWideCharAsLong)AsLong

PublicConstCP_UTF8=65001

PublicConstCP_ACP=0

SubQQ1722187970()

'unicode 转 utf-8

'定义要转换的字符串变量

Dimstr1AsString

str1="我和你"

'定义一个变量存储接收实际转换后的字符的字节数

DimbByteAsLong

'先调用WideCharToMultiByte函数获取缓冲区字节数

bByte=WideCharToMultiByte(CP_UTF8,0,StrPtr(str1),Len(str1),0,0,0,0)

Debug.PrintbByte

'定义一个字节数组变量存储转换后的字符字节

Dimarr()AsByte

ReDimarr(bByte-1)

'再次调用WideCharToMultiByte函数填充字节到arr数组中

WideCharToMultiByteCP_UTF8,0,StrPtr(str1),Len(str1),VarPtr(arr(0)),bByte,0,0

Debug.PrintByte2Base64(arr)

'   '遍历字节验证16进制值,可以将字符输入文本文件另存为UTF-8，用二进制查看器打开验证对比

'   For k = 0 To UBound(arr)

'       Debug.Print VBA.Hex(arr(k))

'   Next k

EndSub