[原创]TEA算法的VB实现代码

前些日子不少人都要挂QQ,有客户需求就自然有人去研究,所以不少人开始研究QQ的协议.其中最重要的一步就是研究QQ使用的加密算法---TEA算法

关于TEA算法的描述以及C语言源码这里就不多说了,现在给出该算法的VB实现

'       ----------------------------------------------------------------------------------
'      |                                                                                  |
'      |                                标准TEA加密解密模块                               |
'      |                                     Zeffy 制作                                   |
'      |                                     QQ:8481862                                   |
'      |                             Email:[e-mail]                             |
'      |                                                                                  |
'      |                                     2005.8.16                                    |
'      |                                                                                  |
'       ----------------------------------------------------------------------------------

Private Const OFFSET_4 = 4294967296#    '&h100000000 的数值
Private Const MAXINT_4 = 2147483647     '整型数据所能表示的最大正数值 (&h7fffffff)
Private Const Bit_32 = 2147483648#      '&h80000000 的正整数形式
Private Const DELTA = &H9E3779B9        'TEA算法的DELTA值

Private Function AddLong(lX As Long, lY As Long) As Long '长整数加法函数
    Dim lX4 As Long
    Dim lY4 As Long
    Dim lX8 As Long
    Dim lY8 As Long
    Dim lResult As Long
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddLong = lResult
End Function

Private Function SubtractLong(lX As Long, lY As Long) As Long '长整数减法函数
    Dim lX8 As Long
    Dim lY8 As Long
    Dim mX As Double
    Dim mY As Double
    Dim mResult As Double
    Dim lResult As Long
   
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
   
    mX = lX And &H7FFFFFFF
    mY = lY And &H7FFFFFFF
   
    If lX8 Then
       If lY8 Then
          mResult = mX - mY
       Else
          mX = mX + Bit_32
          mResult = mX - mY
       End If
    Else
       If lY8 Then
          mY = lY
          mResult = mX - mY
       Else
          mResult = mX - mY
       End If
    End If
   
   
    If mResult < 0 Then
       lResult = ((Bit_32 + mResult) Or &H80000000) And &HFFFFFFFF
    ElseIf mResult > MAXINT_4 Then
       lResult = ((mResult - Bit_32) Or &H80000000) And &HFFFFFFFF
    Else
       lResult = mResult And &HFFFFFFFF
    End If
   
    SubtractLong = lResult
 
End Function

Private Function LeftRotateLong(lValue As Long, lBits As Integer) As Long '按位左移函数
    Dim lngSign As Long, intI As Integer
    Dim mValue As Long
   
    lBits = lBits Mod 32
    mValue = lValue
    If lBits = 0 Then LeftRotateLong = mValue: Exit Function
   
    For intI = 1 To lBits
        lngSign = mValue And &H40000000
        mValue = (mValue And &H3FFFFFFF) * 2
    
        If lngSign And &H40000000 Then
           mValue = mValue Or &H80000000
        End If
    Next
   
    LeftRotateLong = mValue
End Function

Private Function RightRotateLong(lValue As Long, lBits As Integer) As Long '按位右移函数
   Dim lngSign As Long, intI As Integer
   Dim mValue As Long
  
   mValue = lValue
   lBits = lBits Mod 32
  
   If lBits = 0 Then RightRotateLong = mValue: Exit Function
  
   For intI = 1 To lBits
      lngSign = mValue And &H80000000
      mValue = (mValue And &H7FFFFFFF) / 2
      If lngSign Then
         mValue = mValue Or &H40000000
      End If
   Next
   RightRotateLong = mValue
End Function

Public Sub TeaEncode(v() As Long, k() As Long, lType As Integer) '标准的TEA加密过程,参数lType 为1时表示16轮迭代(QQ使用的就是16轮迭代),否则为32轮迭代
   Dim Y As Long, Z As Long
   Dim K1 As Long, K2 As Long, K3 As Long, K4 As Long
   Dim L1 As Long, L2 As Long, L3 As Long, L4 As Long
  
   Dim Sum As Long
   Dim i As Integer, Rounds As Integer
   Dim mResult(0 To 1) As Long
     
   Y = v(0)
   Z = v(1)
   K1 = k(0)
   K2 = k(1)
   K3 = k(2)
   K4 = k(3)
  
   If lType = 1 Then
      Rounds = 16
   Else
      Rounds = 32
   End If
  
   For i = 1 To Rounds
      'sum += delta ;
      Sum = AddLong(Sum, DELTA)
      'y += (z<<4)+k[0] ^ z+sum ^ (z>>5)+k[1]
      L1 = LeftRotateLong(Z, 4)
      L1 = AddLong(L1, K1)
      L2 = AddLong(Z, Sum)
      L3 = RightRotateLong(Z, 5)
      L3 = AddLong(L3, K2)
      L4 = L1 Xor L2 Xor L3
      Y = AddLong(Y, L4)
      'z += (y<<4)+k[2] ^ y+sum ^ (y>>5)+k[3]
      L1 = LeftRotateLong(Y, 4)
      L1 = AddLong(L1, K3)
      L2 = AddLong(Y, Sum)
      L3 = RightRotateLong(Y, 5)
      L3 = AddLong(L3, K4)
      L4 = L1 Xor L2 Xor L3
      Z = AddLong(Z, L4)
   Next
  
   v(0) = Y
   v(1) = Z
End Sub

Public Sub TeaDecode(v() As Long, k() As Long, lType As Integer) '标准TEA解密过程,参数lType 为1时表示16轮迭代(QQ使用的就是16轮迭代),否则为32轮迭代
   Dim Y As Long, Z As Long
   Dim K1 As Long, K2 As Long, K3 As Long, K4 As Long
   Dim L1 As Long, L2 As Long, L3 As Long, L4 As Long
   Dim Sum As Long
   Dim i As Integer, Rounds As Integer
   Dim mResult(0 To 1) As Long
     
   Y = v(0)
   Z = v(1)
   K1 = k(0)
   K2 = k(1)
   K3 = k(2)
   K4 = k(3)
  
   If lType = 1 Then
      Rounds = 16
      Sum = LeftRotateLong(DELTA, 4)
   Else
      Rounds = 32
      Sum = LeftRotateLong(DELTA, 5)
   End If
  
   For i = 1 To Rounds

      L1 = LeftRotateLong(Y, 4)
      L1 = AddLong(L1, K3)
      L2 = AddLong(Y, Sum)
      L3 = RightRotateLong(Y, 5)
      L3 = AddLong(L3, K4)
      L4 = L1 Xor L2 Xor L3
      Z = SubtractLong(Z, L4)
     
      L1 = LeftRotateLong(Z, 4)
      L1 = AddLong(L1, K1)
      L2 = AddLong(Z, Sum)
      L3 = RightRotateLong(Z, 5)
      L3 = AddLong(L3, K2)
      L4 = L1 Xor L2 Xor L3
      Y = SubtractLong(Y, L4)

      Sum = SubtractLong(Sum, DELTA)
  
   Next

  v(0) = Y
  v(1) = Z
End Sub