Option Strict Off
Option Explicit On
Module MxTea
	'*****************************************************************************
	'* MXTEA.VB  -  XTEA-Encryption/Decryption
	'*
	'* (C) TDi GmbH
	'*
	'* Implementation for VB.NET
	'*****************************************************************************
	'* The 'Extended Tiny Encryption Algorithm' (XTEA) by David Wheeler and 
	'* Roger Needham of the Cambridge Computer Laboratory.
	'* XTEA is a Feistel cipher with XOR and AND addition as the non-linear
	'* mixing functions.
	'* Takes 64 bits (8 Bytes block) of data in Data[0] and Data[1].
	'* Returns 64 bits of encrypted data in Data[0] and Data[1].
	'* Takes 128 bits of key in Key[0] - Key[3].
	'*
	'* In the calling routine, declare:
	'*    Dim Key(4)  As Integer
	'*    Dim Data(2) As Integer
	'*
	'* Then call the function:
	'*    Call MxApp_Encrypt(Data(), Key())
	'*    Call MxApp_Decrypt(Data(), Key())
	'*****************************************************************************
	
	Private Declare Sub CopyMemByteToLong Lib "kernel32"  Alias "RtlMoveMemory"(ByRef Destination As Integer, ByRef Source As Byte, ByVal Length As Integer)
	Private Declare Sub CopyMemLongToByte Lib "kernel32"  Alias "RtlMoveMemory"(ByRef Destination As Byte, ByRef Source As Integer, ByVal Length As Integer)
	
	
	
	Sub MxApp_Encrypt(ByRef Data() As Integer, ByRef Key() As Integer)
		
		Const Rounds As Short = 32
		Const Delta As Integer = &H9E3779B9
		Dim Sum As Integer
		Dim Cnt As Short
		Dim Idxl, Idxr As Short
		Dim a, b As Integer
		
		Sum = 0
		
		For Cnt = 1 To Rounds
			
			'*** new TEA:  Data[0] += (Data[1]<<4 ^ Data[1]>>5) + Data[1] ^ sum + k[sum&3];
			Idxr = Sum And 3
			a = UnsignedAdd(LShift4(Data(1)) Xor RShift5(Data(1)), Data(1))
			b = UnsignedAdd(Sum, Key(Idxr))
			Data(0) = UnsignedAdd(Data(0), a Xor b)
			
			Sum = UnsignedAdd(Sum, Delta)
			
			'*** new TEA:  Data[1] += (Data[0]<<4 ^ Data[0]>>5) + Data[0] ^ sum + k[sum>>11 & 3];
			Idxl = CShort(RShift11(Sum) And 3)
			a = UnsignedAdd(LShift4(Data(0)) Xor RShift5(Data(0)), Data(0))
			b = UnsignedAdd(Sum, Key(Idxl))
			Data(1) = UnsignedAdd(Data(1), a Xor b)
			
		Next 
		
		'*** Display Data(0)/Data(1) as HEX-Long ***
		' MsgBox "Encrypt: " & Hex(Data(0)) & "  :  " & Hex(Data(1))
		
	End Sub

	
	Sub MxApp_Decrypt(ByRef Data() As Integer, ByRef Key() As Integer)
		
		Const Rounds As Short = 32
		Const Delta As Integer = &H9E3779B9
		Dim Sum As Integer
		Dim Cnt As Short
		Dim Idxl, Idxr As Short
		Dim a, b As Integer
		
		Sum = &HC6EF3720
		
		For Cnt = 1 To Rounds
			
			'*** XTEA:  Data[1] += (Data[0]<<4 ^ Data[0]>>5) + Data[0] ^ sum + k[sum>>11 & 3];
			Idxl = CShort(RShift11(Sum) And 3)
			a = UnsignedAdd(LShift4(Data(0)) Xor RShift5(Data(0)), Data(0))
			b = UnsignedAdd(Sum, Key(Idxl))
			Data(1) = UnsignedSubtract(Data(1), a Xor b)
			
			Sum = UnsignedSubtract(Sum, Delta)
			
			'*** XTEA:  Data[0] += (Data[1]<<4 ^ Data[1]>>5) + Data[1] ^ sum + k[sum&3];
			Idxr = Sum And 3
			a = UnsignedAdd(LShift4(Data(1)) Xor RShift5(Data(1)), Data(1))
			b = UnsignedAdd(Sum, Key(Idxr))
			Data(0) = UnsignedSubtract(Data(0), a Xor b)
			
		Next 
		
		'*** Display Data(0)/Data(1) as HEX-Long ***
		' MsgBox "Decrypt: " & Hex(Data(0)) & "  :  " & Hex(Data(1))
		
	End Sub
	
	'-----------------------------------------------------------------------------
	
	Private Function LShift4(ByRef Data1 As Integer) As Integer
		Static x1(3) As Byte
		Static xx(3) As Byte
		Call CopyMemLongToByte(x1(0), Data1, 4)
		xx(0) = (CShort(x1(0) And 15) * 16)
		xx(1) = (CShort(x1(1) And 15) * 16) Or ((x1(0) And 240) \ 16)
		xx(2) = (CShort(x1(2) And 15) * 16) Or ((x1(1) And 240) \ 16)
		xx(3) = (CShort(x1(3) And 15) * 16) Or ((x1(2) And 240) \ 16)
		Call CopyMemByteToLong(LShift4, xx(0), 4)
	End Function
	
	Private Function RShift5(ByRef Data1 As Integer) As Integer
		Static x1(3) As Byte
		Static xx(3) As Byte
		Call CopyMemLongToByte(x1(0), Data1, 4)
		xx(0) = ((x1(0) And 224) \ 32) Or (CShort(x1(1) And 31) * 8)
		xx(1) = ((x1(1) And 224) \ 32) Or (CShort(x1(2) And 31) * 8)
		xx(2) = ((x1(2) And 224) \ 32) Or (CShort(x1(3) And 31) * 8)
		xx(3) = ((x1(3) And 224) \ 32)
		Call CopyMemByteToLong(RShift5, xx(0), 4)
	End Function
	
	Private Function RShift11(ByRef Data1 As Integer) As Integer
		Static x1(3) As Byte
		Static xx(3) As Byte
		Call CopyMemLongToByte(x1(0), Data1, 4)
		xx(0) = ((x1(1) And 248) \ 8) Or (CShort(x1(2) And 7) * 8)
		xx(1) = ((x1(2) And 248) \ 8) Or (CShort(x1(3) And 7) * 8)
		xx(2) = ((x1(3) And 248) \ 8)
		xx(3) = 0
		Call CopyMemByteToLong(RShift11, xx(0), 4)
	End Function
	
	Private Function UnsignedAdd(ByVal Data1 As Integer, ByVal Data2 As Integer) As Integer
		Static x1(3) As Byte
		Static x2(3) As Byte
		Static xx(3) As Byte
		Static Rest As Integer
		Static Value As Integer
		Static a As Integer
		Call CopyMemLongToByte(x1(0), Data1, 4)
		Call CopyMemLongToByte(x2(0), Data2, 4)
		Rest = 0
		For a = 0 To 3
			Value = CInt(x1(a)) + CInt(x2(a)) + Rest
			xx(a) = Value And 255
			Rest = Value \ 256
		Next 
		Call CopyMemByteToLong(UnsignedAdd, xx(0), 4)
	End Function

	Private Function UnsignedSubtract(ByVal Data1 As Integer, ByVal Data2 As Integer) As Integer
		Static x1(3) As Byte
		Static x2(3) As Byte
		Static xx(3) As Byte
		Static Rest As Integer
		Static Value As Integer
		Static a As Integer
		Call CopyMemLongToByte(x1(0), Data1, 4)
		Call CopyMemLongToByte(x2(0), Data2, 4)
		Call CopyMemLongToByte(xx(0), UnsignedSubtract, 4)
		Rest = 0
		For a = 0 To 3
			Value = CLng(x1(a)) - CLng(x2(a)) - Rest
			If (Value < 0) Then
				Value = Value + 256
				Rest = 1
			Else
				Rest = 0
			End If
			xx(a) = Value
		Next 
		Call CopyMemByteToLong(UnsignedSubtract, xx(0), 4)
	End Function
End Module
