Private Sub Command1_Click()
    Call Base64转PNG图片(cao, App.Path & "\验证码.png")
End Sub
'-----------------------------------以上为窗体代码-----------------------------------
'-----------------------------------以下为模块代码-----------------------------------
Option Explicit
Public Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim m_token As Long

Function Base64Decode(strEncoded$) As Byte() '解码函数
    On Error Resume Next
    Dim arrB() As Byte, bTmp(3) As Byte, bT As Long, bRet() As Byte
    Dim i As Long, j As Long
    arrB = StrConv(strEncoded, vbFromUnicode)
    j = InStr(strEncoded & "=", "=") - 2
    ReDim bRet(j - j \ 4 - 1)
    For i = 0 To j Step 4
        Erase bTmp
        bTmp(0) = (InStr(cstBase64, Chr(arrB(i))) - 1) And 63
        bTmp(1) = (InStr(cstBase64, Chr(arrB(i + 1))) - 1) And 63
        bTmp(2) = (InStr(cstBase64, Chr(arrB(i + 2))) - 1) And 63
        bTmp(3) = (InStr(cstBase64, Chr(arrB(i + 3))) - 1) And 63
        bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
        bRet((i \ 4) * 3) = bT \ 65536
        bRet((i \ 4) * 3 + 1) = (bT And 65280) \ 256
        bRet((i \ 4) * 3 + 2) = bT And 255
    Next
    Base64Decode = bRet
End Function

Public Function Base64转PNG图片(ByVal Base64编码字符串 As String, ByVal PNG图片路径 As String)
    Open App.Path & "\base64.txt" For Output As #2
    Print #2, Base64编码字符串
    Close #2
    '———————————————————————导出编码字符串
    Dim tem$, Pic() As Byte
    Open App.Path & "\base64.txt" For Binary As #1 '以二进制打开Base64编码后的图片
    tem = StrConv(InputB(LOF(1), 1), vbUnicode)
    Close #1
    Pic = Base64Decode(tem)
    '———————————————————————导入编码字符串
    Open PNG图片路径 For Binary As #3
    Put #3, , Pic
    Close #3
    '———————————————————————输出PNG图片
End Function