'//! Module Name:mduBase64.bas
'//! Intro:Base64 Encode/Decode

Option Explicit

Private Const BASE64STR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Private Const ERROR_USER As Integer = 531

Public Function EncodeBase64(ByVal strSrc As String) As String
On Error GoTo errHandler

Dim bytSrc() As Byte
Dim bytTmp() As Byte
Dim strDes   As String
Dim i        As Integer
Dim j        As Integer
Dim n        As Integer
Dim l        As Integer

bytSrc = StrConv(strSrc, vbFromUnicode)
n = UBound(bytSrc) + 1
l = n Mod 3
n = n - l - 1

ReDim bytTmp(3) As Byte

For i = 0 To n Step 3
    bytTmp(0) = (bytSrc(i) And &HFC) \ &H4
    bytTmp(1) = (bytSrc(i) And &H3) * &H10 + (bytSrc(i + 1) And &HF0) \ &H10
    bytTmp(2) = (bytSrc(i + 1) And &HF) * &H4 + (bytSrc(i + 2) And &HC0) \ &H40
    bytTmp(3) = bytSrc(i + 2) And &H3F
    
    For j = 0 To 3
        strDes = strDes & Mid$(BASE64STR, bytTmp(j) + 1, 1)
    Next
Next

Select Case l
    Case 1
        bytTmp(0) = (bytSrc(n + 1) And &HFC) \ &H4
        bytTmp(1) = (bytSrc(n + 1) And &H3) * &H10
        bytTmp(2) = 64
        bytTmp(3) = 64
        For i = 0 To 1
            strDes = strDes & Mid$(BASE64STR, bytTmp(i) + 1, 1)
        Next
        strDes = strDes & "=="
    Case 2
        bytTmp(0) = (bytSrc(n + 1) And &HFC) \ &H4
        bytTmp(1) = (bytSrc(n + 1) And &H3) * &H10 + (bytSrc(n + 2) And &HF0) \ &H10
        bytTmp(2) = (bytSrc(n + 2) And &HF) * &H4
        bytTmp(3) = 64
        For i = 0 To 2
            strDes = strDes & Mid$(BASE64STR, bytTmp(i) + 1, 1)
        Next
        strDes = strDes & "="
    Case Else
End Select

EncodeBase64 = strDes
Exit Function
errHandler:
    Debug.Print Err.Description
    #If DEBUG_MODE Then
        Stop: Resume
    #End If
    EncodeBase64 = ""
End Function

Public Function DecodeBase64(ByVal strSrc As String) As String
On Error GoTo errHandler

Dim bytTmp() As Byte
Dim bytDes() As Byte
Dim strDes   As String
Dim i        As Integer
Dim j        As Integer
Dim n        As Integer
Dim iPos     As Integer
Dim iLen     As Integer
Dim iFrom    As Integer
Dim iTo      As Integer

n = Len(strSrc)
iFrom = 0
iTo = 0
ReDim typdes(iTo) As Byte

ReDim bytTmp(3) As Byte
For i = 1 To n Step 4
    iLen = 4
    For j = 0 To 3
        iPos = InStr(1, BASE64STR, Mid$(strSrc, i + j, 1))
        Select Case iPos
            Case 1 To 64
                bytTmp(j) = iPos - 1
            Case 65
                iLen = j
                Exit For
            Case Else
                Err.Raise ERROR_USER, , "包含非法字符"
        End Select
    Next
    
    bytTmp(0) = bytTmp(0) * &H4 + (bytTmp(1) And &H30) \ &H10
    bytTmp(1) = (bytTmp(1) And &HF) * &H10 + (bytTmp(2) And &H3C) \ &H4
    bytTmp(2) = (bytTmp(2) And &H3) * &H40 + bytTmp(3)
    
    iFrom = iTo
    iTo = iTo + (iLen - 1) - 1
    ReDim Preserve bytDes(iTo) As Byte
    For j = iFrom To iTo
        bytDes(j) = bytTmp(j - iFrom)
    Next
    
    iTo = iTo + 1
Next

strDes = StrConv(bytDes(), vbUnicode)
DecodeBase64 = strDes
Exit Function
errHandler:
    Debug.Print Err.Description
    #If DEBUG_MODE Then
        Stop: Resume
    #End If
    DecodeBase64 = ""
End Function

[ 本帖最后由 jiashie 于 2010-5-20 11:42 编辑 ]

收到的鲜花

• Artless 于 2010-05-19 23:57 送鲜花  5朵   附言：好文章

支持
文件呢？

在此基础上可以自己再扩展几个不同参数的函数，如Public Function EncodeBase64(ByRef bytSrc As Byte()) As Byte()
编码时，其实也是对byte()进行的
bytSrc = StrConv(strSrc, vbFromUnicode)
对于文件，可以用文件读写Get 到一个byte()，代码稍加修改即可。

[ 本帖最后由 jiashie 于 2010-5-20 08:41 编辑 ]

这个实用..顶了.

好牛逼啊

有没有问题