[原创]VB.NET 写的TEA加密算法和解密算法,可直接使用(注：使用的是VB.NET 2008)

  1  ' //   最近想了解一下QQ的协议,但第一就是解决TEA加密算法,在网上找了很久,
  2  ' //发现有很多的版本的,当然也有VB的,但不是VB.NET的.那些VB的已经不能直接用了.
  3  ' //而且现在VB.NET已经可以移位了.看了以前VB写的.为了移位就写了一个函数。
  4  ' //只有C#或C++的两行的核心算法VB却要几十行。找遍了网上也没发现有VB.NET做只能靠自己了。
  5  ' //   TEA加密算我上面说过，其实就只有两行核心代码。但是QQ在使用这个算法的时候，
  6  ' //由于需要加密不定长的数据，所以使用了一些常规的填充办法和交织算法.所以更多是处理填充和交织。
  7  '
  8  ' //    本人E-Mail:   liwqbasic[AT]gamail.com   ([AT]换成@)   QQ: &H12C214E9 [0x12C214E9]
  9  '
 10  '
 11 
 12  Namespace  HashTEA
 13       Public   Class  hashtea
 14   
 15           Private   Const  delta  As   UInteger   =   & H9E3779B9L     ' tea算法的delta值
 16           Private  Plain( 7 )  As   Byte                           ' 指向当前的明文块 
 17           Private  prePlain( 7 )  As   Byte                        ' 指向前面一个明文块 
 18           Private  out()  As   Byte
 19           Private  Crypt  As   UInteger
 20           Private  preCrypt  As   UInteger      ' 当前加密的密文位置和上一次加密的密文块位置，他们相差8 
 21           Private  Pos  As   Long               ' 当前处理的加密解密块的位置 
 22           Private  padding  As   Long           ' 填充数 
 23           Private  Key( 15 )  As   Byte           ' 密钥 
 24           Private  Header  As   Boolean         ' 用于加密时，表示当前是否是第一个8字节块，因为加密算法 
 25           ' 是反馈的，但是最开始的8个字节没有反馈可用，所有需要标明这种情况 
 26           Private  contextStart  As   Long
 27 
 28           Public   Function  UnHashTEA( ByVal  BinFrom  As   Byte (),  ByVal  BinTKey  As   Byte (), _
 29                                   ByVal  offset  As   Integer ,  ByVal  Is16Rounds  As   Boolean )  As   Byte ()
 30 
 31              Crypt  =   0
 32              preCrypt  =   0
 33              Key  =  BinTKey
 34               Dim  count  As   Integer   =   0
 35               Dim  m(offset  +   7 )  As   Byte
 36               Dim  intlen  As   Integer   =  BinFrom.Length
 37 
 38               If  intlen  <   16   Or  (intlen  Mod   8   <>   0 )  Then  ThrowMsg( " Len No Enuf " )
 39 
 40              prePlain  =  Decipher(BinFrom, Key,  True )
 41              Pos  =  prePlain( 0 )  And   & H7
 42              count  =  intlen  -  Pos  -   10
 43 
 44               If  count  <   0   Then  ThrowMsg( " Count No Enuf " )
 45 
 46               For  i  =  offset  To  m.Length  -   1
 47                  m(i)  =   0
 48               Next
 49               ReDim  out(count  -   1 )
 50              preCrypt  =   0
 51              Crypt  =   8
 52              contextStart  =   8
 53              Pos  +=   1
 54 
 55              padding  =   1
 56               While  padding  <=   2
 57 
 58                   If  Pos  <   8   Then
 59                      Pos  +=   1
 60                      padding  +=   1
 61 
 62                   End   If
 63                   If  Pos  =   8   Then
 64                      m  =  BinFrom
 65                       If   Not  (Decrypt8Bytes(BinFrom, offset, intlen))  Then
 66                          ThrowMsg( " Decrypt8Bytes() failed. " )
 67                       End   If
 68                   End   If
 69               End   While
 70 
 71               Dim  i2  =   0
 72               While  count  <>   0
 73                   If  Pos  <   8   Then
 74                      out(i2)  =   CByte (m(offset  +  preCrypt  +  Pos)  Xor  prePlain(Pos))
 75                      i2  +=   1
 76                      count  -=   1
 77                      Pos  +=   1
 78                   End   If
 79 
 80                   If  Pos  =   8   Then
 81                      m  =  BinFrom
 82                      preCrypt  =  Crypt  -   8
 83                      Decrypt8Bytes(BinFrom, offset, intlen)
 84                   End   If
 85 
 86               End   While
 87 
 88               For  i  =   1   To   7
 89                   If  Pos  <   8   Then
 90                       If  (m(offset  +  preCrypt  +  Pos)  Xor  prePlain(Pos))  <>   0   Then
 91                          ThrowMsg( " tail is not filled correct. " )
 92                       End   If
 93                      Pos  +=   1
 94                       If  Pos  =   8   Then
 95                          m  =  BinFrom
 96                           If   Not  (Decrypt8Bytes(BinFrom, offset, intlen))  Then
 97                              ThrowMsg( " Decrypt8Bytes() failed. " )
 98                           End   If
 99 
100                       End   If
101                   End   If
102               Next
103 
104               Return  out
105 
106           End Function
107 
108           Private   Function  Decrypt8Bytes( ByVal   input ()  As   Byte ,  ByVal  offset  As   Integer , _
109                                          ByVal  intlen  As   Integer )  As   Boolean
110 
111               For  i  =   0   To   7
112                   If  contextStart  +  i  >=  intlen  Then
113                       Return   True
114                   End   If
115                  prePlain(i)  =  prePlain(i)  Xor   input (offset  +  Crypt  +  i)
116 
117               Next
118 
119 
120 
121              prePlain  =  Decipher(prePlain, Key,  True )
122               If  prePlain  Is   Nothing   Then
123                   Return   False
124 
125               End   If
126              contextStart  +=   8
127              Crypt  +=   8
128              Pos  =   0
129 
130               Return   True
131           End Function
132 
133           Private   Function  Decipher( ByVal  BinInput()  As   Byte , _
134                                     ByVal  Binkey()  As   Byte ,  ByVal  Is16Rounds  As   Boolean )  As   Byte ()
135               ' 标准tea解密过程,参数ltype 为1时表示16轮迭代(qq使用的就是16轮迭代),否则为32轮迭代
136 
137               Dim  sum  As   Long   =   & HE3779B90L
138               Dim  rounds  As   Integer
139 
140               Dim  y  As   Long   =  GetUInt(BinInput,  0 ,  4 )
141               Dim  z  As   Long   =  GetUInt(BinInput,  4 ,  4 )
142               Dim  a  As   Long   =  GetUInt(Key,  0 ,  4 )
143               Dim  b  As   Long   =  GetUInt(Key,  4 ,  4 )
144               Dim  c  As   Long   =  GetUInt(Key,  8 ,  4 )
145               Dim  d  As   Long   =  GetUInt(Key,  12 ,  4 )
146 
147               If  Is16Rounds  Then
148                  rounds  =   16
149               Else
150                  rounds  =   32
151               End   If
152               Dim  Test  As   Long   =   0
153               For  i  =   1   To  rounds
154 
155                  Test  =  ((y  <<   4 )  +  c)  Xor  (y  +  sum)  Xor  ((y  >>   5 )  +  d)
156                  z  -=  Test
157                  z  =  z  And   & HFFFFFFFFL
158 
159                  Test  =  ((z  <<   4 )  +  a)  Xor  (z  +  sum)  Xor  ((z  >>   5 )  +  b)
160                  y  -=  Test
161                  y  =  y  And   & HFFFFFFFFL
162 
163                  sum  -=  delta
164                  sum  =  sum  And   & HFFFFFFFFL
165 
166               Next
167 
168               Return  ToBytes(y, z)
169           End Function
170 
171           Public   Function  HashTEA( ByVal  BinFrom  As   Byte (),  ByVal  BinTKey  As   Byte (), _
172                                   ByVal  offset  As   Integer ,  ByVal  Is16Rounds  As   Boolean )  As   Byte ()
173 
174              Header  =   True
175              Key  =  BinTKey
176              Pos  =   1
177              padding  =   0
178              Crypt  =   0
179              preCrypt  =   0
180               Dim  intlen  As   Integer   =  BinFrom.Length
181               Dim  xRnd  As   New  Random
182              Pos  =  (intlen  +   10 )  Mod   8
183 
184               If  Pos  <>   0   Then  Pos  =   8   -  Pos
185               ReDim  out(intlen  +  Pos  +   9 )
186 
187 
188 
189              Plain( 0 )  =   CByte ((xRnd.Next  And   & HF8)  Or  Pos)
190 
191               For  i  =   1   To  Pos
192                  Plain(i)  =   CByte (xRnd.Next  And   & HFF)
193               Next
194 
195               For  i  =   0   To   7
196                  prePlain(i)  =   CByte ( & H0)
197               Next
198 
199              Pos  +=   1
200              padding  =   1
201               Do   While  padding  <   3
202                   If  Pos  <   8   Then
203                      Plain(Pos)  =   CByte (xRnd.Next  And   & HFF)
204                      Pos  +=   1
205                      padding  +=   1
206 
207                   Else
208                      Encrypt8Bytes(Is16Rounds)
209                   End   If
210               Loop
211 
212               Dim  i2  =  offset
213               While  intlen  >   0
214                   If  Pos  <   8   Then
215 
216                      Plain(Pos)  =  BinFrom(i2)
217                      Pos  +=   1
218                      intlen  -=   1
219 
220                      i2  +=   1
221                   Else
222                      Encrypt8Bytes(Is16Rounds)
223 
224                   End   If
225               End   While
226 
227              padding  =   1
228               While  padding  <   8
229                   If  Pos  <   8   Then
230 
231                      Plain(Pos)  =   & H0
232                      padding  +=   1
233                      Pos  +=   1
234                   End   If
235 
236                   If  Pos  =   8   Then
237                      Encrypt8Bytes(Is16Rounds)
238                   End   If
239               End   While
240 
241               Return  out
242           End Function
243 
244           Private   Sub  Encrypt8Bytes( ByVal  Is16Rounds  As   Boolean )
245               Dim  Crypted()  As   Byte
246              Pos  =   0
247               For  i  =   0   To   7
248                   If  Header  Then
249                      Plain(i)  =  Plain(i)  Xor  prePlain( 0 )
250                   Else
251                      Plain(i)  =  Plain(i)  Xor  out(preCrypt  +  i)
252                   End   If
253               Next
254              Crypted  =  Encipher(Plain, Key, Is16Rounds)
255              Array.Copy(Crypted,  0 , out, Crypt,  8 )
256               For  i  =   0   To   7
257                  out(Crypt  +  i)  =  out(Crypt  +  i)  Xor  prePlain(i)
258 
259               Next
260              Array.Copy(Plain,  0 , prePlain,  0 ,  8 )
261              preCrypt  =  Crypt
262              Crypt  +=   8
263              Pos  =   0
264              Header  =   False
265 
266           End Sub
267 
268           Private   Function  Encipher( ByVal  BinInput()  As   Byte ,  ByVal  k()  As   Byte ,  ByVal  Is16Rounds  As   Boolean )
269               ' 标准的tea加密过程,参数 Is16Rounds 为True时表示16轮迭代(qq使用的就是16轮迭代),否则为32轮迭代
270 
271               Dim  sum  As   ULong
272 
273               Dim  rounds  As   Integer
274 
275               Dim  y  As   ULong   =  GetUInt(BinInput,  0 ,  4 )
276               Dim  z  As   ULong   =  GetUInt(BinInput,  4 ,  4 )
277               Dim  a  As   ULong   =  GetUInt(Key,  0 ,  4 )
278               Dim  b  As   ULong   =  GetUInt(Key,  4 ,  4 )
279               Dim  c  As   ULong   =  GetUInt(Key,  8 ,  4 )
280               Dim  d  As   ULong   =  GetUInt(Key,  12 ,  4 )
281 
282               If  Is16Rounds  Then
283                  rounds  =   16
284               Else
285                  rounds  =   32
286               End   If
287 
288               For  i  =   1   To  rounds
289                  sum  =  sum  And   & HFFFFFFFFL
290                  sum  +=  delta
291                  z  =  z  And   & HFFFFFFFFL
292                  y  +=  ((z  <<   4 )  +  a)  Xor  (z  +  sum)  Xor  ((z  >>   5 )  +  b)
293                  y  =  y  And   & HFFFFFFFFL
294                  z  +=  ((y  <<   4 )  +  c)  Xor  (y  +  sum)  Xor  ((y  >>   5 )  +  d)
295 
296 
297               Next
298 
299               Return  ToBytes(y, z)
300           End Function
301 
302           Public   Function  GetUInt( ByVal   input   As   Byte (),  ByVal  ioffset  As   Integer ,  ByVal  intlen  As   Integer )  As   UInteger
303 
304               Dim  ret  As   UInteger   =   0
305               Dim  lend  As   Integer   =   IIf ((intlen  >   4 ), (ioffset  +   4 ), (ioffset  +  intlen))
306               For  i  =  ioffset  To  lend  -   1
307                  ret  <<=   8
308                  ret  =  ret  Or   input (i)
309               Next
310               Return  ret
311           End Function
312 
313           Public   Function  ToBytes( ByVal  a  As   ULong ,  ByVal  b  As   ULong )  As   Byte ()
314 
315               Dim  bytes( 7 )  As   Byte
316 
317              bytes( 0 )  =   CByte ((a  >>   24 )  And   & HFF)
318              bytes( 1 )  =   CByte ((a  >>   16 )  And   & HFF)
319              bytes( 2 )  =   CByte ((a  >>   8 )  And   & HFF)
320              bytes( 3 )  =   CByte ((a)  And   & HFF)
321              bytes( 4 )  =   CByte ((b  >>   24 )  And   & HFF)
322              bytes( 5 )  =   CByte ((b  >>   16 )  And   & HFF)
323              bytes( 6 )  =   CByte ((b  >>   8 )  And   & HFF)
324              bytes( 7 )  =   CByte ((b)  And   & HFF)
325               Return  bytes
326 
327           End Function
328 
329           Private   Sub  ThrowMsg( ByVal  TMsg  As   String )
330               Dim  Trmsg  As   New  MQQException(TMsg)
331               Throw  Trmsg
332           End Sub
333 
334       End Class
335 
336       Public   Class  MQQException
337           Inherits  System.ApplicationException
338 
339           Public   Sub   New ( ByVal  StrMsg  As   String )
340               MyBase .New(StrMsg)
341 
342           End Sub
343 
344       End Class
345 
346  End Namespace
347 
348 

转载于:https://www.cnblogs.com/ExeLive/archive/2008/03/07/1095097.html