Enc-Base64位加密程序包括源代码(支持中文和特殊符号)

Enc-Base64位加密程序包括源代码(支持中文和特殊符号)

创建一个新类,即可调用该类的加密和解密方法

Option   Explicit

‘Base64编码函数:Base64Encode
‘Instr1         编码前字符串
‘Outstr1         编码后字符串
Public   Function   Base64Encode(InStr1   As   String)   As   String
        Dim   mInByte(3)   As   Byte,   mOutByte(4)   As   Byte
        Dim   myByte   As   Byte
        Dim   i   As   Integer,   LenArray   As   Integer,   j   As   Integer
        Dim   myBArray()   As   Byte
        Dim   OutStr1   As   String
       
        myBArray()   =   StrConv(InStr1,   vbFromUnicode)
        LenArray   =   UBound(myBArray)   +   1
        For   i   =   0   To   LenArray   Step   3
                If   LenArray   –   i   =   0   Then
                        Exit   For
                End   If
                If   LenArray   –   i   =   2   Then
                        mInByte(0)   =   myBArray(i)
                        mInByte(1)   =   myBArray(i   +   1)
                        Base64EncodeByte   mInByte,   mOutByte,   2
                ElseIf   LenArray   –   i   =   1   Then
                        mInByte(0)   =   myBArray(i)
                        Base64EncodeByte   mInByte,   mOutByte,   1
                Else
                        mInByte(0)   =   myBArray(i)
                        mInByte(1)   =   myBArray(i   +   1)
                        mInByte(2)   =   myBArray(i   +   2)
                        Base64EncodeByte   mInByte,   mOutByte,   3
                End   If
                For   j   =   0   To   3
                        OutStr1   =   OutStr1   &   Chr(mOutByte(j))
                Next   j
        Next   i
        Base64Encode   =   OutStr1
End   Function

Private   Sub   Base64EncodeByte(mInByte()   As   Byte,   mOutByte()   As   Byte,   Num   As   Integer)
      Dim   tByte   As   Byte
      Dim   i   As   Integer

      If   Num   =   1   Then
              mInByte(1)   =   0
              mInByte(2)   =   0
      ElseIf   Num   =   2   Then
              mInByte(2)   =   0
      End   If
      tByte   =   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)   =   tByte
      For   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   i
      If   Num   =   1   Then
              mOutByte(2)   =   Asc( “= “)
              mOutByte(3)   =   Asc( “= “)
      ElseIf   Num   =   2   Then
              mOutByte(3)   =   Asc( “= “)
      End   If
End   Sub

Public   Function   Base64Decode(InStr1   As   String)   As   String
      Dim   mInByte(4)   As   Byte,   mOutByte(3)   As   Byte
      Dim   i   As   Integer,   LenArray   As   Integer,   j   As   Integer
      Dim   myBArray()   As   Byte
      Dim   OutStr1   As   String
      Dim   tmpArray()   As   Byte

      myBArray()   =   StrConv(InStr1,   vbFromUnicode)
      LenArray   =   UBound(myBArray)
      ReDim   tmpArray(((LenArray   +   1)   /   4)   *   3)
        j   =   0
       
        For   i   =   0   To   LenArray   Step   4
              If   LenArray   –   i   =   0   Then
                      Exit   For
Else
                        mInByte(0)   =   myBArray(i)
                        mInByte(1)   =   myBArray(i   +   1)
                        mInByte(2)   =   myBArray(i   +   2)
                        mInByte(3)   =   myBArray(i   +   3)
                        Base64DecodeByte   mInByte,   mOutByte,   4
                End   If
                tmpArray(j   *   3)   =   mOutByte(0)
                tmpArray(j   *   3   +   1)   =   mOutByte(1)
                tmpArray(j   *   3   +   2)   =   mOutByte(2)
                j   =   j   +   1
        Next   i
        Base64Decode   =   BinaryToString(tmpArray)
End   Function

Private   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
Private   Function   BinaryToString(ByVal   BinaryStr   As   Variant)   As   String   ‘二进制转换为字符串
    Dim   lnglen   As   Long
    Dim   tmpBin   As   Variant
    Dim   strC   As   String
    Dim   skipflag   As   Long
    Dim   i   As   Long
    skipflag   =   0
    strC   =   ” ”
   
    If   Not   IsNull(BinaryStr)   Then
            lnglen   =   LenB(BinaryStr)
            For   i   =   1   To   lnglen
                    If   skipflag   =   0   Then
                        tmpBin   =   MidB(BinaryStr,   i,   1)
                        If   AscB(tmpBin)   >   127   Then
                                strC   =   strC   &   Chr(AscW(MidB(BinaryStr,   i   +   1,   1)   &   tmpBin))
                                skipflag   =   1
                        Else
                                strC   =   strC   &   Chr(AscB(tmpBin))
                        End   If
                    Else
                        skipflag   =   0
                    End   If
            Next
        End   If
        BinaryToString   =   strC
End   Function

Private   Function   StringToBinary(ByVal   VarString   As   String)   As   Variant   ‘字符串转成二进制
    Dim   strBin   As   Variant
    Dim   varchar   As   Variant
    Dim   varasc   As   Long
    Dim   varlow,   varhigh
    Dim   i   As   Long
    strBin   =   ” ”
   
    For   i   =   1   To   Len(VarString)
            varchar   =   Mid(VarString,   i,   1)
            varasc   =   Asc(varchar)
            If   varasc   <   0   Then
                    varasc   =   varasc   +   65535
            End   If
            If   varasc   >   255   Then
                    varlow   =   Left(Hex(Asc(varchar)),   2)
                    varhigh   =   Right(Hex(Asc(varchar)),   2)
                    strBin   =   strBin   &   ChrB( “&H ”   &   varlow)   &   ChrB( “&H ”   &   varhigh)
            Else
                    strBin   =   strBin   &   ChrB(AscB(varchar))
            End   If
    Next
    StringToBinary   =   strBin
End   Function

You may also like...

发表评论