' 用如下方法使用:
' Dim b as Base64
' b = New Base64
' Debug.Print b.Encode("This is a test.") ' Prints "VGhpcyBpcyBhIHRlc3Qu"
' Debug.Print b.Decode("VGhpcyBpcyBhIHRlc3Qu") ' Prints "This is a test."
'建立一個類模塊，然後輸入這段代碼
Private Const MAX_LINELENGTH As Long = 76 ' Must be a multiple of 4
Private Const CHAR_EQUAL As Byte = 61
Private Const CHAR_CR As Byte = 13
Private Const CHAR_LF As Byte = 10
Private m_Index1(0 To 255) As Byte
Private m_Index2(0 To 255) As Byte
Private m_Index3(0 To 255) As Byte
Private m_Index4(0 To 63) As Byte
Private m_ReverseIndex1(0 To 255) As Byte
Private m_ReverseIndex2(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex3(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex4(0 To 255) As Byte
' Encode a string to a string.
Public Function Encode(sInput As String) As String
Dim bTemp() As Byte
'Convert to a byte array then convert.
'This is faster the repetitive calls to asc() or chr$()
bTemp = StrConv(sInput, vbFromUnicode)
Encode = StrConv(EncodeArr(bTemp), vbUnicode)
End Function
'Decode a string to a string.
Public Function Decode(sInput As String) As String
Dim bTemp() As Byte
'Convert to a byte array then convert.
'This is faster the repetitive calls to asc() or chr$()
bTemp = StrConv(sInput, vbFromUnicode)
Decode = StrConv(DecodeArr(bTemp), vbUnicode)
End Function
Public Sub DecodeToFile(sInput As String, sOutputFile As String)
Dim bTemp() As Byte
Dim fh As Long
fh = FreeFile(0)
Open sOutputFile For Binary Access Write As fh
Put fh, , bTemp
Close fh
End Sub
Public Sub DecodeFile(sInputFile As String, sOutputFile As String)
Dim bTemp() As Byte
Dim fh As Long
fh = FreeFile(0)
Open sInputFile For Binary Access Read As fh
ReDim bTemp(0 To LOF(fh) - 1)
Get fh, , bTemp
Close fh
bTemp = DecodeArr(bTemp)
Open sOutputFile For Binary Access Write As fh
Put fh, , bTemp
Close fh
End Sub
Public Function EncodeFromFile(sFileName As String) As String
Dim bTemp() As Byte
Dim fh As Long
fh = FreeFile(0)
Open sFileName For Binary Access Read As fh
ReDim bTemp(0 To LOF(fh) - 1)
Get fh, , bTemp
Close fh
EncodeFromFile = StrConv(EncodeArr(bTemp), vbUnicode)
End Function
Public Sub EncodeFile(sInputFile As String, sOutputFile As String)
Dim bTemp() As Byte
Dim fh As Long
fh = FreeFile(0)
Open sInputFile For Binary Access Read As fh
ReDim bTemp(0 To LOF(fh) - 1)
Get fh, , bTemp
Close fh
bTemp = EncodeArr(bTemp)
Open sOutputFile For Binary Access Write As fh
Put fh, , bTemp
Close fh
End Sub
Private Function EncodeArr(bInput() As Byte) As Byte()
Dim bOutput() As Byte
Dim k As Long
Dim l As Long
Dim i As Long
Dim evenBound As Long
Dim CurrentOut As Long
Dim b As Byte
Dim c As Byte
Dim d As Byte
Dim linelength As Long
k = LBound(bInput)
l = UBound(bInput)
'Calculate the input size
i = l - k + 1
'Calculate the output size
Select Case i Mod 3
Case 0:
i = (i \ 3) * 4
evenBound = l
Case 1:
i = ((i \ 3) * 4) + 4
evenBound = l - 1
Case 2:
i = ((i \ 3) * 4) + 4
evenBound = l - 2
Case 3:
i = ((i \ 3) * 4) + 4
evenBound = l - 3
End Select
'Add in the line feeds.
If i Mod MAX_LINELENGTH = 0 Then
i = i + (i \ MAX_LINELENGTH) * 2 - 2
Else
i = i + (i \ MAX_LINELENGTH) * 2
End If<B作者: haxoo 时间: 2006-7-8 23:46
[em02]作者: jweng 时间: 2006-7-13 17:46
晕作者: 台灯 时间: 2009-7-11 13:40
很晕作者: chaojianan 时间: 2009-10-19 20:37
有无实例分享。作者: LeeTien 时间: 2010-4-12 21:46
没功能介绍啊