{
***************************************************
* A binary compatible RC2 implementation          *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 64bit block encryption                          *
* Variable size key - up to 1024bit               *
***************************************************
}
unit RC2;

interface
uses
  Sysutils, Tools;

type
  TRC2Data= record
    InitBlock: array[0..7] of byte;    { initial IV }
    LastBlock: array[0..7] of byte;    { current IV }
    case integer of
      0: (KeyB: array[0..127] of byte);
      1: (KeyW: array[0..63] of word);
  end;

function RC2SelfTest: boolean;
  { performs a self test on this implementation }
procedure RC2Init(var Data: TRC2Data; Key: pointer; Len: integer; IV: pointer);
  { initializes the TRC2Data structure with the key information and IV if applicable }
procedure RC2Burn(var Data: TRC2Data);
  { erases all information about the key }

procedure RC2EncryptECB(var Data: TRC2Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the ECB mode }
procedure RC2EncryptCBC(var Data: TRC2Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the CBC chaining mode }
procedure RC2EncryptOFB(var Data: TRC2Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the OFB chaining mode }
procedure RC2EncryptCFB(var Data: TRC2Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the CFB chaining mode }
procedure RC2EncryptOFBC(var Data: TRC2Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the OFB counter chaining mode }

procedure RC2DecryptECB(var Data: TRC2Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the ECB mode }
procedure RC2DecryptCBC(var Data: TRC2Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the CBC chaining mode }
procedure RC2DecryptOFB(var Data: TRC2Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the OFB chaining mode }
procedure RC2DecryptCFB(var Data: TRC2Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the CFB chaining mode }
procedure RC2DecryptOFBC(var Data: TRC2Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the OFB counter chaining mode }

procedure RC2Reset(var Data: TRC2Data);
  { resets the chaining mode information }

{******************************************************************************}
implementation

{$I RC2.Inc}

function RC2SelfTest;
const
  Key: array[0..15] of byte=
    ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F);
  InBlock: array[0..7] of byte=
    ($00,$00,$00,$00,$00,$00,$00,$00);
  OutBlock: array[0..7] of byte=
    ($50,$DC,$01,$62,$BD,$75,$7F,$31);
var
  Block: array[0..7] of byte;
  Data: TRC2Data;
begin
  RC2Init(Data,@Key,Sizeof(Key),nil);
  RC2EncryptECB(Data,@InBlock,@Block);
  Result:= CompareMem(@Block,@OutBlock,Sizeof(Block));
  RC2DecryptECB(Data,@Block,@Block);
  Result:= Result and CompareMem(@Block,@InBlock,Sizeof(Block));
  RC2Burn(Data);
end;

procedure RC2Init;
var
  i: integer;
begin
  if (Len<= 0) or (Len> 128) then
    raise Exception.Create('RC2: Invalid key length');
  with Data do
  begin
    if IV= nil then
    begin
      FillChar(InitBlock,8,0);
      FillChar(LastBlock,8,0);
    end
    else
    begin
      Move(IV^,InitBlock,8);
      Move(IV^,LastBlock,8);
    end;
    Move(Key^,KeyB,Len);
    for i:= Len to 127 do
      KeyB[i]:= sBox[(KeyB[i-Len]+KeyB[i-1]) and $FF];
    KeyB[0]:= sBox[KeyB[0]];
  end;
end;

procedure RC2Burn;
begin
  FillChar(Data,Sizeof(Data),0);
end;

procedure RC2EncryptECB;
var
  i, j: integer;
  w0, w1, w2, w3: word;
begin
  Move(InData^,w0,2);
  Move(pointer(integer(InData)+2)^,w1,2);
  Move(pointer(integer(InData)+4)^,w2,2);
  Move(pointer(integer(InData)+6)^,w3,2);
  for i:= 0 to 15 do
  begin
    j:= i*4;
    w0:= Lrot16((w0+(w1 and (w3 xor $FFFF))+(w2 and w3)+Data.KeyW[j+0]),1);
    w1:= Lrot16((w1+(w2 and (w0 xor $FFFF))+(w3 and w0)+Data.KeyW[j+1]),2);
    w2:= Lrot16((w2+(w3 and (w1 xor $FFFF))+(w0 and w1)+Data.KeyW[j+2]),3);
    w3:= Lrot16((w3+(w0 and (w2 xor $FFFF))+(w1 and w2)+Data.KeyW[j+3]),5);
    if (i= 4) or (i= 10) then
    begin
      w0:= w0+Data.KeyW[w3 and 63];
      w1:= w1+Data.KeyW[w0 and 63];
      w2:= w2+Data.KeyW[w1 and 63];
      w3:= w3+Data.KeyW[w2 and 63];
    end;
  end;
  Move(w0,OutData^,2);
  Move(w1,pointer(integer(OutData)+2)^,2);
  Move(w2,pointer(integer(OutData)+4)^,2);
  Move(w3,pointer(integer(OutData)+6)^,2);
end;

procedure RC2DecryptECB;
var
  i, j: integer;
  w0, w1, w2, w3: word;
begin
  Move(InData^,w0,2);
  Move(pointer(integer(InData)+2)^,w1,2);
  Move(pointer(integer(InData)+4)^,w2,2);
  Move(pointer(integer(InData)+6)^,w3,2);
  for i:= 15 downto 0 do
  begin
    j:= i*4;
    w3:= Rrot16(w3,5)-(w0 and (w2 xor $FFFF))-(w1 and w2)-Data.KeyW[j+3];
    w2:= Rrot16(w2,3)-(w3 and (w1 xor $FFFF))-(w0 and w1)-Data.KeyW[j+2];
    w1:= Rrot16(w1,2)-(w2 and (w0 xor $FFFF))-(w3 and w0)-Data.KeyW[j+1];
    w0:= Rrot16(w0,1)-(w1 and (w3 xor $FFFF))-(w2 and w3)-Data.KeyW[j+0];
    if (i= 5) or (i= 11) then
    begin
      w3:= w3-Data.KeyW[w2 and 63];
      w2:= w2-Data.KeyW[w1 and 63];
      w1:= w1-Data.KeyW[w0 and 63];
      w0:= w0-Data.KeyW[w3 and 63];
    end;
  end;
  Move(w0,OutData^,2);
  Move(w1,pointer(integer(OutData)+2)^,2);
  Move(w2,pointer(integer(OutData)+4)^,2);
  Move(w3,pointer(integer(OutData)+6)^,2);
end;

procedure RC2EncryptCBC;
begin
  XorBlock(InData,@Data.LastBlock,OutData,8);
  RC2EncryptECB(Data,OutData,OutData);
  Move(OutData^,Data.LastBlock,8);
end;

procedure RC2DecryptCBC;
var
  TempBlock: array[0..7] of byte;
begin
  Move(InData^,TempBlock,8);
  RC2DecryptECB(Data,InData,OutData);
  XorBlock(OutData,@Data.LastBlock,OutData,8);
  Move(TempBlock,Data.LastBlock,8);
end;

procedure RC2EncryptCFB;
var
  i: integer;
  TempBlock: array[0..7] of byte;
begin
  for i:= 0 to Len-1 do
  begin
    RC2EncryptECB(Data,@Data.LastBlock,@TempBlock);
    PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
    Move(Data.LastBlock[1],Data.LastBlock[0],7);
    Data.LastBlock[7]:= PByteArray(OutData)[i];
  end;
end;

procedure RC2DecryptCFB;
var
  i: integer;
  TempBlock: array[0..7] of byte;
  b: byte;
begin
  for i:= 0 to Len-1 do
  begin
    b:= PByteArray(InData)[i];
    RC2EncryptECB(Data,@Data.LastBlock,@TempBlock);
    PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
    Move(Data.LastBlock[1],Data.LastBlock[0],7);
    Data.LastBlock[7]:= b;
  end;
end;

procedure RC2EncryptOFB;
begin
  RC2EncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
  XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure RC2DecryptOFB;
begin
  RC2EncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
  XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure RC2EncryptOFBC;
var
  i: integer;
  TempBlock: array[0..7] of byte;
begin
  for i:= 0 to Len-1 do
  begin
    RC2EncryptECB(Data,@Data.LastBlock,@TempBlock);
    PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
    IncBlock(@Data.LastBlock,8);
  end;
end;

procedure RC2DecryptOFBC;
var
  i: integer;
  TempBlock: array[0..7] of byte;
begin
  for i:= 0 to Len-1 do
  begin
    RC2EncryptECB(Data,@Data.LastBlock,@TempBlock);
    PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
    IncBlock(@Data.LastBlock,8);
  end;
end;

procedure RC2Reset;
begin
  Move(Data.InitBlock,Data.LastBlock,8);
end;

end.