TEA Encryption Algorithm Source

The source is available under the MIT license. Download code and the testing program (CodeTea.zip: date 2007.02.07, size 11 949 bytes, md5 6c616ebb62ee7f87fd1460f8ad5510b6)

The unit uTeaSet.pas implements TEA, XTEA, Block TEA and XXTEA algorithms. This is a direct translation from the original C code by David Wheeler & Roger Needham, Cambridge University Computer Lab:

TEA: http://www.cl.cam.ac.uk/ftp/papers/djw-rmn/djw-rmn-tea.html (1994)
XTEA, Block TEA: http://www.cl.cam.ac.uk/ftp/users/djw3/xtea.ps (1997)
XXTEA: http://www.cl.cam.ac.uk/ftp/users/djw3/xxtea.ps (1998)
The unit also contains some useful routines.

unit uTeaSet;
{Pascal/Delphi implementation of TEA - Tiny Encryption Algorithm
Algorithms: TEA, XTEA, BlockTEA, XXTEA
author: Nikolai Shokhirev
created: April 04, 2004
modified: May 05, 2004
last modified: February 17, 2006 - corrected XTeaEncrypt/XTeaDecrypt
Thanks to Pedro Gimeno Fortea }

interface

const
Delta: longword = $9e3779b9;

type

TLong2 = array[0.. 1] of Longword; // 64-bit
TTeaKey = array[0..3] of longword; // 128-bit
TByte16 = array[0..15] of byte; // 128-bit
TByte4 = array[0..3] of byte; // 32-bit
TTeaData = array of longword; // n*32-bit
TByteArrData = array of byte; // n*8-bit

// Algorithm: David Wheeler & Roger Needham, Cambridge University Computer Lab
// TEA: http://www.cl.cam.ac.uk/ftp/papers/djw-rmn/djw-rmn-tea.html (1994)
procedure TeaEncrypt(var data: TLong2; const key: TTeaKey);
procedure TeaDecrypt(var data: TLong2; const key: TTeaKey);

// Algorithm: David Wheeler & Roger Needham, Cambridge University Computer Lab
// XTEA: http://www.cl.cam.ac.uk/ftp/users/djw3/xtea.ps (1997)
procedure XTeaEncrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);
procedure XTeaDecrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);

// Algorithm: David Wheeler & Roger Needham, Cambridge University Computer Lab
// Block TEA: http://www.cl.cam.ac.uk/ftp/users/djw3/xtea.ps (1997)
procedure BlockTeaEncrypt(data: TTeaData; const key: TTeaKey);
procedure BlockTeaDecrypt(data: TTeaData; const key: TTeaKey);

// Algorithm: David Wheeler & Roger Needham, Cambridge University Computer Lab
// XXTEA: http://www.cl.cam.ac.uk/ftp/users/djw3/xxtea.ps (1998)
procedure XXTeaEncrypt(data: TTeaData; const key: TTeaKey);
procedure XXTeaDecrypt(data: TTeaData; const key: TTeaKey);

// comparison of TTeaKey type variables
function SameKey(const key1, key2: TTeaKey): boolean;

// Conversion routines
procedure StrToKey(const s: string; var key: TTeaKey);
function KeyToStr(const key: TTeaKey): string;

// Conversion routines
procedure StrToData(const s: string; var data: TTeaData);
procedure DataToStr(var s: string; const data: TTeaData);

// reads a file of longword
procedure ReadData(const FileName: string; var data: TTeaData);
// writes a file of longword
procedure WriteData(const FileName: string; var data: TTeaData);

implementation

uses
math, SysUtils;

procedure TeaEncrypt(var data: TLong2; const key: TTeaKey);
var
y,z,sum: Longword;
a:byte;
begin
y:=data[0];
z:=data[1];
sum:=0;
for a:=0 to 31 do
begin
{ c code:
sum += delta;
y += (z << 4)+key[0] ^ z+sum ^ (z >> 5)+key[1];
z += (y << 4)+key[2] ^ y+sum ^ (y >> 5)+key[3];
}
inc(sum,Delta);
inc(y,((z shl 4)+key[0]) xor (z+sum) xor ((z shr 5)+key[1]));
inc(z,((y shl 4)+key[2]) xor (y+sum) xor ((y shr 5)+key[3]));
end;
data[0]:=y;
data[1]:=z
end;

procedure TeaDecrypt(var data: TLong2; const key: TTeaKey);
var
y,z,sum: Longword;
a:byte;
begin
y:=data[0];
z:=data[1];
sum:=delta shl 5;
for a:=0 to 31 do
begin
{ c code:
z -= (y << 4)+key[2] ^ y+sum ^ (y >> 5)+key[3];
y -= (z << 4)+key[0] ^ z+sum ^ (z >> 5)+key[1];
sum -= delta;
}
dec(z,((y shl 4)+key[2]) xor (y+sum) xor ((y shr 5)+key[3]));
dec(y,((z shl 4)+key[0]) xor (z+sum) xor ((z shr 5)+key[1]));
dec(sum,Delta);
end;
data[0]:=y;
data[1]:=z
end;

procedure XTeaEncrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);
var
y,z,sum,limit: Longword;
begin
y:=data[0];
z:=data[1];
sum:=0;
limit := Delta*N;
while sum <> limit do
begin
{ c code:
y += (z << 4 ^ z >> 5) + z ^ sum + key[sum&3];
sum += delta;
z += (y << 4 ^ y >> 5) + y ^ sum + key[sum>>11 & 3];
}
// inc(y,((z shl 4) xor (z shr 5)) xor (sum+key[sum and 3]));
inc(y,(((z shl 4) xor (z shr 5)) + z) xor (sum+key[sum and 3]));
inc(sum,Delta);
// inc(z,((y shl 4) xor (y shr 5)) xor (sum+key[(sum shr 11) and 3]));
inc(z,(((y shl 4) xor (y shr 5)) + y) xor (sum+key[(sum shr 11) and 3]));
end;
data[0]:=y;
data[1]:=z
end;

procedure XTeaDecrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);
var
y,z,sum: Longword;
begin
y:=data[0];
z:=data[1];
sum:=Delta*N;
while sum <> 0 do
begin
{ c code:
z -= (y << 4 ^ y >> 5) + y ^ sum + key[sum>>11 & 3];
sum -= delta;
y -= (z << 4 ^ z >> 5) + z ^ sum + key[sum&3];
}
// dec(z,((y shl 4) xor (y shr 5)) xor (sum+key[(sum shr 11) and 3]));
dec(z,(((y shl 4) xor (y shr 5)) + y) xor (sum+key[(sum shr 11) and 3]));
dec(sum,Delta);
// dec(y,((z shl 4) xor (z shr 5)) xor (sum+key[sum and 3]));
dec(y,(((z shl 4) xor (z shr 5)) + z) xor (sum+key[sum and 3]));
end;
data[0]:=y;
data[1]:=z
end;

procedure BlockTeaEncrypt(data: TTeaData; const key: TTeaKey);
var
z, y, sum, e, p: longword;
q, n: integer;

function mx: longword;
begin
result := (((z shl 4) xor (z shr 5)) + z) xor (key[(p and 3) xor e] + sum);
end;

begin
n := Length(data);
q := 6 + 52 div n;
z := data[n-1];
sum := 0;
repeat
inc(sum,Delta);
e := (sum shr 2) and 3;
for p := 0 to n-1 do
begin
y := data[p];
inc(y,mx);
data[p] := y;
z := y;
end;
dec(q);
until q = 0;
end;

procedure BlockTeaDecrypt(data: TTeaData; const key: TTeaKey);
var
z, y, sum, e, p, q: longword;
n: integer;

function mx: longword;
begin
result := (((z shl 4) xor (z shr 5)) + z) xor (key[(p and 3) xor e] + sum);
end;

begin
n := Length(data);
q := 6 + 52 div n;
sum := q*Delta;
while sum <> 0 do
begin
e := (sum shr 2) and 3;
for p := n-1 downto 1 do
begin
z := data[p-1];
y := data[p];
dec(y,mx);
data[p] := y;
end;
z := data[n-1];
y := data[0];
dec(y,mx);
data[0] := y;
dec(sum,Delta);
end;
end;

procedure XXTeaEncrypt(data: TTeaData; const key: TTeaKey);
var
z, y, x, sum, e, p: longword;
q, n: integer;

function mx: longword;
begin
result := (((z shr 5) xor (y shl 2)) + ((y shr 3) xor (z shl 4))) xor ((sum xor y) + (key[(p and 3) xor e] xor z) );
end;

begin
n := Length(data);
q := 6 + 52 div n;
z := data[n-1];
y := data[0];
sum := 0;
repeat
inc(sum,Delta);
e := (sum shr 2) and 3;
for p := 0 to n-2 do
begin
y := data[p+1];
x := data[p];
inc(x,mx);
data[p] := x;
z := x;
end;
y := data[0];
x := data[n-1];
inc(x,mx);
data[n-1] := x;
z := x;
dec(q);
until q = 0;
end;

procedure XXTeaDecrypt(data: TTeaData; const key: TTeaKey);
var
z, y, x, sum, e, p, q: longword;
n: integer;

function mx: longword;
begin
result := (((z shr 5) xor (y shl 2)) + ((y shr 3) xor (z shl 4))) xor ((sum xor y) + (key[(p and 3) xor e] xor z) );
end;

begin
n := Length(data);
q := 6 + 52 div n;
z := data[n-1];
y := data[0];
sum := q*Delta;
while sum <> 0 do
begin
e := (sum shr 2) and 3;
for p := n-1 downto 1 do
begin
z := data[p-1];
x := data[p];
dec(x,mx);
data[p] := x;
y := x;
end;
z := data[n-1];
x := data[0];
dec(x,mx);
data[0] := x;
y := x;
dec(sum,Delta);
end;
end;

function SameKey(const key1, key2: TTeaKey): boolean;
var
i: integer;
begin
result := false;
for i := 0 to 3 do
if key1[i] <> key2[i] then
exit;
result := true;
end;

procedure StrToKey(const s: string; var key: TTeaKey);
var
sa, sb: AnsiString;
i, n: integer;
begin
sa := AnsiString(s);
sb := StringOfChar(' ',16);
n := min(Length(sa),16);
for i := 1 to n do
sb[i] := sa[i];
for i := 1 to 16 do
TByte16(key)[i-1] := ord(sb[i]);
sa := '';
sb := '';
end;

function KeyToStr(const key: TTeaKey): string;
var
s: AnsiString;
i: integer;
begin
SetLength(s,16);
for i := 1 to 16 do
begin
s[i] := Chr(TByte16(key)[i-1]);
end;
result := s;
end;

procedure StrToData(const s: string; var data: TTeaData);
var
sa: AnsiString;
i, n, m: integer;
begin
sa := AnsiString(s);
n := Length(sa) div 4;
m := Length(sa) mod 4;
if m <> 0 then
begin
inc(n);
sa := sa + StringOfChar(' ',m);
end;
if n < 2 then // n = 1
begin
n := 2;
sa := sa + StringOfChar(' ',4);
end;

SetLength(data,n);
for i := 0 to n-1 do
for m := 0 to 3 do
TByte4(data[i])[m] := ord(sa[i*4+m+1]);
sa := '';
end;

procedure DataToStr(var s: string; const data: TTeaData);
var
sa: AnsiString;
i, n, m: integer;
b: byte;
begin
n := Length(data);
SetLength(sa,n*4);
for i := 0 to n-1 do
for m := 0 to 3 do
begin
b := TByte4(data[i])[m];
sa[i*4+m+1] := Chr(b);
end;
s := Trim(sa);
sa := '';
end;

procedure ReadData(const FileName: string; var data: TTeaData);
var
i, n: integer;
ww: longword;
wwf: file of longword;
begin
try
AssignFile(wwf,FileName);
Reset(wwf);
n := FileSize(wwf);
SetLength(data,n);
for i := 0 to n-1 do
begin
read(wwf,ww);
data[i] := ww;
end;
finally
CloseFile(wwf);
end;
end;

procedure WriteData(const FileName: string; var data: TTeaData);
var
i, n: integer;
ww: longword;
wwf: file of longword;
begin
try
AssignFile(wwf,FileName);
Rewrite(wwf);
n := Length(data);
for i := 0 to n-1 do
begin
ww := data[i];
write(wwf,ww);
end;
finally
CloseFile(wwf);
end;
end;

end.