BASE64编码和解码

编码代码是在原来别人写的一段代码改的 
'加密进输入的字节，所以就可以加密二制文件等，返回的是一Ba64的字符串  
Function  B64E(inData()  As  Byte)  As  String  
       On  Error  Resume  Next  
       Const  Base64  =  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  
       Dim  UB  As  Long,  lB  As  Long                                  '数组的上限和下限  
       Dim  sOut,  cOut,  i  
       Dim  nGroup      As  Long  
       Dim  pOut,  sGroup  
       UB  =  UBound(inData)  
       Dim  Second  As  Byte  
       Dim  Thrid  As  Byte  
       lB  =  LBound(inData)  
       If  Err.Number  <>  0  Then  
               B64E  =  ""  
               Exit  Function  
       End  If  
       For  i  =  lB  To  UB  Step  3  
               If  i  +  1  >  UB  Then  
                       Second  =  0  
                       Thrid  =  0  
               ElseIf  i  +  2  >  UB  Then  
                       Second  =  inData(i  +  1)  
                       Thrid  =  0  
               Else  
                       Second  =  inData(i  +  1)  
                       Thrid  =  inData(i  +  2)  
               End  If  
               nGroup  =  &H10000  *  inData(i)  +  &H100  *  Second  +  Thrid  
               sGroup  =  Oct(nGroup)  
               sGroup  =  String(8  -  Len(sGroup),  "0")  +  sGroup  
               pOut  =  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  1,  2))  +  1,  1)  +  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  3,  2))  +  1,  1)  +  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  5,  2))  +  1,  1)  +  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  7,  2))  +  1,  1)  
               sOut  =  sOut  +  pOut  
               If  (i  +  2)  Mod  57  =  0  Then  sOut  =  sOut  +  vbCrLf  
               nGroup  =  0  
       Next  i  
       Select  Case  (UB  -  lB  +  1)  Mod  3  
       Case  1  
               sOut  =  Left(sOut,  Len(sOut)  -  2)  +  "=="  
       Case  2  
               sOut  =  Left(sOut,  Len(sOut)  -  1)  +  "="  
       End  Select  
       B64E  =  sOut  
End  Function  
 
'返回的也是一字节数组  
Public  Function  B64U(ByVal  inData  As  String,  OutData()  As  Byte)  As  Boolean  
       On  Error  GoTo  Errhandle  
       Const  Base64  =  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  
       Dim  UB  As  Long,  lB  As  Long                                  '数组的上限和下限  
       Dim  sOut,  cOut,  i  
       Dim  nGroup      As  Long  
       Dim  pOut,  sGroup  
       inData  =  Replace(inData,  vbCrLf,  "")  
       ReDim  OutData(0  To  (Int(Len(inData)  /  4)  +  1)  *  3  -  1)  As  Byte  
       For  i  =  1  To  (Len(inData)  -  Len(inData)  Mod  4)  Step  4  
               nGroup  =  &O1000000  *  (InStr(Base64,  Mid(inData,  i,  1))  -  1)  +  &O10000  *  (InStr(Base64,  Mid(inData,  i  +  1,  1))  -  1)  +  _  
                                               &O100  *  (IIf(InStr(Base64,  Mid(inData,  i  +  2,  1))  =  0,  1,  InStr(Base64,  Mid(inData,  i  +  2,  1)))  -  1)  _  
                                               +  (IIf(InStr(Base64,  Mid(inData,  i  +  3,  1))  =  0,  1,  InStr(Base64,  Mid(inData,  i  +  3,  1)))  -  1)  
               sGroup  =  Trim(Hex(nGroup))                                                                                        '转成16位的  
               sGroup  =  String(6  -  Len(sGroup),  "0")  &  sGroup                                                                      '如果不够六位用0去补  
               OutData(Int(i  /  4)  *  3)  =  Val("&H"  &  Mid(sGroup,  1,  2))  
               OutData(Int(i  /  4)  *  3  +  1)  =  Val("&H"  &  Mid(sGroup,  3,  2))  
               OutData(Int(i  /  4)  *  3  +  2)  =  Val("&H"  &  Mid(sGroup,  5,  2))  
       Next  i  
       Select  Case  Len(inData)  -  Len(Replace(inData,  "=",  ""))  
       Case  1  
               ReDim  Preserve  OutData(0  To  (Int(Len(inData)  /  4)  +  1)  *  3  -  2)  As  Byte  
       Case  2  
               ReDim  Preserve  OutData(0  To  (Int(Len(inData)  /  4)  +  1)  *  3  -  3)  As  Byte  
       End  Select  
       B64U  =  True  
       Exit  Function  
Errhandle:  
       B64U  =  False  
End  Function  
 
'这段代码可以加密二进制数据，像图片文件等都没有问题，  
调用方法：  
Private  Sub  Command1_Click()  
       Dim  arrstr()  As  Byte  
       arrstr  =  StrConv(Text1.Text,  vbFromUnicode)  
       Text2.Text  =  B64E(arrstr)  
End  Sub  
 
Private  Sub  Command2_Click()  
       Dim  OutData()  As  Byte  
       If  B64U(Text2.Text,  OutData)  =  True  Then  
               Text1.Text  =  CStr(OutData)  
       End  If  
End  Sub