急需VB下的BASE64编/解码源程序！

Question

大家都用VC的BASE64编/解码程序吗？

Answer 1

Option ExplicitPublic Function Base64Encode(Infile As String, Outfile As String)
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
        '°&Ntilde;&raquo;&Oslash;&sup3;&micro;·&ucirc;&ordm;&Iacute;&raquo;&raquo;&ETH;&ETH;·&ucirc;&Egrave;&yen;&micro;&ocirc;
            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
'&Egrave;&iexcl;&Ccedil;°&Aacute;ù&Icirc;&raquo;
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
'0&micro;&Auml;&Aacute;ù&Icirc;&raquo;&ordm;&Iacute;1&micro;&Auml;&Ccedil;°&Aacute;&frac12;&Icirc;&raquo;
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
'1&micro;&Auml;&ordm;ó&Euml;&Auml;&Icirc;&raquo;&ordm;&Iacute;2&micro;&Auml;&Ccedil;°&Euml;&Auml;&Icirc;&raquo;
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
'2&micro;&Auml;&ordm;ó&Aacute;&frac12;&Icirc;&raquo;&ordm;&Iacute;3&micro;&Auml;&Aacute;ù&Icirc;&raquo;
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