Private Function Base64_Encode(strSource) As String
'
Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'
Dim strTempLine As String
Dim j As Integer
'
For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'
'1 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'2 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
'3 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
'4 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
Next j
'
If Not (Len(strSource) Mod 3) = 0 Then
'
If (Len(strSource) Mod 3) = 2 Then
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
'
strTempLine = strTempLine & "="
'
ElseIf (Len(strSource) Mod 3) = 1 Then
'
'
strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
'
strTempLine = strTempLine & "=="
'
End If
'
End If
'
Base64_Encode = strTempLine
'
End Function
'
Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'
Dim strTempLine As String
Dim j As Integer
'
For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'
'1 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'2 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
'3 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
'4 byte
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
Next j
'
If Not (Len(strSource) Mod 3) = 0 Then
'
If (Len(strSource) Mod 3) = 2 Then
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
'
strTempLine = strTempLine & "="
'
ElseIf (Len(strSource) Mod 3) = 1 Then
'
'
strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
'
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
'
strTempLine = strTempLine & "=="
'
End If
'
End If
'
Base64_Encode = strTempLine
'
End Function
Dim FnumIn As Integer, FnumOut As Integer
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim i As Integer, LineLen As Integer, j As Integer
FnumIn = FreeFile()
Open Infile For Binary As #FnumIn
FnumOut = FreeFile()
Open Outfile For Binary As #FnumOut
While Not EOF(FnumIn)
i = 0
Do While i < 3
Get #FnumIn, , myByte
If Not EOF(FnumIn) Then
mInByte(i) = myByte
i = i + 1
Else
Exit Do
End If
Loop
Base64EncodeByte mInByte, mOutByte, i
For j = 0 To 3
Put #FnumOut, , mOutByte(j)
Next j
LineLen = LineLen + 1
If LineLen * 4 > 70 Then
Put #FnumOut, , vbCrLf
LineLen = 0
End If
Wend
Close (FnumOut)
Close (FnumIn)
End FunctionPrivate Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim i As IntegerIf Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End IftByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByteFor i = 0 To 3
If mOutByte(i) >= 0 And mOutByte(i) <= 25 Then
mOutByte(i) = mOutByte(i) + Asc("A")
ElseIf mOutByte(i) >= 26 And mOutByte(i) <= 51 Then
mOutByte(i) = mOutByte(i) - 26 + Asc("a")
ElseIf mOutByte(i) >= 52 And mOutByte(i) <= 61 Then
mOutByte(i) = mOutByte(i) - 52 + Asc("0")
ElseIf mOutByte(i) = 62 Then
mOutByte(i) = Asc("+")
Else
mOutByte(i) = Asc("/")
End If
Next iIf Num = 1 Then
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub
Public Function Base64Decode(Infile As String, Outfile As String)
Dim FnumIn As Integer, FnumOut As Integer
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim myByte As Byte
Dim i As Integer, LineLen As Integer, j As Integer
Dim ByteNum As Integer
FnumIn = FreeFile()
Open Infile For Binary As #FnumIn
FnumOut = FreeFile()
Open Outfile For Binary As #FnumOutWhile Not EOF(FnumIn)
i = 0
Do While i < 4
Get #FnumIn, , myByte
If Not EOF(FnumIn) Then
If myByte <> &HA And myByte <> &HD Then
'°Ñ»Ø³µ·ûºÍ»»ÐзûÈ¥µô
mInByte(i) = myByte
i = i + 1
End If
Else
Exit Do
End If
Loop
Base64DecodeByte mInByte, mOutByte, ByteNum
For j = 0 To 2 - ByteNum
Put #FnumOut, , mOutByte(j)
Next j
'LineLen = LineLen + 1
Wend
Close (FnumOut)
Close (FnumIn)
End FunctionPrivate Sub Base64DecodeByte(mInByte() As Byte, mOutByte() As Byte, ByteNum As Integer)
Dim tByte As Byte
Dim i As Integer
ByteNum = 0
For i = 0 To 3
If mInByte(i) >= Asc("A") And mInByte(i) <= Asc("Z") Then
mInByte(i) = mInByte(i) - Asc("A")
ElseIf mInByte(i) >= Asc("a") And mInByte(i) <= Asc("z") Then
mInByte(i) = mInByte(i) - Asc("a") + 26
ElseIf mInByte(i) >= Asc("0") And mInByte(i) <= Asc("9") Then
mInByte(i) = mInByte(i) - Asc("0") + 52
ElseIf mInByte(i) = Asc("+") Then
mInByte(i) = 62
ElseIf mInByte(i) = Asc("/") Then
mInByte(i) = 63
Else '"="
ByteNum = ByteNum + 1
mInByte(i) = 0
End If
Next i
'È¡Ç°Áùλ
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
'0µÄÁùλºÍ1µÄÇ°Á½Î»
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
'1µÄºóËÄλºÍ2µÄÇ°ËÄλ
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
'2µÄºóÁ½Î»ºÍ3µÄÁùλ
End SubPrivate Sub cmdBase64_Click(Index As Integer)
If Index = 0 Then
Call Base64Encode(App.Path & "\in2.txt", App.Path & "\out.txt")
Else
Call Base64Decode(App.Path & "\out.txt", App.Path & "\in3.txt")
End If
End Sub