请高手帮助修改一下以下代码，以提高代码的运行速度，谢谢！！！

Question

请高手帮助修改一下以下代码，以提高代码的运行速度，谢谢！！！
一个85k的文件运行了30几秒
窗体:
Private Sub Command4_Click()
Dim aaa As String
Label1.Caption = Now
Call Base64Encode1(App.Path & "\bfyx.rar", aaa)
Text1 = aaa
Label2.Caption = Now
End Sub
模块:
Public Function Base64Encode1(infile As String, Outfile As String)
Dim FnumIn 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
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
    Outfile = Outfile + Chr(mOutByte(j))
    Next j
    LineLen = LineLen + 1
    If LineLen * 4 > 70 Then
    Outfile = Outfile & vbCrLf
        LineLen = 0
    End If
Wend
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

Answer 1

看了一遍，对于运行速度搞不太清楚，Command4_Click->函数（3嵌套循环+判断->函数（））
从具体看感觉确实有提高的余地，因为尽管是3套循环，但是循环圈数不多。来帮你顶，看不出哪能简化

Answer 2

又看了看，本人不熟悉BASE64有关方面的东东。

Answer 3

看不懂，不过你可以先把循环中的Base64EncodeByte函数调用注掉，看看速度。
好确定优化范围。

Answer 4

Outfile = Outfile + Chr(mOutByte(j))
'字符串的连接比较大时 最好先写到临时文件中然后再一次读出来
这里估计需要消耗10秒(85K时) 改改看

Answer 5

同意楼上Public Function Base64Encode1(infile As String, Outfile As String)
Dim FnumIn 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,TempCount as integer
dim strTemp as string
FnumIn = FreeFile()
strTemp=""
Open infile For Binary As #FnumIn
tempCount=1
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
    strTemp = strTemp + Chr(mOutByte(j))
    Next j
    LineLen = LineLen + 1
    If LineLen * 4 > 70 Then
    strTemp = strTemp & vbCrLf
        LineLen = 0
    End If
    tempcount=tempcount+1
    if(tempcount>1000) then
        OutFile=OutFile & strTemp
        strTemp=""
        Tempcount=1   
    end if
Wend
   OutFile=OutFIle & StrTemp
Close (FnumIn)

Answer 6

除此以外，将/改为
另外，asc("*")可以保存到临时变量中Base64编码其实不用以文本方式读取的，以Binary读写，这样就不存在string的问题了，快得多For j = 0 To 3
  Outfile = Outfile + Chr(mOutByte(j))
Next j
也可以这样处理在While循环外Outfile=string(4,0)
将以上的For循环改为一句：
CopyMemory ByVal StrPtr(Outfile), ByVal VarPtr(mOutByte(0)),4

Answer 7

谢谢个位的帮助，谢谢！！！
KiteGirl(小仙妹)：
请您帮助把您的代码给我好吗，谢谢！！！

Answer 8

我的代码编码一个200K左右的文件在我家最慢的机器上只需要2.6秒左右(CR433 CPU)。但遗憾的是：我的代码不是编码Base64的，而是编码我自己设计的KT64编码。KT64和Base64的区别在于：1、Bit的排列顺序刚好是反的。
2、KT64通过额外的头信息表示文件长度，而不是用=号填充。
（后面我会告诉你如何将程序改为Base64）下面是我的代码全部内容，是我一组关于Bit的函数，内容非常多。之所以速度快，是因为使用了一种特别“缺德”的的算法（称为“缺德”一点不过分……）ByteBits模块内容：（对于一个Byte的8个Bit进行操作的系列函数）Public Function BitGetByBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Byte
  Dim tOutByte As Byte
  
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BytesIndexGetByBitIndex(pBitIndex, pBitCount)
  tByteBitIndex = ByteBitIndexGetByBitIndex(pBitIndex, pBitCount)
  tOutByte = BitGetByByte(pBytes(tByteIndex), tByteBitIndex)  BitGetByBytes = tOutByte
End FunctionPublic Sub BitPutToBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, ByVal pBitValue As Byte, Optional ByVal pBitCount As Byte = 8)
    
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BytesIndexGetByBitIndex(pBitIndex, pBitCount)
  tByteBitIndex = ByteBitIndexGetByBitIndex(pBitIndex, pBitCount)
  pBytes(tByteIndex) = BitPutToByte(pBytes(tByteIndex), tByteBitIndex, pBitValue)
  
End SubPublic Function ByteBitIndexGetByBitIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long
  
  tOutIndex = pBitIndex Mod pBitCount
  'tOutIndex = pBitCount - (pBitIndex Mod pBitCount) - 1
  
  ByteBitIndexGetByBitIndex = tOutIndex
End Function
Public Function BytesIndexGetByBitIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long  tOutIndex = (pBitIndex \ pBitCount)  BytesIndexGetByBitIndex = tOutIndex
End FunctionPublic Function BytesCount(ByRef pBytes() As Byte) As Long
  Dim tOutCount As Long
  
  Err.Clear
  On Error Resume Next
  
  Dim tBoundUpper As Long
  Dim tBoundLower As Long
  
  tBoundUpper = UBound(pBytes())
  tBoundLower = LBound(pBytes())
  
  Dim tLengthTest As Long
  Dim tLengthOverMax As Boolean
  
  tLengthTest = (tBoundUpper \ 2) + (tBoundLower \ 2)
  tLengthOverMax = tLengthTest > &H3FFFFFFF
  
  If tLengthOverMax Then
      tOutCount = &H7FFFFFFF
    Else
      tOutCount = (tBoundUpper - tBoundLower) + 1
  End If
  
  BytesCount = tOutCount
End Function

Answer 9

下面是modBits模块的内容（对一组Byte的任意一位进行操作）（格外注意这个叫做ByteBitIndexGetByBitIndex的函数：）
Public Function ByteBitIndexGetByBitIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long
  
  tOutIndex = pBitIndex Mod pBitCount
  'tOutIndex = pBitCount - (pBitIndex Mod pBitCount) - 1 '（将此行代替上一行可能实现Base64，初步实验是这样。但=号需要你自己添加。）
  
  ByteBitIndexGetByBitIndex = tOutIndex
End FunctionPublic Function BitGetByBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Byte
  Dim tOutByte As Byte
  
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BytesIndexGetByBitIndex(pBitIndex, pBitCount)
  tByteBitIndex = ByteBitIndexGetByBitIndex(pBitIndex, pBitCount)
  tOutByte = BitGetByByte(pBytes(tByteIndex), tByteBitIndex)  BitGetByBytes = tOutByte
End FunctionPublic Sub BitPutToBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, ByVal pBitValue As Byte, Optional ByVal pBitCount As Byte = 8)
    
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BytesIndexGetByBitIndex(pBitIndex, pBitCount)
  tByteBitIndex = ByteBitIndexGetByBitIndex(pBitIndex, pBitCount)
  pBytes(tByteIndex) = BitPutToByte(pBytes(tByteIndex), tByteBitIndex, pBitValue)
  
End Sub
Public Function BytesIndexGetByBitIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long  tOutIndex = (pBitIndex \ pBitCount)  BytesIndexGetByBitIndex = tOutIndex
End FunctionPublic Function BytesCount(ByRef pBytes() As Byte) As Long
  Dim tOutCount As Long
  
  Err.Clear
  On Error Resume Next
  
  Dim tBoundUpper As Long
  Dim tBoundLower As Long
  
  tBoundUpper = UBound(pBytes())
  tBoundLower = LBound(pBytes())
  
  Dim tLengthTest As Long
  Dim tLengthOverMax As Boolean
  
  tLengthTest = (tBoundUpper \ 2) + (tBoundLower \ 2)
  tLengthOverMax = tLengthTest > &H3FFFFFFF
  
  If tLengthOverMax Then
      tOutCount = &H7FFFFFFF
    Else
      tOutCount = (tBoundUpper - tBoundLower) + 1
  End If
  
  BytesCount = tOutCount
End Function

Answer 10

KT64编码模块内容：（过程和Base64非常相似（除了上述区别），按照我上面的说明改进那个函数，就是Base64，然后你再自己添加=号。）Private priCodeTable_Encode() As Byte
Private priCodeTable_UnEncode() As BytePublic Const conKT64CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"Public Function KT64Encode(ByRef pBytes() As Byte) As String
  Dim tOutStr As String
  Dim tTrueCodes() As Byte
  tTrueCodes() = KT64TrueCodesGetByBytes(pBytes())
  tOutStr = KT64StringGetByTrueCodes(tTrueCodes())
  KT64Encode = tOutStr
End FunctionPublic Sub KT64SetCodeTable(ByVal pString As String)
  Dim tBytes() As Byte
  
  tBytes() = pString
  
  Dim tIndex As Byte
  
  ReDim priCodeTable_Encode(0 To 255)
  ReDim priCodeTable_UnEncode(0 To 255)
  
  Dim tTableIndex As Byte
  
  For tIndex = 0 To 127 Step 2
    tTableIndex = tIndex \ 2
    priCodeTable_Encode(tTableIndex) = tBytes(tIndex)
    priCodeTable_UnEncode(tBytes(tIndex)) = tTableIndex
  Next
  
End SubPrivate Function KT64StringGetByTrueCodes(ByRef pBytes() As Byte, Optional ByVal pCodeTable = conKT64CodeTableStrng) As String
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = BytesCount(pBytes())
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  KT64SetCodeTable pCodeTable
  
  Dim tOutString As String  Dim tIndex As Long
  Dim tSurBytes_Index As Long
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  tOutBytes_Length = tSurBytes_Count * 2 - 1
  ReDim tOutBytes(tOutBytes_Length)
  
  For tIndex = 0 To tOutBytes_Length Step 2
    tSurBytes_Index = tIndex \ 2
    tOutBytes(tIndex) = priCodeTable_Encode(pBytes(tSurBytes_Index))
  Next
  
  tOutString = tOutBytes()
  
  KT64StringGetByTrueCodes = tOutString
End FunctionPrivate Function KT64TrueCodesGetByBytes(ByRef pBytes() As Byte) As Byte()
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = BytesCount(pBytes())
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  Dim tOutBytes() As Byte
  Dim tBits_Length As Long
  Dim tOutBytes_Length As Long
  
  tBits_Length = tSurBytes_Count * 8 - 1
  tOutBytes_Length = BytesIndexGetByBitIndex(tBits_Length, 6)
  
  ReDim tOutBytes(tOutBytes_Length)
  
  Dim tIndex As Long
  Dim tBitValue As Byte
  
  For tIndex = 0 To tBits_Length
    tBitValue = BitGetByBytes(pBytes(), tIndex, 8)
    BitPutToBytes tOutBytes(), tIndex, tBitValue, 6
  Next
  
  KT64TrueCodesGetByBytes = tOutBytes()
End Function

Answer 11

谢谢KiteGirl(小仙妹)：谢谢！！！
我用foxmail加入了一个15兆的附件，保存邮件，发现就用了大概5秒左右，还请高手集训帮助，谢谢！！！

Answer 12

上面发错了，这个才是关键部分：操作Byte的8个Bit之一。Option Explicit'BitGetByByte函数
'BitPutToByte函数Private pubByteBits_BytePutTable() As Byte
Private pubByteBits_BytePutTable_Create As Boolean
Private pubByteBits_BytePutTable_CellReadys() As BooleanPrivate pubByteBits_ByteGetTable() As Byte
Private pubByteBits_ByteGetTable_Create As Boolean
Private pubByteBits_ByteGetTable_CellReadys() As BooleanPrivate pubByteBits_UnConCodeTable() As Byte
Private pubByteBits_UnConCodeTable_Create As Boolean
Private pubByteBits_UnConCodeTable_CellReadys() As BooleanPrivate pubByteBits_ConCodeTable() As Byte
Private pubByteBits_ConCodeTable_Create As Boolean
Private pubByteBits_ConCodeTable_CellReadys() As BooleanPublic Function BitGetByByte(ByVal pByte As Byte, ByVal pBitIndex As Byte) As Byte
  'BitGetByByte函数
  '语法：[tOutByte] = BitGetByByte(pByte ,pBitIndex, pBitValue)
  '功能：读取字节指定位的一个Bit值，并返回该值。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。读取Bit位
  '返回：byte       tOutByte            '读取的Bit位数值
  
  Dim tOutByte As Byte
  
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_ByteGetTable_Create Then
  
    Dim tBytesLength As Byte
    Dim tBitsIndexLength As Byte
    
    tBytesLength = 255
    tBitsIndexLength = 7
    
    ReDim pubByteBits_ByteGetTable(tBytesLength, tBitsIndexLength)
    ReDim pubByteBits_ByteGetTable_CellReadys(tBytesLength, tBitsIndexLength)
    
    pubByteBits_ByteGetTable_Create = True
  
  End If
  
  If Not pubByteBits_ByteGetTable_CellReadys(pByte, tBitIndex) Then
      
    pubByteBits_ByteGetTable(pByte, tBitIndex) = BitGetByByte_Operation(pByte, tBitIndex) And 1
    pubByteBits_ByteGetTable_CellReadys(pByte, tBitIndex) = True
    
  End If
  
  tOutByte = pubByteBits_ByteGetTable(pByte, tBitIndex)
  
  BitGetByByte = tOutByte
End FunctionPublic Function BitPutToByte(ByVal pByte As Byte, ByVal pBitIndex As Byte, ByVal pBitValue As Byte) As Byte
  'BitPutToByte函数
  '语法：[tOutByte] = BitPutToByte(pByte ,pBitIndex, pBitValue)
  '功能：将一个Bit值写入一个字节的指定位，并返回该字节。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。写入Bit位
  '      boolean    pBitValue           '必要参数。写入Bit值
  '返回：byte       tOutByte            '写入Bit位后的新字节。  Dim tOutByte As Byte
    
  Dim tBitIndex As Byte
  Dim tBitValue As Byte
  
  tBitIndex = pBitIndex Mod 8
  tBitValue = CBool(pBitValue) And 1
    
  If Not pubByteBits_BytePutTable_Create Then
    
    Dim tBytesLength As Byte
    Dim tBitsIndexLength As Byte
    Dim tBitsValueLength As Byte
    
    tBytesLength = 255
    tBitsIndexLength = 7
    tBitsValueLength = 1
    
    ReDim pubByteBits_BytePutTable(tBytesLength, tBitsIndexLength, tBitsValueLength)
    ReDim pubByteBits_BytePutTable_CellReadys(tBytesLength, tBitsIndexLength, tBitsValueLength)
    
    pubByteBits_BytePutTable_Create = True
    
  End If  If Not pubByteBits_BytePutTable_CellReadys(pByte, tBitIndex, tBitValue) Then
            
    pubByteBits_BytePutTable(pByte, tBitIndex, tBitValue) = BitPutToByte_Operation(pByte, tBitIndex, tBitValue)
    pubByteBits_BytePutTable_CellReadys(pByte, tBitIndex, tBitValue) = True
    
  End If
    
  tOutByte = pubByteBits_BytePutTable(pByte, tBitIndex, tBitValue)
  
  BitPutToByte = tOutByte
End FunctionPrivate Function BitGetByByte_Operation(ByVal pByte As Byte, ByVal pBitIndex As Byte) As Boolean
  'BitGetByByte_Operation函数
  '语法：[tOutByte] = BitGetByByte_Operation(pByte ,pBitIndex, pBitValue)
  '功能：以算术方法读取字节指定位的一个Bit值，并返回该值。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。读取Bit位
  '返回：byte       tOutByte            '读取的Bit位数值  Dim tOutByte As Byte
  
  tOutByte = CBool(pByte And BitPutToByte_ConCodeGet(pBitIndex))
  
  BitGetByByte_Operation = tOutByte
End FunctionPrivate Function BitPutToByte_Operation(ByVal pByte As Byte, ByVal pBitIndex As Byte, ByVal pBitValue As Boolean) As Byte
  'BitPutToByte_Operation函数
  '语法：[tOutByte] = BitPutToByte_Operation(pByte ,pBitIndex, pBitValue)
  '功能：以算术方法将一个Bit值写入一个字节的指定位，并返回该字节。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。写入Bit位
  '      boolean    pBitValue           '必要参数。写入Bit值
  '返回：byte       tOutByte            '写入Bit位后的新字节。
  
  Dim tOutByte As Byte
  
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  Dim tUnConCode As Byte
  
  tUnConCode = BitPutToByte_UnConCodeGet(pBitIndex)
  
  Dim tConCode As Byte
  
  tConCode = pBitValue And BitPutToByte_ConCodeGet(pBitIndex)
  
  tOutByte = (tUnConCode And pByte) + tConCode
  
  BitPutToByte_Operation = tOutByte
End FunctionPrivate Function BitPutToByte_UnConCodeGet(ByVal pBitIndex As Byte) As Byte
  'BitPutToByte_UnConCodeGet函数
  '语法：[tOutByte] = BitPutToByte_UnConCodeGet(pBitIndex)
  '功能：获得一个Bit位对应的反掩码。
  '参数：byte   pBitIndex               '必要参数，Bit位索引。取值范围 0 - 7 ，如大于7，则取余数。
  '返回：byte   tOutByte                'Byte位对应的反掩码。对应关系如下：
  '                                     '0 - &HFE 11111110
  '                                     '1 - &HFD 11111101
  '                                     '2 - &HFB 11111011
  '                                     '3 - &HF7 11110111
  '                                     '4 - &HEF 11101111
  '                                     '5 - &HBF 11011111
  '                                     '6 - &HDF 10111111
  '                                     '7 - &H7F 01111111
  
  Dim tOutCode As Byte
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_UnConCodeTable_Create Then
    
    Dim tBitsLength As Byte
    
    tBitsLength = 7
    
    ReDim pubByteBits_UnConCodeTable(tBitsLength)
    ReDim pubByteBits_UnConCodeTable_CellReadys(tBitsLength)
    
    pubByteBits_UnConCodeTable_Create = True
    
  End If
    
  If Not pubByteBits_UnConCodeTable_CellReadys(tBitIndex) Then
  
    pubByteBits_UnConCodeTable(tBitIndex) = Not BitPutToByte_ConCodeGet(tBitIndex)
    pubByteBits_UnConCodeTable_CellReadys(tBitIndex) = True
      
  End If
  
  tOutCode = pubByteBits_UnConCodeTable(pBitIndex)
  
  BitPutToByte_UnConCodeGet = tOutCode
End Function

Answer 13

还有一点：Private Function BitPutToByte_ConCodeGet(ByVal pBitIndex As Byte) As Byte
  'BitPutToByte_ConCodeGet函数
  '语法：[tOutByte] = BitPutToByte_ConCodeGet(pBitIndex)
  '功能：获得一个Bit位对应的正掩码。
  '参数：byte   pBitIndex               '必要参数，Bit位索引。取值范围 0 - 7 ，如大于7，则取余数。
  '返回：byte   tOutByte                'Byte位对应的正掩码。对应关系如下：
  '                                     '0 - &H01 00000001
  '                                     '1 - &H02 00000010
  '                                     '2 - &H04 00000100
  '                                     '3 - &H08 00001000
  '                                     '4 - &H10 00010000
  '                                     '5 - &H20 00100000
  '                                     '6 - &H40 01000000
  '                                     '7 - &H80 10000000
  
  Dim tOutCode As Byte
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_ConCodeTable_Create Then
    
    Dim tBitsLength As Byte
    
    tBitsLength = 7    ReDim pubByteBits_ConCodeTable(tBitsLength)
    ReDim pubByteBits_ConCodeTable_CellReadys(tBitsLength)
    
    pubByteBits_ConCodeTable_Create = True
    
  End If
    
  If Not pubByteBits_ConCodeTable_CellReadys(tBitIndex) Then
  
    pubByteBits_ConCodeTable(tBitIndex) = 2 ^ tBitIndex
    pubByteBits_ConCodeTable_CellReadys(tBitIndex) = True
      
  End If
  
  tOutCode = pubByteBits_ConCodeTable(pBitIndex)
  
  BitPutToByte_ConCodeGet = tOutCode
End Function接下来是测试代码：Private Sub Command1_Click()
  Dim tBytes() As Byte
  Dim tIndex As Long
  Dim tBytesSize As Long
  
  OnTimer = Timer
  
  Open "SY.txt" For Binary As #1
    tBytesSize = LOF(1) - 1
    ReDim tBytes(tBytesSize)
    Get #1, 1, tBytes()
  Close #1
    
  Dim tOutStr As String
  tOutStr = KT64Encode(tBytes())
  
  Open "Out.txt" For Binary As #1
    Put #1, 1, tOutStr
  Close #1  Text1.Text = Timer - OnTimerEnd SubPrivate Sub Form_Load()End Sub编译后执行，编码一个200K文件的KT64文件需要2.6秒。另外，楼主关于循环读字符串的帖子，我也有回复，赶紧看看吧。

Answer 14

以上代码简单原理是这样的：将Byte数组按8位一组读出，然后按6位一组写入到目的Byte数组（BitPutToBytes的BitCount参数可以指定按1 - 8位写入各种Byte数组），就实现了0-64的“素码”（我们内部的称呼）。然后将“素码”通过一个表进行转换，转为最终编码（我们戏称“荤码”）。KT64编码和Base64区别在于：KT64是从右向左计算的：0 0 1 1 1 1 1 1
- - 5 4 3 2 1 0Base64是从左向右计算的：0 0 1 1 1 1 1 1
- - 0 1 2 3 4 5实际上，从右向左编写程序时候比较方便。KT64是这样来确保文件长度的正确：bytes_length=204567 '通过一个文件头信息来声明长度。
KT64_code= …… 以后还会使用另一个办法：使用特定控制码（因为可传输的符号不止64个，有一定的冗余编码可以用来做控制码）上述代码的速度之所以比较快，是因为BitGetByByte和BitPutToByte这两个函数采用一种缓冲表来加快速度，这是我用VB编写取/置Bit位最快的程度了。下面是一个叫做clsByteBits的控件，用起来也比较有趣。Option Explicit'Value属性                              '保存Bit的Byte值。
'Bit属性                                '返回或设置指定Bit的值。
'evnValueChange事件                     '当值发生改变的时候触发此事件。
'evnError事件                           '如果Bit位索引超过允许范围则触发此事件。Private priByte As Byte                 '保存数据的BytePublic Event evnValueChange(ByVal pBitIndex As Byte)
Public Event evnError(ByVal pCode As Long, ByVal pInfo As Long)Public Property Get Value() As Byte
  
  Value = priByteEnd PropertyPublic Property Let Value(ByVal vNewValue As Byte)
  Dim tByte As Byte
  Dim tByteChange As Boolean
  
  tByte = vNewValue
  tByteChange = Not (tByte = priByte)
  
  priByte = tByte
  
  If tByteChange Then ValueChange
  
End PropertyPublic Property Get Bit(ByVal pBitIndex As Byte) As Byte
  Dim tOutValue As Byte
  
  tOutValue = BitGetByByte(priByte, pBitIndex)
  
  Bit = tOutValue
End PropertyPublic Property Let Bit(ByVal pBitIndex As Byte, ByVal vNewValue As Byte)
  Dim tByte As Byte
  Dim tByteChange As Boolean
  
  tByte = BitPutToByte(priByte, pBitIndex, vNewValue)
  tByteChange = Not (tByte = priByte)
  
  priByte = tByte
  
  If tByteChange Then ValueChange pBitIndex
  
End PropertyPrivate Sub IndexChange(ByVal pBitIndex As Byte)
  Dim tIndexOverMax As Boolean
  
  tIndexOverMax = pBitIndex > 7
  
  If tIndexOverMax Then
  
    Dim tInfo As String
  
    tInfo = "pBitIndex过大"
  
    RaiseEvent evnError(1, tInfo)
  
  End If
End SubPrivate Sub ValueChange(Optional ByVal pBitIndex As Byte = 7)
  
  RaiseEvent evnValueChange(pBitIndex)End Sub

Answer 15

谢谢！！！ KiteGirl(小仙妹)，谢谢！！！

Answer 16

to 小仙妹   你的代码看的好吃力，你能把它直接转成Base64的吗？另外，在论坛上好久没见到你了。

Answer 17

这个遭瘟的Base64，终于搞定了！用Base64Encode函数。但是没写解码部分。Private priCodeTable_Encode() As Byte
Private priCodeTable_UnEncode() As BytePublic Const conBase64CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"Public Function Base64Encode(ByRef pBytes() As Byte) As String
  Dim tOutStr As String
  Dim tTrueCodes() As Byte
  Dim tBitCount As Long
  Dim tPatch As Long
  tBitCount = BytesCount(pBytes())
  tPatch = (tBitCount * 8) Mod 6
  tTrueCodes() = Base64TrueCodesGetByBytes(pBytes())
  tOutStr = Base64StringGetByTrueCodes(tTrueCodes()) & String(tPatch, "=")
  Base64Encode = tOutStr
End FunctionPublic Sub Base64SetCodeTable(ByVal pString As String)
  Dim tBytes() As Byte
  
  tBytes() = pString
  
  Dim tIndex As Byte
  
  ReDim priCodeTable_Encode(0 To 255)
  ReDim priCodeTable_UnEncode(0 To 255)
  
  Dim tTableIndex As Byte
  
  For tIndex = 0 To 127 Step 2
    tTableIndex = tIndex \ 2
    priCodeTable_Encode(tTableIndex) = tBytes(tIndex)
    priCodeTable_UnEncode(tBytes(tIndex)) = tTableIndex
  Next
  
End SubPrivate Function Base64StringGetByTrueCodes(ByRef pBytes() As Byte, Optional ByVal pCodeTable = conBase64CodeTableStrng) As String
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = BytesCount(pBytes())
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  Base64SetCodeTable pCodeTable
  
  Dim tOutString As String
  
  Dim tIndex As Long
  Dim tSurBytes_Index As Long
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  tOutBytes_Length = tSurBytes_Count * 2 - 1
  ReDim tOutBytes(tOutBytes_Length)
  
  For tIndex = 0 To tOutBytes_Length Step 2
    tSurBytes_Index = tIndex \ 2
    tOutBytes(tIndex) = priCodeTable_Encode(pBytes(tSurBytes_Index))
    tSurBytes_Index = (tOutBytes_Length - tIndex) \ 2
    tOutBytes(tOutBytes_Length - tIndex - 1) = priCodeTable_Encode(pBytes(tSurBytes_Index))
  Next
  
  tOutString = tOutBytes()
  
  Base64StringGetByTrueCodes = tOutString
End FunctionPrivate Function Base64TrueCodesGetByBytes(ByRef pBytes() As Byte) As Byte()
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = BytesCount(pBytes())
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  Dim tOutBytes() As Byte
  Dim tBits_Length As Long
  Dim tOutBytes_Length As Long
  
  tBits_Length = tSurBytes_Count * 8 - 1
  tOutBytes_Length = BitOnBytesIndex(tBits_Length, 6)
  
  ReDim tOutBytes(tOutBytes_Length)
  
  Dim tIndex As Long
  Dim tBitIndex As Long
  Dim tBitValue As Byte
  Dim tBitAbsIndex As Long
  Dim tByteIndex As Long
  
  For tIndex = 0 To tBits_Length
    tBitValue = Base64_BitGetByBytes(pBytes(), tIndex, 8)
    Base64_BitPutToBytes tOutBytes(), tIndex, tBitValue, 6
  Next
  
  Base64TrueCodesGetByBytes = tOutBytes()
End FunctionPrivate Function Base64_BitGetByBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Byte
  Dim tOutByte As Byte
  
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = Base64_BitOnBytesIndex(pBitIndex, pBitCount)
  tByteBitIndex = Base64_BitAbsIndex(pBitIndex, pBitCount)
  tOutByte = BitGetByByte(pBytes(tByteIndex), tByteBitIndex)  Base64_BitGetByBytes = tOutByte
End FunctionPrivate Sub Base64_BitPutToBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, ByVal pBitValue As Byte, Optional ByVal pBitCount As Byte = 8)
    
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = Base64_BitOnBytesIndex(pBitIndex, pBitCount)
  tByteBitIndex = Base64_BitAbsIndex(pBitIndex, pBitCount)
  pBytes(tByteIndex) = BitPutToByte(pBytes(tByteIndex), tByteBitIndex, pBitValue)
  
End SubPrivate Function Base64_BitAbsIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long
  
  tOutIndex = pBitCount - (pBitIndex Mod pBitCount) - 1
  
  Base64_BitAbsIndex = tOutIndex
End Function
Private Function Base64_BitOnBytesIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long  tOutIndex = (pBitIndex \ pBitCount)  Base64_BitOnBytesIndex = tOutIndex
End Function

Answer 18

使用了一种特别“缺德”的的算法  &  这个遭瘟的Base64，终于搞定了！
------------------------------------
小仙妹很幽默哟，有msn吗？

Answer 19

我这可不是胡说的。说我的算法缺德，是因为取位运算是以存储空间换取速度（我自己叫做“动态饱和缓冲表”，是类似哈希表的一种方法），把运算节省到这份上真是做得有点太过分了。至于那个Base64，的确很遭瘟。本来以取余和整除可以很容易计算，但它偏偏要反过来。真怀疑设计Base64那家伙是不是脑子坏掉了。就因为这个颠倒的原因，导致以上Base64编码速度比我的KT64慢很多。不过，或许有更快的算法，我会进一步研究。看看是设计Base64那人脑子坏掉，还是我的脑子坏掉了。呵呵！

Answer 20

哈哈！最新算法：编码一个200KB的文本在编辑状态用了1.n秒，在编译后是0.2秒。按照这个速度，15MB也不过是15秒而已。目前主要问题是：后面的=号数量还不准确，需要你自己进一步研究调整。Private priCodeTable_Encode() As Byte
Private priCodeTable_UnEncode() As BytePrivate Const conBase64CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"Private Sub Command1_Click()
  'Dim tBytes() As Byte
  'tBytes() = StrConv("小仙妹是个好孩子", vbFromUnicode)
  'Text1.Text = Base64Encode(tBytes())
  
    Dim tBytes() As Byte
  Dim tIndex As Long
  Dim tBytesSize As Long
  
  OnTimer = Timer
  
  Open "SY.txt" For Binary As #1
    tBytesSize = LOF(1) - 1
    ReDim tBytes(tBytesSize)
    Get #1, 1, tBytes()
  Close #1
  
  Dim tOutStr As String
  tOutStr = Base64Encode(tBytes())
 
  Open "Out.txt" For Binary As #1
    Put #1, 1, tOutStr
  Close #1 '
'
  Text1.Text = Timer - OnTimerEnd SubFunction Base64Encode(ByRef pBytes() As Byte) As String
  Dim tOutString As String
  Dim tDesBytes() As Byte
  Dim tDesBytes_Length As Long
  
  Dim tSurBytes_Length As Long
  
  tSurBytes_Length = UBound(pBytes())
  tDesBytes_Length = (tSurBytes_Length * 4 + 1) \ 3
  
  ReDim tDesBytes(tDesBytes_Length)
  
  Dim tDesBytesIndex As Long
  Dim tDesSubIndex As Long
  
  For tDesBytesIndex = 0 To tDesBytes_Length
    tDesSubIndex = tDesBytesIndex Mod 4
    tSurBytesIndex = (tDesBytesIndex \ 4) * 3
    Select Case tDesSubIndex
      Case 0
        tDesBytes(tDesBytesIndex) = pBytes(tSurBytesIndex) \ 4
      Case 1
        tDesBytes(tDesBytesIndex) = (pBytes(tSurBytesIndex) Mod 4) * 16 + pBytes(tSurBytesIndex + 1) \ 16
      Case 2
        tDesBytes(tDesBytesIndex) = (pBytes(tSurBytesIndex + 1) Mod 16) * 4 + pBytes(tSurBytesIndex + 2) \ 64
      Case 3
        tDesBytes(tDesBytesIndex) = (pBytes(tSurBytesIndex + 2) Mod 64)
    End Select
    
  Next
  
  Dim tPatch As Long
  tPatch = ((((tSurBytes_Length + 1) * 8) - 1) Mod 6)
  
  tOutString = Base64StringGetByTrueCodes(tDesBytes()) & String(tPatch, "=")
  
  Base64Encode = tOutString
End FunctionPrivate Function Base64StringGetByTrueCodes(ByRef pBytes() As Byte, Optional ByVal pCodeTable = conBase64CodeTableStrng) As String
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = UBound(pBytes()) + 1
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  Base64SetCodeTable pCodeTable
  
  Dim tOutString As String
  
  Dim tIndex As Long
  Dim tSurBytes_Index As Long
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  tOutBytes_Length = tSurBytes_Count * 2 - 1
  ReDim tOutBytes(tOutBytes_Length)
  
  For tIndex = 0 To tOutBytes_Length Step 2
    tSurBytes_Index = tIndex \ 2
    tOutBytes(tIndex) = priCodeTable_Encode(pBytes(tSurBytes_Index))
    tSurBytes_Index = (tOutBytes_Length - tIndex) \ 2
    tOutBytes(tOutBytes_Length - tIndex - 1) = priCodeTable_Encode(pBytes(tSurBytes_Index))
  Next
  
  tOutString = tOutBytes()
  
  Base64StringGetByTrueCodes = tOutString
End FunctionPublic Sub Base64SetCodeTable(ByVal pString As String)
  Dim tBytes() As Byte
  
  tBytes() = pString
  
  Dim tIndex As Byte
  
  ReDim priCodeTable_Encode(0 To 255)
  ReDim priCodeTable_UnEncode(0 To 255)
  
  Dim tTableIndex As Byte
  
  For tIndex = 0 To 127 Step 2
    tTableIndex = tIndex \ 2
    priCodeTable_Encode(tTableIndex) = tBytes(tIndex)
    priCodeTable_UnEncode(tBytes(tIndex)) = tTableIndex
  Next
  
End Sub

Answer 21

目前主要问题是：后面的=号数量还不准确，需要你自己进一步研究调整。
------------------------------------------------------------------
哪个=号？我没试出问题呀。
小仙妹，你真是神了。你的代码比我2.4的CPU还快。

Answer 22

太谢谢KiteGirl(小仙妹),谢谢！！！
按照Surpass(网络飞狐)(原名“凌寒”) 说法，您是一个前辈了，您的代码是我从网上下的有关Base64代码运行最快的了（大于1兆的文件，200k用1秒的有）
我还有个请求：您能帮助歇一下解码好吗，（我的分数不多，还请您见谅）谢谢！！！

Answer 23

我现在讲讲我是怎么琢磨类似算法的：8位Bytes的bit排列00 01 02 03 04 05 06 07
08 09 0A 0B 0C 0D 0E 0F
10 11 12 13 14 15 16 176位Bytes的bit排列00 01 02 03 04 05
06 07 08 09 0A 0B
0C 0D 0E 0F 10 11
12 13 14 15 16 17根据上面的排列，总结出下面的式子。B0 = A0 \ 4
B1 = (A0 Mod 4) * 16 + A1 \ 16
B2 = (A1 Mod 16) * 4 + A2 \ 64
B3 = A2 Mod 64接着是根据8位Byte数量计算需要的6位Byte数量的算式化简：Dmax=((Smax + 1) * 8) / 6 - 1
Dmax=(Smax * 4 + 4) / 3 - 1
Dmax=(Smax * 4 + 4 - 3) / 3
Dmax=(Smax * 4 + 1) / 3计算=号数量的P的过程（由于不了解Base64标准的规定，根据猜想目前暂时用这个公式，不知道是不是正确）：P = (Smax + 1) * 8 - 1) Mod 6)
P = (Smax * 8 + 8 - 1) Mod 6)
P = (Smax * 8 + 7) Mod 6)

Answer 24

Base64编码与解码函数：（原编码函数有错误，这里初步更正了。现在的代码更正确一些。）Private priCodeTable_Encode() As Byte
Private priCodeTable_UnEncode() As BytePrivate Const conBase64CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"Private Sub Command1_Click()
 
    Dim tBytes() As Byte
  Dim tIndex As Long
  Dim tBytesSize As Long
  
  OnTimer = Timer
  
  Open "SY.txt" For Binary As #1
    tBytesSize = LOF(1) - 1
    ReDim tBytes(tBytesSize)
    Get #1, 1, tBytes()
  Close #1
  
  Dim tOutStr As String
  tOutStr = Base64Encode(tBytes())
 
  Open "Out.txt" For Binary As #1
    Put #1, 1, tOutStr
  Close #1 '
'
  Text1.Text = Timer - OnTimerEnd SubFunction Base64Decode(ByVal pString As String) As Byte()
  Dim tSurBytes() As Byte
  Dim tSurBytes_Length As Long
  
  Dim tString As String
  Dim tPatch As Long
  
  tString = Replace(pString, "=", "")
  tPatch = Len(pString) - Len(tString)
  
  tSurBytes() = Base64TrueCodesGetByString(pString)
  tSurBytes_Length = UBound(tSurBytes())
  
  Dim tDesBytes() As Byte
  Dim tDesBytes_Length As Long
  
  tDesBytes_Length = ((tSurBytes_Length - tPatch + 1) * 3) \ 4
  ReDim tDesBytes(tDesBytes_Length)
  
  Dim tDesIndex As Long
  Dim tDesSubIndex As Long
  Dim tSurIndex  As Long
  
  For tDesIndex = 0 To tDesBytes_Length
    tSurIndex = ((tDesIndex) \ 3) * 4
    tDesSubIndex = tDesIndex Mod 3
    Select Case tDesSubIndex
      Case 0
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex) * 4) + (tSurBytes(tSurIndex + 1) \ 16)
      Case 1
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex + 1) Mod 16) * 16 + (tSurBytes(tSurIndex + 2) \ 4)
      Case 2
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex + 2) Mod 4) * 64 + tSurBytes(tSurIndex + 3)
    End Select
  Next
  
  Base64Decode = tDesBytes()
End FunctionFunction Base64Encode(ByRef pBytes() As Byte) As String
  Dim tOutString As String
  Dim tDesBytes() As Byte
  Dim tDesBytes_Length As Long
  
  Dim tSurBytes_Length As Long
  Dim tSurBytes_Patch As Long
  Dim tSurBytes() As Byte
  
  tSurBytes_Length = UBound(pBytes())
  tDesBytes_Length = (tSurBytes_Length * 4 + 1) \ 3 + 1  tSurBytes_Patch = (tSurBytes_Length + 1) Mod 3 + 1  tSurBytes() = pBytes()
  
  ReDim Preserve tSurBytes(tSurBytes_Length + tSurBytes_Patch)
    
  ReDim tDesBytes(tDesBytes_Length)
  
  Dim tDesBytesIndex As Long
  Dim tDesSubIndex As Long
  
  'On Error Resume Next
  
  For tDesBytesIndex = 0 To tDesBytes_Length
    tDesSubIndex = tDesBytesIndex Mod 4
    tSurBytesIndex = (tDesBytesIndex \ 4) * 3
    Select Case tDesSubIndex
      Case 0
        tDesBytes(tDesBytesIndex) = tSurBytes(tSurBytesIndex) \ 4
      Case 1
        tDesBytes(tDesBytesIndex) = (tSurBytes(tSurBytesIndex) Mod 4) * 16 + tSurBytes(tSurBytesIndex + 1) \ 16
      Case 2
        tDesBytes(tDesBytesIndex) = (tSurBytes(tSurBytesIndex + 1) Mod 16) * 4 + tSurBytes(tSurBytesIndex + 2) \ 64
      Case 3
        tDesBytes(tDesBytesIndex) = (tSurBytes(tSurBytesIndex + 2) Mod 64)
    End Select
    
  Next
  
  Dim tPatch As Long
  'tPatch = ((((tSurBytes_Length + 1) * 3) - 1) Mod 4) - 1
  
  tPatch = (tDesBytes_Length + 1) Mod 4
  
  tOutString = Base64StringGetByTrueCodes(tDesBytes()) & String(tPatch, "=")
  
  Base64Encode = tOutString
End FunctionPrivate Function Base64TrueCodesGetByString(ByVal pString As String, Optional ByVal pCodeTable = conBase64CodeTableStrng) As Byte()
  Dim tOutBytes() As Byte
  
  Dim tSurBytes() As Byte
  Dim tSurBytes_Length As Long
  
  Base64SetCodeTable pCodeTable
  
  tSurBytes() = pString
  tSurBytes_Length = UBound(tSurBytes())
  
  Dim tOutBytes_Length As Long
  
  tOutBytes_Length = (tSurBytes_Length) \ 2
  ReDim tOutBytes(tOutBytes_Length)
  
  For tIndex = 0 To tSurBytes_Length Step 2
    tOutBytes(tIndex \ 2) = priCodeTable_UnEncode(tSurBytes(tIndex))
  Next
  
  Base64TrueCodesGetByString = tOutBytes()
End Function
Private Function Base64StringGetByTrueCodes(ByRef pBytes() As Byte, Optional ByVal pCodeTable = conBase64CodeTableStrng) As String
  Dim tSurBytes_Count As Long
  Dim tSurBytes_Space As Boolean
  
  tSurBytes_Count = UBound(pBytes()) + 1
  tSurBytes_Space = Not CBool(tSurBytes_Count)
  
  If tSurBytes_Space Then Exit Function
  
  Base64SetCodeTable pCodeTable
  
  Dim tOutString As String
  
  Dim tIndex As Long
  Dim tSurBytes_Index As Long
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  tOutBytes_Length = tSurBytes_Count * 2 - 1
  ReDim tOutBytes(tOutBytes_Length)
  
  For tIndex = 0 To tOutBytes_Length Step 2
    tSurBytes_Index = tIndex \ 2
    tOutBytes(tIndex) = priCodeTable_Encode(pBytes(tSurBytes_Index))
    tSurBytes_Index = (tOutBytes_Length - tIndex) \ 2
    tOutBytes(tOutBytes_Length - tIndex - 1) = priCodeTable_Encode(pBytes(tSurBytes_Index))
  Next
  
  tOutString = tOutBytes()
  
  Base64StringGetByTrueCodes = tOutString
End FunctionPublic Sub Base64SetCodeTable(ByVal pString As String)
  Dim tBytes() As Byte
  
  tBytes() = pString
  
  Dim tIndex As Byte
  
  ReDim priCodeTable_Encode(0 To 255)
  ReDim priCodeTable_UnEncode(0 To 255)
  
  Dim tTableIndex As Byte
  
  For tIndex = 0 To 127 Step 2
    tTableIndex = tIndex \ 2
    priCodeTable_Encode(tTableIndex) = tBytes(tIndex)
    priCodeTable_UnEncode(tBytes(tIndex)) = tTableIndex
  Next
  
End SubPrivate Sub Command2_Click()
  Dim tBytes() As Byte
  Dim tIndex As Long
  Dim tString As String
  
  tBytes() = StrConv("小仙妹是个好孩子AAAAAA", vbFromUnicode)
  
  'For tIndex = 0 To 19
  '  Text1.Text = Text1.Text & " " & Hex(tBytes(tIndex))
  'Next tIndex
  
  tString = Base64Encode(tBytes())
  
  Text1.Text = tString
  
  tBytes() = Base64Decode(tString)
  
  'For tIndex = 0 To 19
  '  Text2.Text = Text2.Text & " " & Hex(tBytes(tIndex))
  'Next tIndex
  
  Text2.Text = StrConv(tBytes(), vbUnicode)
  'Text2.Text = Base64Decode(Text1.Text)
End SubPrivate Sub Command3_Click()
  Dim tBytes() As Byte
  ReDim tBytes(63)
  Dim tIndex As Long
  Dim tString As String
  
  For tIndex = 0 To 63
    tBytes(tIndex) = tIndex
  Next
  tString = Base64StringGetByTrueCodes(tBytes())
  tBytes() = Base64TrueCodesGetByString(tString)
  
  For tIndex = 0 To 63
    Text1.Text = Text1.Text & " " & tBytes(tIndex)
  Next
  
  'Text1.Text = tString
End Sub

Answer 25

原来的代码错误如下：1、如果原数组不是3的整倍，则丢失后面多余位的信息。数组最后一个字节可能不正确。输入：小仙妹是个好孩子AAAA
输出：小仙妹是个好孩子AAA@目前已经解决了这个问题。2、原来的加=号的算法不对，这里已经更正了。解码、编码算法分析如下：00 01 02 03 04 05 06 07
08 09 0A 0B 0C 0D 0E 0F
10 11 12 13 14 15 16 1700 01 02 03 04 05
06 07 08 09 0A 0B
0C 0D 0E 0F 10 11
12 13 14 15 16 17B0 = A0 \ 4
B1 = (A0 Mod 4)*16 + A1 \ 16
B2 = (A1 Mod 16)*4 + A2 \ 64
B3 = A2 Mod 64A0 = (B0 * 4) + (B1 \ 16)
A1 = (B1 Mod 16) * 16 + (B2 \ 4)
A3 = (B2 Mod 4) * 64 + B3

Answer 26

注意：上述函数是一边研究一边写的，写得有些潦草。目前这个函数初步认定不会出现数据问题。但以下几点还有待解决：1、=号数量与OutLook编码不符合。
2、错误的=号解码时是否会引起出错还不确定。
3、容错性有待提高。对于数据来说，哪怕一个Bit的错误都可能导致严重后果。所以，在证实上述代码确实可靠前提下，千万不要轻易用于正式的应用程序里（如果你编写的程序是一个面向大众的应用程序，记得在证实可靠前注明“测试版”）。

Answer 27

谨盼KiteGirl(小仙妹)的解码程序，谢谢！！！

Answer 28

http://community.csdn.net/Expert/topic/2961/2961033.xml?temp=.6965906

Answer 29

有没有搞错呀！解码程序就在上面呀！叫做Base64Decode。

Answer 30

搜索下面这句话：
tPatch = (tDesBytes_Length + 1) Mod 4更正为：
tPatch = 4 - ((tDesBytes_Length + 1) Mod 4)这样就彻底正确了。我现在正在编写一个规范化代码。如果没有估计错的话，后面的代码速度可能比上面还要快。而且将以控件提供。

Answer 31

谢谢！！KiteGirl(小仙妹)：
解码程序Base64Decode只对您的编码能正确解码，对其他规范的Base64编码编出的不能正确加码。
我下面的程序能正确解码您的代码编出的程序，对其他的也能正确编码，另您能否将您的代码以代码形势告知，而不是控件，
下面的代码缺点就是速度慢，还请大家帮助修改，谢谢！！！
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 Sub

Answer 32

to KiteGirl(小仙妹) ;
在您的解码代码里，我想在读取字节时，当遇到“回车符和换行符“时，把回车符和换行符去掉，该如何修改此代码，谢谢！！！
Function Base64Decode(ByVal pString As String) As Byte()
  Dim tSurBytes() As Byte
  Dim tSurBytes_Length As Long
  
  Dim tString As String
  Dim tPatch As Long
  
  'tString = Replace(pString, "=", "")
  tString = pString
  tPatch = Len(pString) - Len(tString)
  
  tSurBytes() = Base64TrueCodesGetByString(pString)
  tSurBytes_Length = UBound(tSurBytes())
  
  Dim tDesBytes() As Byte
  Dim tDesBytes_Length As Long
  
  tDesBytes_Length = ((tSurBytes_Length) * 3) \ 4
  ReDim tDesBytes(tDesBytes_Length)
  
  Dim tDesIndex As Long
  Dim tDesSubIndex As Long
  Dim tSurIndex  As Long
  
  For tDesIndex = 0 To tDesBytes_Length
    tSurIndex = ((tDesIndex) \ 3) * 4
    tDesSubIndex = tDesIndex Mod 3
    Select Case tDesSubIndex
      Case 0
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex) * 4) + (tSurBytes(tSurIndex + 1) \ 16)
      Case 1
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex + 1) Mod 16) * 16 + (tSurBytes(tSurIndex + 2) \ 4)
      Case 2
        tDesBytes(tDesIndex) = (tSurBytes(tSurIndex + 2) Mod 4) * 64 + tSurBytes(tSurIndex + 3)
    End Select
  Next
  
  Base64Decode = tDesBytes()
End Function

Answer 33

你不要着急，我正在写一个新的代码。新代码基本原理沿用上面的编码原理，但数据和算法的表示方式不大一样。更直观而且更高效。该代码初步测试，在CPU为CR433的电脑上，编译后可在6秒内处理相当于15M的数据。和你所说的Foxmail编码15M只用5秒非常相似（而且你说的5秒可能是在比CR433快的机器上，如果真是这样，可能它比Foxmail还要快。）。而且，这个代码写得比较规范。至于去掉Base64编码的回车，只要这样就可以了：tString=Replace(tString, vbCrlf, "")tString是带换行的Base64编码。你说我的代码不能正确解码其他工具产生的Base64编码，可能是由于这些编码有换行造成的。另外，也有可能是我上面那些代码写的有些潦草，隐藏着不少的问题。等新编码出来之后，立刻提供给你。至于控件，并非是只给你编译好的控件，而是提供控件的代码。我写的控件代码一般有三部分组成：1、核心模块，2、Class类、3、控件。控件基于Class、Class基于核心模块。所以，无论你怎么用都可以。

Answer 34

谢谢您！！！KiteGirl(小仙妹) ，谢谢！！！

Answer 35

代码很长，分几个部分发。'名称:          Base64编码/解码模块
'Name:          Base64 Encode & Decode Module'作者:          KiteGirl [中国]
'programmer:    KiteGirl [China]Private priBitMoveTable() As Byte               '移位缓冲表
Private priBitMoveTable_CellReady() As Boolean  '移位缓冲表标志表
Private priBitMoveTable_Create As Boolean       '移位缓冲表创建标志Private priEncodeTable() As Byte                '编码表（素码转Base64）
Private priEncodeTable_Create As BooleanPrivate priDecodeTable() As Byte                '解码表（Base64转素码）
Private priDecodeTable_Create As BooleanPrivate Declare Sub Base64_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDestination As Any, ByRef pSource As Any, ByVal pLength As Long)Public Const conBase64_CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Public Const conBase64_PatchCode As Byte = 61Type tpBase64_Dollop2438                '24Bit(8Bit*3Byte)数据块
  btBytes(0 To 2) As Byte
End TypeType tpBase64_Dollop2446                '24Bit(6Bit*4Byte)数据块
  btBytes(0 To 3) As Byte
End TypePublic Function Base64Decode(ByRef pBytes() As Byte, Optional ByVal pPatchCode As Byte = conBase64_PatchCode) As Byte()
  'Base64Decode函数
  '语法：[tOutBytes()] = Base64Decode(pBytes(), [pPatchCode])
  '功能：将Byte数组表示的Base64编码Ascii字节数组解码为Byte字节数组，并返回。
  '参数：byte pBytes()                  '必要参数。Byte数组表示的Base64编码数据。
  '      byte pPatchCode                '可选参数。冗余字节追加码。默认为61（"="的Ascii码）
  '返回：byte tOutBytes()               'Byte数组。
  '示例：
  '      Dim tSurString As String
  '      Dim tSurBytes() As Byte
  '      tSurString = "S2l0ZUdpcmzKx7j2usO6otfT"
  '      tSurBytes() = StrConv(tSurString, vbFromUnicode)
  '      Dim tDesString As String
  '      Dim tDesBytes() As Byte
  '      tDesBytes() = Base64Decode(tSurBytes())
  '      tDesString = StrConv(tDesBytes(), vbUnicode) 'tDesString返回"KiteGirl是个好孩子"  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  Dim tBytes_Length As Byte
  
  Dim tBytes2446() As Byte
  
  Dim tSurBytes_Length As Long
  Dim tDesBytes_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  tBytes_Length = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  tBytes2446() = BytesPrimeDecode(pBytes())
  tOutBytes() = Bytes2438GetBy2446(tBytes2446())  Dim tPatchNumber As Long
    
  Dim tIndex As Long
  Dim tBytesIndex As Long
  
  For tIndex = 0 To 1
    tBytesIndex = tBytes_Length - tIndex
    tPatchNumber = tPatchNumber + ((pBytes(tIndex) = pPatchCode) And 1)
  Next
    
  tSurBytes_Length = tBytes_Length - tPatchNumber
  tDesBytes_Length = (tSurBytes_Length * 3) \ 4
    
  ReDim Preserve tOutBytes(tDesBytes_Length)  Base64Decode = tOutBytes()
End FunctionPublic Function Base64Encode(ByRef pBytes() As Byte, Optional ByVal pPatchCode As Byte = conBase64_PatchCode) As Byte()
  'Base64Encode函数
  '语法：[tOutBytes()] = Base64Encode(pBytes(), [pPatchCode])
  '功能：将Byte数组编码为Base64编码的Ascii字节数组，并返回。
  '参数：byte pBytes()                  '必要参数。Byte数组表示的数据。
  '      byte pPatchCode                '可选参数。冗余字节追加码。默认为61（"="的Ascii码）
  '返回：byte tOutBytes()               'Base64编码表示的Ascii代码数组。
  '注意：如果你想在VB里以字符串表示该函数的返回值，需要用StrConv转换为Unicode。
  '示例：
  '      Dim tSurString As String
  '      Dim tSurBytes() As Byte
  '      tSurString = "KiteGirl是个好孩子"
  '      tSurBytes() = StrConv(tSurString, vbFromUnicode)
  '      Dim tDesString As String
  '      Dim tDesBytes() As Byte
  '      tDesBytes() = Base64Encode(tSurBytes())
  '      tDesString = StrConv(tDesBytes(), vbUnicode) 'tDesString返回"S2l0ZUdpcmzKx7j2usO6otfT"
  
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  Dim tBytes2446() As Byte
  
  Dim tSurBytes_Length As Long
  Dim tDesBytes_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  tSurBytes_Length = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
      
  tBytes2446() = Bytes2438PutTo2446(pBytes())
  tOutBytes() = BytesPrimeEncode(tBytes2446())
  
  tOutBytes_Length = UBound(tOutBytes())
  
  Dim tPatchNumber As Long
  
  tDesBytes_Length = (tSurBytes_Length * 4 + 3) \ 3
  tPatchNumber = tOutBytes_Length - tDesBytes_Length
  
  Dim tIndex As Long
  Dim tBytesIndex As Long  For tIndex = 1 To tPatchNumber
    tBytesIndex = tOutBytes_Length - tIndex + 1
    tOutBytes(tBytesIndex) = pPatchCode
  Next  Base64Encode = tOutBytes()
End FunctionPublic Function BytesPrimeDecode(ByRef pBytes() As Byte) As Byte()
  '功能：将Base64数组解码为素码数组
  
  Dim tOutBytes() As Byte
      
  Dim tBytes_Length As Long
  
  Err.Clear
  On Error Resume Next  tBytes_Length = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  ReDim tOutBytes(tBytes_Length)
  
  If Not priDecodeTable_Create Then Base64CodeTableCreate  Dim tIndex As Long
  
  For tIndex = 0 To tBytes_Length
    tOutBytes(tIndex) = priDecodeTable(pBytes(tIndex))
  Next  BytesPrimeDecode = tOutBytes()
End FunctionPublic Function BytesPrimeEncode(ByRef pBytes() As Byte) As Byte()
  '功能：将素码数组编码为Base64数组
  
  Dim tOutBytes() As Byte
  
  Dim tBytes_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  tBytes_Length = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  ReDim tOutBytes(tBytes_Length)
  
  If Not priEncodeTable_Create Then Base64CodeTableCreate
    
  Dim tIndex As Long
  
  For tIndex = 0 To tBytes_Length
    tOutBytes(tIndex) = priEncodeTable(pBytes(tIndex))
  Next
  
  BytesPrimeEncode = tOutBytes()
End FunctionPublic Sub Base64CodeTableCreate(Optional ByVal pString As String = conBase64_CodeTableStrng)
  '功能：根据字符串提供的代码初始化Base64解码/编码码表。
  
  Dim tBytes() As Byte
  Dim tBytes_Length As Long
  
  tBytes() = pString
  tBytes_Length = UBound(tBytes())
  
  If Not tBytes_Length = 127 Then
      MsgBox "编码/解码表初始化失败", , "错误"
      Exit Sub
  End If
  
  Dim tIndex As Byte
  
  ReDim priEncodeTable(0 To 255)
  ReDim priDecodeTable(0 To 255)
  
  Dim tTableIndex As Byte
  Dim tByteValue As Byte
  
  For tIndex = 0 To tBytes_Length Step 2
    tTableIndex = tIndex \ 2
    tByteValue = tBytes(tIndex)
    priEncodeTable(tTableIndex) = tByteValue
    priDecodeTable(tByteValue) = tTableIndex
  Next
  
  priEncodeTable_Create = True
  priDecodeTable_Create = True
End Sub

Answer 36

Private Function Bytes2438GetBy2446(ByRef pBytes() As Byte) As Byte()
  '功能：将素码转换为字节。
  Dim tOutBytes() As Byte
  
  Dim tDollops2438() As tpBase64_Dollop2438
  Dim tDollops2446() As tpBase64_Dollop2446
  
  tDollops2446() = BytesPutTo2446(pBytes())
  tDollops2438() = Dollops2438GetBy2446(tDollops2446())
  tOutBytes() = BytesGetBy2438(tDollops2438())
  
  Bytes2438GetBy2446 = tOutBytes()
End FunctionPrivate Function Bytes2438PutTo2446(ByRef pBytes() As Byte) As Byte()
  '功能：将字节转换为素码。
  Dim tOutBytes() As Byte
  
  Dim tDollops2438() As tpBase64_Dollop2438
  Dim tDollops2446() As tpBase64_Dollop2446
  
  tDollops2438() = BytesPutTo2438(pBytes())
  tDollops2446() = Dollops2438PutTo2446(tDollops2438())
  tOutBytes() = BytesGetBy2446(tDollops2446())
  
  Bytes2438PutTo2446 = tOutBytes()
End FunctionPrivate Function BytesGetBy2446(ByRef p2446() As tpBase64_Dollop2446) As Byte()
  '功能：2446数组转换为字节数组
  
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  Dim t2446Length As Long
  
  Err.Clear
  On Error Resume Next
  
  t2446Length = UBound(p2446())
  
  If CBool(Err.Number) Then Exit Function  tOutBytes_Length = t2446Length * 4 + 3
  
  ReDim tOutBytes(0 To tOutBytes_Length)
  
  Dim tCopyLength As Long
  
  tCopyLength = tOutBytes_Length + 1
  
  Base64_CopyMemory tOutBytes(0), p2446(0), tCopyLength
  
  BytesGetBy2446 = tOutBytes()
End FunctionPrivate Function BytesPutTo2446(ByRef pBytes() As Byte) As tpBase64_Dollop2446()
  '功能：字节数组转换为2446数组
  Dim tOut2446() As tpBase64_Dollop2446
  Dim tOut2446_Length As Long
  
  Dim tBytesLength As Long
  
  Err.Clear
  On Error Resume Next
  
  tBytesLength = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  tOut2446_Length = tBytesLength \ 4
  
  ReDim tOut2446(0 To tOut2446_Length)
  
  Dim tCopyLength As Long
  
  tCopyLength = tBytesLength + 1
  
  Base64_CopyMemory tOut2446(0), pBytes(0), tCopyLength
  
  BytesPutTo2446 = tOut2446()
End FunctionPrivate Function BytesGetBy2438(ByRef p2438() As tpBase64_Dollop2438) As Byte()
  '功能：2438数组转换为字节数组
  Dim tOutBytes() As Byte
  Dim tOutBytes_Length As Long
  
  Dim t2438Length As Long
  
  Err.Clear
  On Error Resume Next
  
  t2438Length = UBound(p2438())
  
  If CBool(Err.Number) Then Exit Function  tOutBytes_Length = t2438Length * 3 + 2
  
  ReDim tOutBytes(0 To tOutBytes_Length)
  
  Dim tCopyLength As Long
  
  tCopyLength = tOutBytes_Length + 1
  
  Base64_CopyMemory tOutBytes(0), p2438(0), tCopyLength
  
  BytesGetBy2438 = tOutBytes()
End FunctionPrivate Function BytesPutTo2438(ByRef pBytes() As Byte) As tpBase64_Dollop2438()
  '功能：字节数组转换为2438数组
  Dim tOut2438() As tpBase64_Dollop2438
  Dim tOut2438_Length As Long
  
  Dim tBytesLength As Long
  
  Err.Clear
  On Error Resume Next
  
  tBytesLength = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  tOut2438_Length = tBytesLength \ 3
  
  ReDim tOut2438(0 To tOut2438_Length)
  
  Dim tCopyLength As Long
  
  tCopyLength = tBytesLength + 1
  
  Base64_CopyMemory tOut2438(0), pBytes(0), tCopyLength
  
  BytesPutTo2438 = tOut2438()
End FunctionPrivate Function Dollops2438GetBy2446(ByRef p2446() As tpBase64_Dollop2446) As tpBase64_Dollop2438()
  '功能：2446块数组转换为2438块数组
  Dim tOut2438() As tpBase64_Dollop2438
  Dim tOut2438_Length As Long
  
  Dim t2446_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  If CBool(Err.Number) Then Exit Function
  
  t2446_Length = UBound(p2446())
  tOut2438_Length = t2446_Length
  
  ReDim tOut2438(tOut2438_Length)
  
  Dim tIndex As Long
  
  For tIndex = 0 To t2446_Length
    tOut2438(tIndex) = Dollop2438GetBy2446(p2446(tIndex))
  Next
  
  Dollops2438GetBy2446 = tOut2438()
End FunctionPrivate Function Dollops2438PutTo2446(ByRef p2438() As tpBase64_Dollop2438) As tpBase64_Dollop2446()
  '功能：2438块数组转换为2446块数组
  
  Dim tOut2446() As tpBase64_Dollop2446
  Dim tOut2446_Length As Long
  
  Dim t2438_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  If CBool(Err.Number) Then Exit Function
  
  t2438_Length = UBound(p2438())
  tOut2446_Length = t2438_Length
  
  ReDim tOut2446(tOut2446_Length)
  
  Dim tIndex As Long
  
  For tIndex = 0 To t2438_Length
    tOut2446(tIndex) = Dollop2438PutTo2446(p2438(tIndex))
  Next
  
  Dollops2438PutTo2446 = tOut2446()
End FunctionPrivate Function Dollop2438GetBy2446(ByRef p2446 As tpBase64_Dollop2446) As tpBase64_Dollop2438
  '功能：2446块转换为2438块
  Dim tOut2438 As tpBase64_Dollop2438  With tOut2438
    .btBytes(0) = ByteBitMove(p2446.btBytes(0), 2) + ByteBitMove(p2446.btBytes(1), -4)
    .btBytes(1) = ByteBitMove(p2446.btBytes(1), 4) + ByteBitMove(p2446.btBytes(2), -2)
    .btBytes(2) = ByteBitMove(p2446.btBytes(2), 6) + ByteBitMove(p2446.btBytes(3), 0)
  End With  Dollop2438GetBy2446 = tOut2438
End FunctionPrivate Function Dollop2438PutTo2446(ByRef p2438 As tpBase64_Dollop2438) As tpBase64_Dollop2446
  '功能：2438块转换为2446块
  Dim tOut2446 As tpBase64_Dollop2446
  
  With tOut2446
    .btBytes(0) = ByteBitMove(p2438.btBytes(0), -2, 63)
    .btBytes(1) = ByteBitMove(p2438.btBytes(0), 4, 63) + ByteBitMove(p2438.btBytes(1), -4, 63)
    .btBytes(2) = ByteBitMove(p2438.btBytes(1), 2, 63) + ByteBitMove(p2438.btBytes(2), -6, 63)
    .btBytes(3) = ByteBitMove(p2438.btBytes(2), 0, 63)
  End With
  
  Dollop2438PutTo2446 = tOut2446
End FunctionPrivate Function ByteBitMove(ByVal pByte As Byte, ByVal pMove As Integer, Optional ByVal pConCode As Byte = &HFF) As Byte
  '功能：对Byte进行移位（带饱和缓冲功能）。
  Dim tOutByte As Byte
  
  If Not priBitMoveTable_Create Then
    
    ReDim priBitMoveTable(0 To 255, -8 To 8)
    ReDim priBitMoveTable_CellReady(0 To 255, -8 To 8)
    
    priBitMoveTable_Create = True
    
  End If
  
  If Not priBitMoveTable_CellReady(pByte, pMove) Then
    
    priBitMoveTable(pByte, pMove) = ByteBitMove_Operation(pByte, pMove)
    priBitMoveTable_CellReady(pByte, pMove) = True
    
  End If
  
  tOutByte = priBitMoveTable(pByte, pMove) And pConCode
  
  ByteBitMove = tOutByte
End FunctionPrivate Function ByteBitMove_Operation(ByVal pByte As Byte, ByVal pMove As Integer) As Byte
  '功能：对Byte进行算术移位。
  Dim tOutByte As Byte
  
  Dim tMoveLeft As Boolean
  Dim tMoveRight As Boolean
  Dim tMoveCount As Integer
  
  tMoveLeft = pMove > 0
  tMoveRight = pMove < 0
  
  tMoveCount = Abs(pMove)
  
  If tMoveLeft Then
      tOutByte = (pByte Mod (2 ^ (8 - tMoveCount))) * (2 ^ tMoveCount)
    ElseIf tMoveRight Then
      tOutByte = pByte \ 2 ^ tMoveCount
    Else
      tOutByte = pByte
  End If
  
  ByteBitMove_Operation = tOutByte
End Function

Answer 37

关于上面代码的说明：1、这次出于规范化考虑，Base64Encode和Base64Decode不再接受String，而是Byte数组。
这个Byte数组并不是String直接赋值可以得到的。
以"AAA"为例，VB下的String直接转换为byte数组是6个字节，分别为00 41 00 41 00 41，而实际存储在文件里的是三个字节41 41 41。
如果你想把"AAA"转换为Base64Encode可以接受的Bytes()需要以StrConv来转换。Bytes()=StrConv("AAA", vbFromUnicode) '这样得到41 41 41如果你想把41 41 41返回为VB可显示的"AAA"也就是00 41 00 41 00 41，需要这样：tString=StrConv(Bytes(), vbUnicode)从前的函数返回字符串"AAA"其实并不是严格的做法。返回3个Byte(&H41 &H41 &H41)才是正确的。所以，这次写的函数一律采用这种规范一些做法。这个改进对于字符串操作可能显得麻烦一些，但是对于文件之间的编码却是特别方便的。你只要读去一个文件的Bytes()，然后将这个Bytes()编码之后，将取得的字节数组直接存盘就是编码后的文本。关于速度方面，在Celeron 433MHz的电脑上，编码一个17M的文件用了16秒，比想象中的慢了许多。有一部分时间消耗在了Base64的导出编码（素码编码为Base64）。和从前的编码比较，速度并没有很大提高，这点比较遗憾。
尽管如此，这个程序比前次的代码容错性要好很多，几乎不会因为错误的编码以及长度错误导致程序出错。顶多返回给你一个错误的结果而已。而且它的工作方式十分清晰，整个编写过程没有勉强应付的地方。

Answer 38

谢谢!!!KiteGirl(小仙妹),谢谢!!!
不过我在Celeron 1.7G的机上运行，编码一个14.9M的文件用了48秒，解码一个20.9M的文件用了53秒，不知为何我的CUP比您的高，速度却比您的慢，谢谢！！！

Answer 39

编译为exe之后执行，而不是在编辑状态执行。

Answer 40

PS-CODE上有一个老外的BASE64代码,巨快!

Answer 41

编码一个8MB的MP3文件，不编译为exe运行用了58秒，而编译后只用了6.9秒。

Answer 42

to KiteGirl(小仙妹):谢谢！！！谢谢您！！！！