Parsi Coders
سورس کد رمزنگاری با الگوریتم rc6 - نسخه قابل چاپ

+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Pascal/Delphi (http://parsicoders.com/forumdisplay.php?fid=45)
+---- انجمن: Delphi (http://parsicoders.com/forumdisplay.php?fid=69)
+---- موضوع: سورس کد رمزنگاری با الگوریتم rc6 (/showthread.php?tid=1733)

سورس کد رمزنگاری با الگوریتم rc6 - Amin_Mansouri - 01-30-2012

کد:
//ºÏ²¢ÁËËĸö¼Ó½âÃÜÎļþÒÔÏÂÊÇËüÃǵİ汾ÐÅÏ¢
{
**************************************************
* A binary compatible RC6 implementation          *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 128bit block encryption                         *
* Variable size key - up to 2048bit               *
***************************************************

***************************************************
* A binary compatible IDEA implementation         *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 64bit block encryption                          *
* 128bit key size                                 *
***************************************************

***************************************************
* A binary compatible RIPEMD-160 implementation   *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 160bit hash                                     *
***************************************************
}


unit Secunit;

interface

uses
  Windows, Sysutils, Classes;

const
  NUMROUNDS = 20; { number of rounds must be between 16-24 }
  constIDEAIV: array[0..7] of byte = ($C1, $82, $F3, $97, $19, $DA, $C4, $77);

type

  TRC6Data = record
    InitBlock: array[0..15] of byte; { initial IV }
    LastBlock: array[0..15] of byte; { current IV }
    KeyD: array[0..((NUMROUNDS * 2) + 3)] of DWord;
  end;

{******************************************************************************}
  PWord = ^word;
  TIDEAData = record
    InitBlock: array[0..7] of byte; { initial IV }
    LastBlock: array[0..7] of byte; { current IV }
    EK: array[0..51] of word;
    DK: array[0..51] of word;
  end;

{******************************************************************************}
  PByte = ^Byte;
  TRMD160Context = record
    Hash: array[0..4] of DWord;
    Index: integer;
    LenHi, LenLo: integer;
    case integer of
      1: (Buf: array[0..63] of byte);
      2: (X: array[0..15] of DWord);
  end;
  TRMD160Digest = array[0..19] of byte;

{******************************************************************************}
  ESecHashException = class(Exception);
  TIntDigest = array[0..4] of Cardinal;
  TByteDigest = array[0..19] of Byte;

  TSecHash = class(TComponent)
  private
    { Private-Deklarationen }
    klVar, grVar: TIntDigest;
    M: array[0..63] of Byte;
    W: array[0..79] of Cardinal;
    K: array[0..79] of Cardinal;
    procedure InitSHA;
    procedure SHA;
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    function ComputeString(const Msg: string): TIntDigest;
    function ComputeFile(FileName: string): TIntDigest;
    function ComputeMem(mem: pChar; length: integer): TIntDigest;
    function IntDigestToByteDigest(IntDigest: TIntDigest): TByteDigest;
  published
    { Published-Deklarationen }
  end;

{******************************************************************************}

//function RC6SelfTest: boolean;
  { performs a self test on this implementation }
procedure RC6Init(var Data: TRC6Data; Key: pointer; Len: integer; IV: pointer);
  { initializes the TRC6Data structure with the key information and IV if applicable }
procedure RC6Burn(var Data: TRC6Data);
  { erases all information about the key }

procedure RC6EncryptECB(var Data: TRC6Data; InData, OutData: pointer);
  { encrypts the data in a 128bit block using the ECB mode }
procedure RC6EncryptCBC(var Data: TRC6Data; InData, OutData: pointer);
  { encrypts the data in a 128bit block using the CBC chaining mode }
procedure RC6EncryptOFB(var Data: TRC6Data; InData, OutData: pointer);
  { encrypts the data in a 128bit block using the OFB chaining mode }
procedure RC6EncryptCFB(var Data: TRC6Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the CFB chaining mode }
procedure RC6EncryptOFBC(var Data: TRC6Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the OFB counter chaining mode }

procedure RC6DecryptECB(var Data: TRC6Data; InData, OutData: pointer);
  { decrypts the data in a 128bit block using the ECB mode }
procedure RC6DecryptCBC(var Data: TRC6Data; InData, OutData: pointer);
  { decrypts the data in a 128bit block using the CBC chaining mode }
procedure RC6DecryptOFB(var Data: TRC6Data; InData, OutData: pointer);
  { decrypts the data in a 128bit block using the OFB chaining mode }
procedure RC6DecryptCFB(var Data: TRC6Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the CFB chaining mode }
procedure RC6DecryptOFBC(var Data: TRC6Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the OFB counter chaining mode }

procedure RC6Reset(var Data: TRC6Data);
  { resets the chaining mode information }

function LRot16(X: word; c: integer): word; assembler;
function RRot16(X: word; c: integer): word; assembler;
function LRot32(X: dword; c: integer): dword; assembler;
function RRot32(X: dword; c: integer): dword; assembler;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
procedure IncBlock(P: PByteArray; Len: integer);

{******************************************************************************}

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

procedure IDEAEncryptECB(var Data: TIDEAData; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the ECB mode }
procedure IDEAEncryptCBC(var Data: TIDEAData; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the CBC chaining mode }
procedure IDEAEncryptOFB(var Data: TIDEAData; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the OFB chaining mode }
procedure IDEAEncryptCFB(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the CFB chaining mode }
procedure IDEAEncryptOFBC(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the OFB counter chaining mode }

procedure IDEADecryptECB(var Data: TIDEAData; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the ECB mode }
procedure IDEADecryptCBC(var Data: TIDEAData; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the CBC chaining mode }
procedure IDEADecryptOFB(var Data: TIDEAData; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the OFB chaining mode }
procedure IDEADecryptCFB(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the CFB chaining mode }
procedure IDEADecryptOFBC(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the OFB counter chaining mode }

procedure IDEAReset(var Data: TIDEAData);
  { resets the chaining mode information }

{******************************************************************************}

//function RMD160SelfTest: boolean;
procedure RMD160Init(var Context: TRMD160Context);
procedure RMD160Update(var Context: TRMD160Context; Buffer: pointer; Len: integer);
procedure RMD160Final(var Context: TRMD160Context; var Digest: TRMD160Digest);

{******************************************************************************}

function DigestToString(Digest: array of Byte): string;
function RC6PacketEncode(RC6Key, Destination, Source: Pointer; KeyLen, Count: Integer): integer;
function RC6PacketDecode(RC6Key, Destination, Source: Pointer; KeyLen, Count: Integer): integer;
procedure RC6FrameEncode(Source: Pointer);
procedure RC6FrameDecode(Source: Pointer);
function RC6DataEncode(RC6Key, Source: Pointer; KeyLen, Count: Integer): integer;
function RC6DataDecode(RC6Key, Source: Pointer; KeyLen, Count: Integer): integer;
{******************************************************************************}

implementation

const
  sBox: array[0..51] of DWord = (
    $4B32B763, $5618CB1C, $F45044D5, $9287BE8E, $30BF3847, $CEEE96F0,
    $6D2E2BB9, $0B65A572, $2B27FC8F, $C027B060, $E60C129D, $84438C56,
    $A99D1F2B, $47D498E4, $5EE9F981, $1D21733A, $9B58ECF3, $399066AC,
    $D7C7E065, $75FF5A1E, $F436D3D7, $B26E4D90, $50A5C749, $EEDD4102,
    $8264BABB, $2B4C3474, $C983AE2D, $67BB27E6, $05F2A19F, $A42A1B58,
    $A5A1951F, $E0990ECA, $7ED08883, $1D08023C, $BB3F7BF5, $5976F5AE,
    $17AE6F67, $95E5E920, $341DD2D9, $708C564B, $0EC3D004, $D254DC92,
    $ACFB49BD, $E151C376, $E9662A3F, $87A1B6E8, $25D930A1, $C410AB20,
    $62482413, $007F9DCC, $9EB71785, $3C13D14E);

  //Rc6PublicKey: array[0..15] of byte =
  //($D9, $67, $A9, $CC, $D7, $E0, $A1, $84, $41, $58, $5A, $EF, $BF, $75, $AC, $04);

  Rc6PublicKey: array[0..255] of byte =
  ($74, $6F, $73, $36, $80, $53, $DF, $5F, $7C, $1C, $55, $B7, $26, $78, $0F, $4F,
    $5F, $69, $6B, $70, $20, $30, $B1, $38, $42, $49, $4D, $33, $2E, $DA, $DF, $EB,
    $E9, $33, $E8, $38, $2F, $6A, $29, $00, $42, $49, $4D, $61, $79, $28, $BF, $03,
    $A7, $6D, $81, $27, $75, $AC, $6D, $D9, $2D, $5E, $93, $9B, $99, $A5, $AD, $65,
    $7B, $F1, $F1, $4A, $9F, $FB, $FB, $D3, $7C, $93, $1F, $F4, $74, $45, $87, $5C,
    $C3, $36, $74, $F3, $E2, $45, $B3, $55, $E3, $65, $F2, $D3, $75, $17, $64, $84,
    $2D, $A1, $83, $39, $EC, $DF, $D5, $3D, $35, $A0, $AB, $F9, $C3, $73, $EB, $6E,
    $ED, $CF, $22, $DC, $F0, $65, $18, $D7, $90, $58, $6B, $5D, $4D, $FE, $71, $03,
    $6F, $8E, $ED, $02, $1C, $ED, $02, $CC, $78, $73, $1C, $02, $A9, $2A, $43, $59,
    $26, $4A, $2C, $74, $20, $74, $43, $1C, $02, $65, $41, $6D, $69, $B7, $73, $65,
    $67, $20, $54, $39, $37, $6F, $20, $20, $31, $72, $62, $6F, $72, $39, $61, $79,
    $72, $FD, $35, $D3, $76, $C5, $58, $32, $CE, $BF, $13, $20, $8B, $4D, $E8, $EA,
    $52, $FF, $FD, $05, $03, $FF, $FC, $1F, $03, $EE, $03, $14, $02, $28, $02, $40,
    $40, $11, $EE, $9E, $73, $BD, $58, $D9, $7B, $2D, $AE, $F4, $C3, $F7, $C8, $1D,
    $62, $6F, $77, $72, $67, $2E, $D7, $63, $6F, $28, $2E, $74, $72, $75, $6F, $6D,
    $EB, $04, $00, $ED, $74, $27, $39, $8D, $63, $EA, $79, $97, $F4, $D4, $DA, $D6);

  Rc6PublicIV: array[0..15] of byte =
  ($35, $D1, $0B, $C7, $1C, $CE, $AA, $0B, $C7, $10, $AA, $FB, $74, $38, $23, $D7);

  Rc6DataIV: array[0..15] of byte =
  ($5E, $14, $20, $51, $AE, $62, $9D, $57, $D0, $74, $88, $5E, $14, $23, $B9, $1B);

  Rc6FrameIV: array[0..15] of byte =
  ($F6, $ED, $FF, $ED, $13, $6E, $50, $68, $19, $86, $BA, $23, $91, $6F, $16, $CA);
{
function RC6SelfTest;
const
  Key: array[0..15] of byte =
  ($01, $23, $45, $67, $89, $AB, $CD, $EF, $01, $12, $23, $34, $45, $56, $67, $78);
  InBlock: array[0..15] of byte =
  ($02, $13, $24, $35, $46, $57, $68, $79, $8A, $9B, $AC, $BD, $CE, $DF, $E0, $F1);
  OutBlock: array[0..15] of byte =
  ($52, $4E, $19, $2F, $47, $15, $C6, $23, $1F, $51, $F6, $36, $7E, $A4, $3F, $18);
var
  Block: array[0..15] of byte;
  Data: TRC6Data;
begin
  RC6Init(Data, @Key, Sizeof(Key), nil);
  RC6EncryptECB(Data, @InBlock, @Block);
  Result := CompareMem(@Block, @OutBlock, Sizeof(Block)) or not (NUMROUNDS = 20);
  RC6DecryptECB(Data, @Block, @Block);
  Result := Result and CompareMem(@Block, @InBlock, Sizeof(Block));
  RC6Burn(Data);
end;
}

procedure RC6Init;
var
  xKeyD: array[0..63] of DWord;
  i, j, k, xKeyLen: integer;
  A, B: DWord;
begin
  if (Len <= 0) or (Len > 256) then
    raise Exception.Create('Key length must be between 1 and 256 bytes');
  with Data do
  begin
    if IV = nil then
    begin
      FillChar(InitBlock, 16, 0);
      FillChar(LastBlock, 16, 0);
    end
    else
    begin
      Move(IV^, InitBlock, 16);
      Move(IV^, LastBlock, 16);
    end;
    FillChar(xKeyD, Sizeof(xKeyD), 0);
    Move(Key^, xKeyD, Len);
    xKeyLen := Len div 4;
    if (Len mod 4) <> 0 then
      Inc(xKeyLen);
    Move(sBox, KeyD, ((NUMROUNDS * 2) + 4) * 4);
    i := 0; j := 0;
    A := 0; B := 0;
    if xKeyLen > ((NUMROUNDS * 2) + 4) then
      k := xKeyLen * 3
    else
      k := ((NUMROUNDS * 2) + 4) * 3;
    for k := 1 to k do
    begin
      A := LRot32(KeyD[i] + A + B, 3);
      KeyD[i] := A;
      B := LRot32(xKeyD[j] + A + B, A + B);
      xKeyD[j] := B;
      i := (i + 1) mod ((NUMROUNDS * 2) + 4);
      j := (j + 1) mod xKeyLen;
    end;
    FillChar(xKeyD, Sizeof(xKeyD), 0);
  end;
end;

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

procedure RC6EncryptECB;
var
  A, B, C, D, t, u: DWord;
  i: integer;
begin
  Move(InData^, A, 4);
  Move(pointer(integer(InData) + 4)^, B, 4);
  Move(pointer(integer(InData) + 8)^, C, 4);
  Move(pointer(integer(InData) + 12)^, D, 4);
  B := B + Data.KeyD[0];
  D := D + Data.KeyD[1];
  for i := 1 to NUMROUNDS do
  begin
    t := Lrot32(B * (2 * B + 1), 5);
    u := Lrot32(D * (2 * D + 1), 5);
    A := Lrot32(A xor t, u) + Data.KeyD[2 * i];
    C := Lrot32(C xor u, t) + Data.KeyD[2 * i + 1];
    t := A; A := B; B := C; C := D; D := t;
  end;
  A := A + Data.KeyD[(2 * NUMROUNDS) + 2];
  C := C + Data.KeyD[(2 * NUMROUNDS) + 3];
  Move(A, OutData^, 4);
  Move(B, pointer(integer(OutData) + 4)^, 4);
  Move(C, pointer(integer(OutData) + 8)^, 4);
  Move(D, pointer(integer(OutData) + 12)^, 4);
end;

procedure RC6DecryptECB;
var
  A, B, C, D, t, u: DWord;
  i: integer;
begin
  Move(InData^, A, 4);
  Move(pointer(integer(InData) + 4)^, B, 4);
  Move(pointer(integer(InData) + 8)^, C, 4);
  Move(pointer(integer(InData) + 12)^, D, 4);
  C := C - Data.KeyD[(2 * NUMROUNDS) + 3];
  A := A - Data.KeyD[(2 * NUMROUNDS) + 2];
  for i := NUMROUNDS downto 1 do
  begin
    t := A; A := D; D := C; C := B; B := t;
    u := Lrot32(D * (2 * D + 1), 5);
    t := Lrot32(B * (2 * B + 1), 5);
    C := Rrot32(C - Data.KeyD[2 * i + 1], t) xor u;
    A := Rrot32(A - Data.KeyD[2 * i], u) xor t;
  end;
  D := D - Data.KeyD[1];
  B := B - Data.KeyD[0];
  Move(A, OutData^, 4);
  Move(B, pointer(integer(OutData) + 4)^, 4);
  Move(C, pointer(integer(OutData) + 8)^, 4);
  Move(D, pointer(integer(OutData) + 12)^, 4);
end;

procedure RC6EncryptCBC;
begin
  XorBlock(InData, @Data.LastBlock, OutData, 16);
  RC6EncryptECB(Data, OutData, OutData);
  Move(OutData^, Data.LastBlock, 16);
end;

procedure RC6DecryptCBC;
var
  TempBlock: array[0..15] of byte;
begin
  Move(InData^, TempBlock, 16);
  RC6DecryptECB(Data, InData, OutData);
  XorBlock(OutData, @Data.LastBlock, OutData, 16);
  Move(TempBlock, Data.LastBlock, 16);
end;

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

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

procedure RC6EncryptOFB;
begin
  RC6EncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
  XorBlock(@Data.LastBlock, InData, OutData, 16);
end;

procedure RC6DecryptOFB;
begin
  RC6EncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
  XorBlock(@Data.LastBlock, InData, OutData, 16);
end;

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

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

procedure RC6Reset;
begin
  Move(Data.InitBlock, Data.LastBlock, 16);
end;

{******************************************************************************}

function IDEASelfTest: boolean;
const
  Key: array[0..15] of byte =
  ($00, $01, $00, $02, $00, $03, $00, $04, $00, $05, $00, $06, $00, $07, $00, $08);
  InBlock: array[0..7] of byte =
  ($00, $00, $00, $01, $00, $02, $00, $03);
  OutBlock: array[0..7] of byte =
  ($11, $FB, $ED, $2B, $01, $98, $6D, $E5);
var
  Block: array[0..7] of byte;
  Data: TIDEAData;
begin
  IDEAInit(Data, @Key, Sizeof(Key), nil);
  IDEAEncryptECB(Data, @InBlock, @Block);
  Result := CompareMem(@Block, @OutBlock, Sizeof(Block));
  IDEADecryptECB(Data, @Block, @Block);
  Result := Result and CompareMem(@Block, @InBlock, Sizeof(Block));
  IDEABurn(Data);
end;

procedure Mul(var x: word; y: word);
var
  p: DWord;
  t16: word;
begin
  p := DWord(x) * y;
  if p = 0 then
    x := 1 - x - y
  else
  begin
    x := p shr 16;
    t16 := p and $FFFF;
    x := t16 - x;
    if (t16 < x) then
      Inc(x);
  end;
end;

function MulInv(x: word): word;
var
  t0, t1, q, y: word;
begin
  if x <= 1 then
  begin
    Result := x;
    Exit;
  end;
  t1 := DWord($10001) div x;
  y := DWord($10001) mod x;
  if y = 1 then
  begin
    Result := (1 - t1) and $FFFF;
    Exit;
  end;
  t0 := 1;
  repeat
    q := x div y;
    x := x mod y;
    t0 := t0 + (q * t1);
    if x = 1 then
    begin
      Result := t0;
      Exit;
    end;
    q := y div x;
    y := y mod x;
    t1 := t1 + (q * t0);
  until y = 1;
  Result := (1 - t1) and $FFFF;
end;

procedure IDEAInvertKey(EK, DK: PWord);
var
  i: integer;
  t1, t2, t3: word;
  temp: array[0..51] of word;
  p: PWord;
begin
  p := pointer(integer(@temp) + Sizeof(Temp));
  Dec(p);
  t1 := MulInv(EK^);
  Inc(EK);
  t2 := -EK^;
  Inc(EK);
  t3 := -EK^;
  Inc(EK);
  p^ := MulInv(EK^);
  Inc(EK);
  Dec(p);
  p^ := t3;
  Dec(p);
  p^ := t2;
  Dec(p);
  p^ := t1;
  Dec(p);
  for i := 0 to 6 do
  begin
    t1 := EK^;
    Inc(EK);
    p^ := EK^;
    Inc(EK);
    Dec(p);
    p^ := t1;
    Dec(p);
    t1 := MulInv(EK^);
    Inc(EK);
    t2 := -EK^;
    Inc(EK);
    t3 := -EK^;
    Inc(EK);
    p^ := MulInv(EK^);
    Inc(EK);
    Dec(p);
    p^ := t2;
    Dec(p);
    p^ := t3;
    Dec(p);
    p^ := t1;
    Dec(p);
  end;
  t1 := EK^;
  Inc(EK);
  p^ := EK^;
  Dec(p);
  Inc(EK);
  p^ := t1;
  Dec(p);

  t1 := MulInv(EK^);
  Inc(EK);
  t2 := -EK^;
  Inc(EK);
  t3 := -EK^;
  Inc(EK);
  p^ := MulInv(EK^);
  Dec(p);
  p^ := t3;
  Dec(p);
  p^ := t2;
  Dec(p);
  p^ := t1;
  Move(Temp, DK^, Sizeof(Temp));
  FillChar(Temp, Sizeof(Temp), 0);
end;

procedure IDEAInit;
var
  UserKey: PByteArray;
  PEK: PWordArray;
  j: integer;
begin
  if Len <> 16 then
    raise Exception.Create('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;
    UserKey := Key;
    PEK := @EK;
    for j := 0 to 7 do
    begin
      PEK[j] := (UserKey[0] shl 8) + UserKey[1];
      UserKey := pointer(integer(UserKey) + 2);
    end;
    for j := 1 to 6 do
    begin
      PEK[8] := (PEK[1] shl 9) or (PEK[2] shr 7);
      PEK[9] := (PEK[2] shl 9) or (PEK[3] shr 7);
      PEK[10] := (PEK[3] shl 9) or (PEK[4] shr 7);
      PEK[11] := (PEK[4] shl 9) or (PEK[5] shr 7);
      PEK[12] := (PEK[5] shl 9) or (PEK[6] shr 7);
      PEK[13] := (PEK[6] shl 9) or (PEK[7] shr 7);
      PEK[14] := (PEK[7] shl 9) or (PEK[0] shr 7);
      PEK[15] := (PEK[0] shl 9) or (PEK[1] shr 7);
      PEK := pointer(integer(PEK) + 16);
    end;
    IDEAInvertKey(@EK, @DK);
  end;
end;

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

procedure IDEACipher(Key: PWord; Input, Output: PWordArray);
var
  x1, x2, x3, x4, s2, s3: word;
  i: integer;
begin
  x1 := (Input[0] shr 8) or (Input[0] shl 8);
  x2 := (Input[1] shr 8) or (Input[1] shl 8);
  x3 := (Input[2] shr 8) or (Input[2] shl 8);
  x4 := (Input[3] shr 8) or (Input[3] shl 8);
  i := 8;
  repeat
    Mul(x1, Key^);
    Inc(Key);
    x2 := x2 + Key^;
    Inc(Key);
    x3 := x3 + Key^;
    Inc(Key);
    Mul(x4, Key^);
    Inc(Key);

    s3 := x3;
    x3 := x3 xor x1;
    Mul(x3, Key^);
    Inc(Key);
    s2 := x2;
    x2 := x2 xor x4;
    x2 := x2 + x3;
    Mul(x2, Key^);
    Inc(Key);
    x3 := x3 + x2;

    x1 := x1 xor x2;
    x4 := x4 xor x3;
    x2 := x2 xor s3;
    x3 := x3 xor s2;
    Dec(i);
  until (i = 0);
  Mul(x1, Key^);
  Inc(Key);
  x3 := x3 + Key^;
  Inc(Key);
  x2 := x2 + Key^;
  Inc(Key);
  Mul(x4, Key^);
  Output[0] := (x1 shr 8) or (x1 shl 8);
  Output[1] := (x3 shr 8) or (x3 shl 8);
  Output[2] := (x2 shr 8) or (x2 shl 8);
  Output[3] := (x4 shr 8) or (x4 shl 8);
end;

procedure IDEAEncryptECB;
begin
  IDEACipher(@Data.EK, InData, OutData);
end;

procedure IDEADecryptECB;
begin
  IDEACipher(@Data.DK, InData, OutData);
end;

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

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

procedure IDEAEncryptCFB;
var
  i: integer;
  TempBlock: array[0..7] of byte;
begin
  for i := 0 to Len - 1 do
  begin
    IDEAEncryptECB(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 IDEADecryptCFB;
var
  i: integer;
  TempBlock: array[0..7] of byte;
  b: byte;
begin
  for i := 0 to Len - 1 do
  begin
    b := PByteArray(InData)[i];
    IDEAEncryptECB(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 IDEAEncryptOFB;
begin
  IDEAEncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
  XorBlock(@Data.LastBlock, InData, OutData, 8);
end;

procedure IDEADecryptOFB;
begin
  IDEAEncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
  XorBlock(@Data.LastBlock, InData, OutData, 8);
end;

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

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

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

//******************************************************************************
{
function RMD160SelfTest: boolean;
const
  s: string = '12345678901234567890123456789012345678901234567890123456789012345678901234567890';
  OutDigest: TRMD160Digest =
  ($FD, $25, $B9, $78, $5B, $1F, $C8, $DA, $71, $5D, $E4, $08, $E1, $D5, $A3, $A8, $9D, $35, $D4, $43);
var
  Context: TRMD160Context;
  Digest: TRMD160Digest;
begin
  RMD160Init(Context);
  RMD160Update(Context, @s[1], length(s));
  RMD160Final(Context, Digest);
  if CompareMem(@Digest, @OutDigest, Sizeof(Digest)) then
    Result := true
  else
    Result := false;
end;
}

//******************************************************************************

procedure RMD160Init(var Context: TRMD160Context);
begin
  Context.Hash[0] := $94865A87;
  Context.Hash[1] := $7689F402;
  Context.Hash[2] := $C361F719;
  Context.Hash[3] := $39DD1C2E;
  Context.Hash[4] := $AA1C23C7;
  Context.Index := 0;
  Context.LenHi := 0;
  Context.LenLo := 0;
end;

//******************************************************************************

function ROL(x: DWord; n: DWord): DWord; assembler;
asm
  mov ecx,n
  rol &x,cl
end;

//******************************************************************************

function F1(x, y, z: DWord): DWord;
begin
  Result := x xor y xor z;
end;

function F2(x, y, z: DWord): DWord;
begin
  Result := (x and y) or ((x xor $FFFFFFFF) and z);
end;

function F3(x, y, z: DWord): DWord;
begin
  Result := (x or (y xor $FFFFFFFF)) xor z;
end;

function F4(x, y, z: DWord): DWord;
begin
  Result := (x and z) or (y and (z xor $FFFFFFFF));
end;

function F5(x, y, z: DWord): DWord;
begin
  Result := x xor (y or (z xor $FFFFFFFF));
end;

//******************************************************************************

procedure FF1(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F1(b, c, d) + x;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FF2(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F2(b, c, d) + x + $5A827999;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FF3(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F3(b, c, d) + x + $6ED9EBA1;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FF4(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F4(b, c, d) + x + $8F1BBCDC;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FF5(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F5(b, c, d) + x + $A953FD4E;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FFF1(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F1(b, c, d) + x;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FFF2(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F2(b, c, d) + x + $7A6D76E9;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FFF3(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F3(b, c, d) + x + $6D703EF3;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FFF4(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F4(b, c, d) + x + $5C4DD124;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

procedure FFF5(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a := a + F5(b, c, d) + x + $50A28BE6;
  a := ROL(a, s) + e;
  c := ROL(c, 10);
end;

//******************************************************************************

procedure RMD160Compress(var Context: TRMD160Context);
var
  aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee: DWord;
begin
  aa := Context.Hash[0];
  aaa := Context.Hash[0];
  bb := Context.Hash[1];
  bbb := Context.Hash[1];
  cc := Context.Hash[2];
  ccc := Context.Hash[2];
  dd := Context.Hash[3];
  ddd := Context.Hash[3];
  ee := Context.Hash[4];
  eee := Context.Hash[4];
  with Context do
  begin
    FF1(aa, bb, cc, dd, ee, X[0], 11);
    FF1(ee, aa, bb, cc, dd, X[1], 14);
    FF1(dd, ee, aa, bb, cc, X[2], 15);
    FF1(cc, dd, ee, aa, bb, X[3], 12);
    FF1(bb, cc, dd, ee, aa, X[4], 5);
    FF1(aa, bb, cc, dd, ee, X[5], 8);
    FF1(ee, aa, bb, cc, dd, X[6], 7);
    FF1(dd, ee, aa, bb, cc, X[7], 9);
    FF1(cc, dd, ee, aa, bb, X[8], 11);
    FF1(bb, cc, dd, ee, aa, X[9], 13);
    FF1(aa, bb, cc, dd, ee, X[10], 14);
    FF1(ee, aa, bb, cc, dd, X[11], 15);
    FF1(dd, ee, aa, bb, cc, X[12], 6);
    FF1(cc, dd, ee, aa, bb, X[13], 7);
    FF1(bb, cc, dd, ee, aa, X[14], 9);
    FF1(aa, bb, cc, dd, ee, X[15], 8);

    FF2(ee, aa, bb, cc, dd, X[7], 7);
    FF2(dd, ee, aa, bb, cc, X[4], 6);
    FF2(cc, dd, ee, aa, bb, X[13], 8);
    FF2(bb, cc, dd, ee, aa, X[1], 13);
    FF2(aa, bb, cc, dd, ee, X[10], 11);
    FF2(ee, aa, bb, cc, dd, X[6], 9);
    FF2(dd, ee, aa, bb, cc, X[15], 7);
    FF2(cc, dd, ee, aa, bb, X[3], 15);
    FF2(bb, cc, dd, ee, aa, X[12], 7);
    FF2(aa, bb, cc, dd, ee, X[0], 12);
    FF2(ee, aa, bb, cc, dd, X[9], 15);
    FF2(dd, ee, aa, bb, cc, X[5], 9);
    FF2(cc, dd, ee, aa, bb, X[2], 11);
    FF2(bb, cc, dd, ee, aa, X[14], 7);
    FF2(aa, bb, cc, dd, ee, X[11], 13);
    FF2(ee, aa, bb, cc, dd, X[8], 12);

    FF3(dd, ee, aa, bb, cc, X[3], 11);
    FF3(cc, dd, ee, aa, bb, X[10], 13);
    FF3(bb, cc, dd, ee, aa, X[14], 6);
    FF3(aa, bb, cc, dd, ee, X[4], 7);
    FF3(ee, aa, bb, cc, dd, X[9], 14);
    FF3(dd, ee, aa, bb, cc, X[15], 9);
    FF3(cc, dd, ee, aa, bb, X[8], 13);
    FF3(bb, cc, dd, ee, aa, X[1], 15);
    FF3(aa, bb, cc, dd, ee, X[2], 14);
    FF3(ee, aa, bb, cc, dd, X[7], 8);
    FF3(dd, ee, aa, bb, cc, X[0], 13);
    FF3(cc, dd, ee, aa, bb, X[6], 6);
    FF3(bb, cc, dd, ee, aa, X[13], 5);
    FF3(aa, bb, cc, dd, ee, X[11], 12);
    FF3(ee, aa, bb, cc, dd, X[5], 7);
    FF3(dd, ee, aa, bb, cc, X[12], 5);

    FF4(cc, dd, ee, aa, bb, X[1], 11);
    FF4(bb, cc, dd, ee, aa, X[9], 12);
    FF4(aa, bb, cc, dd, ee, X[11], 14);
    FF4(ee, aa, bb, cc, dd, X[10], 15);
    FF4(dd, ee, aa, bb, cc, X[0], 14);
    FF4(cc, dd, ee, aa, bb, X[8], 15);
    FF4(bb, cc, dd, ee, aa, X[12], 9);
    FF4(aa, bb, cc, dd, ee, X[4], 8);
    FF4(ee, aa, bb, cc, dd, X[13], 9);
    FF4(dd, ee, aa, bb, cc, X[3], 14);
    FF4(cc, dd, ee, aa, bb, X[7], 5);
    FF4(bb, cc, dd, ee, aa, X[15], 6);
    FF4(aa, bb, cc, dd, ee, X[14], 8);
    FF4(ee, aa, bb, cc, dd, X[5], 6);
    FF4(dd, ee, aa, bb, cc, X[6], 5);
    FF4(cc, dd, ee, aa, bb, X[2], 12);

    FF5(bb, cc, dd, ee, aa, X[4], 9);
    FF5(aa, bb, cc, dd, ee, X[0], 15);
    FF5(ee, aa, bb, cc, dd, X[5], 5);
    FF5(dd, ee, aa, bb, cc, X[9], 11);
    FF5(cc, dd, ee, aa, bb, X[7], 6);
    FF5(bb, cc, dd, ee, aa, X[12], 8);
    FF5(aa, bb, cc, dd, ee, X[2], 13);
    FF5(ee, aa, bb, cc, dd, X[10], 12);
    FF5(dd, ee, aa, bb, cc, X[14], 5);
    FF5(cc, dd, ee, aa, bb, X[1], 12);
    FF5(bb, cc, dd, ee, aa, X[3], 13);
    FF5(aa, bb, cc, dd, ee, X[8], 14);
    FF5(ee, aa, bb, cc, dd, X[11], 11);
    FF5(dd, ee, aa, bb, cc, X[6], 8);
    FF5(cc, dd, ee, aa, bb, X[15], 5);
    FF5(bb, cc, dd, ee, aa, X[13], 6);

    FFF5(aaa, bbb, ccc, ddd, eee, X[5], 8);
    FFF5(eee, aaa, bbb, ccc, ddd, X[14], 9);
    FFF5(ddd, eee, aaa, bbb, ccc, X[7], 9);
    FFF5(ccc, ddd, eee, aaa, bbb, X[0], 11);
    FFF5(bbb, ccc, ddd, eee, aaa, X[9], 13);
    FFF5(aaa, bbb, ccc, ddd, eee, X[2], 15);
    FFF5(eee, aaa, bbb, ccc, ddd, X[11], 15);
    FFF5(ddd, eee, aaa, bbb, ccc, X[4], 5);
    FFF5(ccc, ddd, eee, aaa, bbb, X[13], 7);
    FFF5(bbb, ccc, ddd, eee, aaa, X[6], 7);
    FFF5(aaa, bbb, ccc, ddd, eee, X[15], 8);
    FFF5(eee, aaa, bbb, ccc, ddd, X[8], 11);
    FFF5(ddd, eee, aaa, bbb, ccc, X[1], 14);
    FFF5(ccc, ddd, eee, aaa, bbb, X[10], 14);
    FFF5(bbb, ccc, ddd, eee, aaa, X[3], 12);
    FFF5(aaa, bbb, ccc, ddd, eee, X[12], 6);

    FFF4(eee, aaa, bbb, ccc, ddd, X[6], 9);
    FFF4(ddd, eee, aaa, bbb, ccc, X[11], 13);
    FFF4(ccc, ddd, eee, aaa, bbb, X[3], 15);
    FFF4(bbb, ccc, ddd, eee, aaa, X[7], 7);
    FFF4(aaa, bbb, ccc, ddd, eee, X[0], 12);
    FFF4(eee, aaa, bbb, ccc, ddd, X[13], 8);
    FFF4(ddd, eee, aaa, bbb, ccc, X[5], 9);
    FFF4(ccc, ddd, eee, aaa, bbb, X[10], 11);
    FFF4(bbb, ccc, ddd, eee, aaa, X[14], 7);
    FFF4(aaa, bbb, ccc, ddd, eee, X[15], 7);
    FFF4(eee, aaa, bbb, ccc, ddd, X[8], 12);
    FFF4(ddd, eee, aaa, bbb, ccc, X[12], 7);
    FFF4(ccc, ddd, eee, aaa, bbb, X[4], 6);
    FFF4(bbb, ccc, ddd, eee, aaa, X[9], 15);
    FFF4(aaa, bbb, ccc, ddd, eee, X[1], 13);
    FFF4(eee, aaa, bbb, ccc, ddd, X[2], 11);

    FFF3(ddd, eee, aaa, bbb, ccc, X[15], 9);
    FFF3(ccc, ddd, eee, aaa, bbb, X[5], 7);
    FFF3(bbb, ccc, ddd, eee, aaa, X[1], 15);
    FFF3(aaa, bbb, ccc, ddd, eee, X[3], 11);
    FFF3(eee, aaa, bbb, ccc, ddd, X[7], 8);
    FFF3(ddd, eee, aaa, bbb, ccc, X[14], 6);
    FFF3(ccc, ddd, eee, aaa, bbb, X[6], 6);
    FFF3(bbb, ccc, ddd, eee, aaa, X[9], 14);
    FFF3(aaa, bbb, ccc, ddd, eee, X[11], 12);
    FFF3(eee, aaa, bbb, ccc, ddd, X[8], 13);
    FFF3(ddd, eee, aaa, bbb, ccc, X[12], 5);
    FFF3(ccc, ddd, eee, aaa, bbb, X[2], 14);
    FFF3(bbb, ccc, ddd, eee, aaa, X[10], 13);
    FFF3(aaa, bbb, ccc, ddd, eee, X[0], 13);
    FFF3(eee, aaa, bbb, ccc, ddd, X[4], 7);
    FFF3(ddd, eee, aaa, bbb, ccc, X[13], 5);

    FFF2(ccc, ddd, eee, aaa, bbb, X[8], 15);
    FFF2(bbb, ccc, ddd, eee, aaa, X[6], 5);
    FFF2(aaa, bbb, ccc, ddd, eee, X[4], 8);
    FFF2(eee, aaa, bbb, ccc, ddd, X[1], 11);
    FFF2(ddd, eee, aaa, bbb, ccc, X[3], 14);
    FFF2(ccc, ddd, eee, aaa, bbb, X[11], 14);
    FFF2(bbb, ccc, ddd, eee, aaa, X[15], 6);
    FFF2(aaa, bbb, ccc, ddd, eee, X[0], 14);
    FFF2(eee, aaa, bbb, ccc, ddd, X[5], 6);
    FFF2(ddd, eee, aaa, bbb, ccc, X[12], 9);
    FFF2(ccc, ddd, eee, aaa, bbb, X[2], 12);
    FFF2(bbb, ccc, ddd, eee, aaa, X[13], 9);
    FFF2(aaa, bbb, ccc, ddd, eee, X[9], 12);
    FFF2(eee, aaa, bbb, ccc, ddd, X[7], 5);
    FFF2(ddd, eee, aaa, bbb, ccc, X[10], 15);
    FFF2(ccc, ddd, eee, aaa, bbb, X[14], 8);

    FFF1(bbb, ccc, ddd, eee, aaa, X[12], 8);
    FFF1(aaa, bbb, ccc, ddd, eee, X[15], 5);
    FFF1(eee, aaa, bbb, ccc, ddd, X[10], 12);
    FFF1(ddd, eee, aaa, bbb, ccc, X[4], 9);
    FFF1(ccc, ddd, eee, aaa, bbb, X[1], 12);
    FFF1(bbb, ccc, ddd, eee, aaa, X[5], 5);
    FFF1(aaa, bbb, ccc, ddd, eee, X[8], 14);
    FFF1(eee, aaa, bbb, ccc, ddd, X[7], 6);
    FFF1(ddd, eee, aaa, bbb, ccc, X[6], 8);
    FFF1(ccc, ddd, eee, aaa, bbb, X[2], 13);
    FFF1(bbb, ccc, ddd, eee, aaa, X[13], 6);
    FFF1(aaa, bbb, ccc, ddd, eee, X[14], 5);
    FFF1(eee, aaa, bbb, ccc, ddd, X[0], 15);
    FFF1(ddd, eee, aaa, bbb, ccc, X[3], 13);
    FFF1(ccc, ddd, eee, aaa, bbb, X[9], 11);
    FFF1(bbb, ccc, ddd, eee, aaa, X[11], 11);
  end;
  ddd := ddd + cc + Context.Hash[1];
  Context.Hash[1] := Context.Hash[2] + dd + eee;
  Context.Hash[2] := Context.Hash[3] + ee + aaa;
  Context.Hash[3] := Context.Hash[4] + aa + bbb;
  Context.Hash[4] := Context.Hash[0] + bb + ccc;
  Context.Hash[0] := ddd;
end;

//******************************************************************************

procedure RMD160UpdateLen(var Context: TRMD160Context; Len: integer);
var
  i, k: integer;
begin
  for k := 0 to 7 do
  begin
    i := Context.LenLo;
    Inc(Context.LenLo, Len);
    if Context.LenLo < i then
      Inc(Context.LenHi);
  end;
end;

//******************************************************************************

procedure RMD160Update(var Context: TRMD160Context; Buffer: pointer; Len: integer);
begin
  RMD160UpdateLen(Context, Len);
  while Len > 0 do
  begin
    Context.Buf[Context.Index] := PByte(Buffer)^;
    Inc(PByte(Buffer));
    Inc(Context.Index);
    Dec(Len);
    if Context.Index = 64 then
    begin
      Context.Index := 0;
      RMD160Compress(Context);
    end;
  end;
end;

//******************************************************************************

procedure RMD160Final(var Context: TRMD160Context; var Digest: TRMD160Digest);
var
  i, j, len: integer;
  mask: byte;
  xl: array[0..15] of DWord;
begin
  FillChar(xl, Sizeof(xl), 0);
  len := ((Context.LenLo and 511) + 7) div 8;
  if (Context.LenLo and 7) <> 0 then
    mask := 1 shl (Context.LenLo and 7)
  else
    mask := $FF;
  j := 0;
  for i := 0 to len - 1 do
  begin
    if i = (Len - 1) then
      xl[i shr 2] := xl[i shr 2] xor ((Context.Buf[j] and Mask) shl (8 * (i and 3)))
    else
      xl[i shr 2] := xl[i shr 2] xor (Context.Buf[j] shl (8 * (i and 3)));
    Inc(j);
  end;
  xl[(Context.LenLo shr 5) and 15] := xl[(Context.LenLo shr 5) and 15] xor (DWord(1) shl (8 * ((Context.LenLo shr 3) and 3) + 7 - (Context.LenLo and 7)));
  Move(xl, Context.X, Sizeof(xl));
  if (Context.LenLo and 511) > 447 then
  begin
    RMD160Compress(Context);
    FillChar(Context.X, Sizeof(Context.X), 0);
  end;
  Context.X[14] := Context.LenLo;
  Context.X[15] := Context.LenHi;
  RMD160Compress(Context);
  Move(Context.Hash, Digest, Sizeof(Digest));
  FillChar(Context, Sizeof(Context), $FF);
end;

function LRot16(X: word; c: integer): word; assembler;
asm
  mov ecx,&c
  mov ax,&X
  rol ax,cl
  mov &Result,ax
end;

function RRot16(X: word; c: integer): word; assembler;
asm
  mov ecx,&c
  mov ax,&X
  ror ax,cl
  mov &Result,ax
end;

function LRot32(X: dword; c: integer): dword; assembler;
asm
  mov ecx,&c
  mov eax,&X
  rol eax,cl
  mov &Result,eax
end;

function RRot32(X: dword; c: integer): dword; assembler;
asm
  mov ecx,&c
  mov eax,&X
  ror eax,cl
  mov &Result,eax
end;

procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
var
  i: integer;
begin
  for i := 0 to Len - 1 do
    O1[i] := I1[i] xor I2[i];
end;

procedure IncBlock(P: PByteArray; Len: integer);
begin
  Inc(P[Len - 1]);
  if (P[Len - 1] = 0) and (Len > 1) then
    IncBlock(P, Len - 1);
end;

{*****************************************************************}

procedure TSecHash.InitSHA;
var i: integer;
begin
  for i := 0 to 19 do
  begin
    K[i] := $5A827999;
    K[i + 20] := $6ED9EBA1;
    K[i + 40] := $8F1BBCDC;
    K[i + 60] := $CA62C1D6;
  end;
  grVar[0] := $4303E152;
  grVar[1] := $CB4D27DA;
  grVar[2] := $9ADE1FCF;
  grVar[3] := $67105629;
  grVar[4] := $8FC38BE0;
end;


procedure TSecHash.SHA; assembler;
asm
   push ebx
   push edi
   push esi
   mov edx, eax            // pointer to Self (instance of SecHash)
   lea esi, [edx].GrVar[0] // Load Address of GrVar[0]
   lea edi, [edx].KlVar[0] // Load Address of KlVar[0]
   mov ecx, 5
   cld
   rep movsd               // copy GrVar[] to KlVar[]
   xor ecx, ecx
   lea edi, [edx].M[0]     // Load Address of M[0]
   lea esi, [edx].W[0]     // Load Address of W[0]
@@Kopieren_M_nach_W_0_15:
   mov eax, [edi+ecx]      // Copy M[0..15] to W[0..15] while changing from
   rol ax, 8               // Little endian to Big endian
   rol eax, 16
   rol ax, 8
   mov [esi+ecx], eax
   add ecx, 4
   cmp ecx, 64
   jl @@Kopieren_M_nach_W_0_15
   xor ecx, ecx
   mov edi, esi
   add edi, 64
@@Kopieren_M_nach_W_16_79:
   mov eax, [edi+ecx-12]     // W[t] = W[t-3] xor W[t-8] xor W[t-14] xor W[t-16] <<< 1
   xor eax, [edi+ecx-32]
   xor eax, [edi+ecx-56]
   xor eax, [edi+ecx-64]
   rol eax, 1
   mov [edi+ecx], eax
   add ecx, 4
   cmp ecx, 256
   jl @@Kopieren_M_nach_W_16_79
   lea edi, [edx].KlVar[0]
   mov ecx, 20
   xor esi, esi
@@B_0_19:
   mov eax, [edi+4]          // t=0..19: TEMP=(a <<< 5)+f[t](b,c,d)
   mov ebx, eax              // f[t](b,c,d) = (b and c) or ((not b) and d)
   and eax, [edi+8]
   not ebx
   and ebx, [edi+12]
   or eax, ebx
   call @@Ft_Common
   add esi, 4
   dec ecx
   jnz @@B_0_19
   mov ecx, 20
@@B_20_39:
   mov eax, [edi+4]          // t=20..39: TEMP=(a <<< 5)+f[t](b,c,d)
   xor eax, [edi+8]          // f[t](b,c,d) = b xor c xor d
   xor eax, [edi+12]
   call @@Ft_Common
   add esi, 4
   dec ecx
   jnz @@B_20_39
   mov ecx, 20
@@B_40_59:
   mov eax, [edi+4]          // t=40..59: TEMP=(a <<< 5)+f[t](b,c,d)
   mov ebx, eax              // f[t](b,c,d) = (b and c) or (b and d) or (c and d)
   and eax, [edi+8]
   and ebx, [edi+12]
   or eax, ebx
   mov ebx, [edi+8]
   and ebx, [edi+12]
   or eax, ebx
   call @@Ft_Common
   add esi, 4
   dec ecx
   jnz @@B_40_59
   mov ecx, 20
@@B_60_79:
   mov eax, [edi+4]          // t=60..79: TEMP=(a <<< 5)+f[t](b,c,d)
   xor eax, [edi+8]          // f[t](b,c,d) = b xor c xor d
   xor eax, [edi+12]
   call @@Ft_Common
   add esi, 4
   dec ecx
   jnz @@B_60_79
   lea esi, [edx].GrVar[0]   // Load Address of GrVar[0]
   mov eax, [edi]            // For i:=0 to 4 do GrVar[i]:=GrVar[i]+klVar[i]
   add eax, [esi]
   mov [esi], eax
   mov eax, [edi+4]
   add eax, [esi+4]
   mov [esi+4], eax
   mov eax, [edi+8]
   add eax, [esi+8]
   mov [esi+8], eax
   mov eax, [edi+12]
   add eax, [esi+12]
   mov [esi+12], eax
   mov eax, [edi+16]
   add eax, [esi+16]
   mov [esi+16], eax
   pop esi
   pop edi
   pop ebx
   jmp @@End
@@Ft_Common:
   add eax, [edi+16]         // + e
   lea ebx, [edx].W[0]
   add eax, [ebx+esi]        // + W[t]
   lea ebx, [edx].K[0]
   add eax, [ebx+esi]        // + K[t]
   mov ebx, [edi]
   rol ebx, 5                // ebx = a <<< 5
   add eax, ebx              // eax = (a <<< 5)+f[t](b,c,d)+e+W[t]+K[t]
   mov ebx, [edi+12]
   mov [edi+16], ebx         // e = d
   mov ebx, [edi+8]
   mov [edi+12], ebx         // d = c
   mov ebx, [edi+4]
   rol ebx, 30
   mov [edi+8], ebx          // c = b <<< 30
   mov ebx, [edi]
   mov [edi+4], ebx          // b = a
   mov [edi], eax            // a = TEMP
   ret
@@End:
end;


function TSecHash.ComputeMem(Mem: pChar; length: integer): TIntDigest;
var i, BitsLow, BitsHigh, ToCompute: integer;
begin
  BitsHigh := (length and $FF000000) shr 29;
  BitsLow := length shl 3;
  InitSHA;
  ToCompute := length;
  while ToCompute > 0 do
  begin
    if ToCompute >= 64 then
    begin
      for i := 0 to 63 do begin M[i] := ord(Mem^); inc(Mem); end;
      SHA;
      dec(ToCompute, 64);
      if ToCompute = 0 then
      begin
        FillChar(M, sizeof(M), 0);
        M[0] := $80;
      end;
    end else
    begin // ToCompute<64
      FillChar(M, SizeOf(M), 0);
      for i := 0 to ToCompute - 1 do begin M[i] := ord(Mem^); inc(Mem); end;
      M[ToCompute] := $80;
      if ToCompute >= 56 then
      begin
        SHA;
        FillChar(M, SizeOf(M), 0);
      end;
      ToCompute := 0;
    end; //End else ToCompute>=64
    if ToCompute = 0 then
    begin
      M[63] := BitsLow and $000000FF;
      M[62] := (BitsLow and $0000FF00) shr 8;
      M[61] := (BitsLow and $00FF0000) shr 16;
      M[60] := (BitsLow and $FF000000) shr 24;
      M[59] := (BitsHigh and $000000FF);
      SHA;
    end;
  end; //End While ToCompute>0
  Result := grVar;
end;

function TSecHash.ComputeString(const Msg: string): TIntDigest;
begin
  Result := ComputeMem(pChar(Msg), length(Msg));
end;


function TSecHash.ComputeFile(FileName: string): TIntDigest;
var f: file;
  ToCompute: integer;
  BitsLow, BitsHigh: integer;
begin
  InitSHA;
  try
    AssignFile(f, filename);
    reset(f, 1);
  except
    on exception do
      raise ESecHashException.Create('File not found !');
  end;
  try
    ToCompute := FileSize(f);
    BitsHigh := (ToCompute and $FF000000) shr 29;
    BitsLow := (ToCompute shl 3);
    while ToCompute > 0 do
    begin
      if ToCompute >= 64 then
      begin
        BlockRead(F, M, 64);
        SHA;
        dec(ToCompute, 64);
        if ToCompute = 0 then
        begin
          FillChar(M, sizeof(M), 0);
          M[0] := $80;
        end;
      end else
      begin // ToCompute<64
        FillChar(M, SizeOf(M), 0);
        BlockRead(F, M, ToCompute);
        M[ToCompute] := $80;
        if ToCompute >= 56 then
        begin
          SHA;
          FillChar(M, SizeOf(M), 0);
        end;
        ToCompute := 0;
      end; //End else ToCompute>=64
      if ToCompute = 0 then
      begin
        M[63] := BitsLow and $000000FF;
        M[62] := (BitsLow and $0000FF00) shr 8;
        M[61] := (BitsLow and $00FF0000) shr 16;
        M[60] := (BitsLow and $FF000000) shr 24;
        M[59] := (BitsHigh and $000000FF);
        SHA;
      end;
    end; //End While ToCompute>0
  finally
    CloseFile(f);
  end;
  Result := grVar;
end;

function TSecHash.IntDigestToByteDigest(IntDigest: TIntDigest): TByteDigest;
var i: integer;
begin
  for i := 0 to 19 do Result[i] := (IntDigest[i div 4] shr ((3 - (i - (i div 4) * 4)) * 8)) and $FF;
end;

{*****************************************************************}

function DigestToString;
begin
  Result := Format('%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x%0.2x',
    [Digest[0], Digest[1], Digest[2], Digest[3], Digest[4], Digest[5],
    Digest[6], Digest[7], Digest[8], Digest[9],
      Digest[10], Digest[11], Digest[12], Digest[13], Digest[14], Digest[15],
      Digest[16], Digest[17], Digest[18], Digest[19]]);
end;

procedure RC6FrameEncode;
var
  KeyData: TRC6Data;
begin
  RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6FrameIV);
  RC6EncryptOFB(KeyData, Source, Source);
  RC6Reset(KeyData);
  RC6Burn(KeyData);
end;

procedure RC6FrameDecode;
var
  KeyData: TRC6Data;
begin
  RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6FrameIV);
  RC6DecryptOFB(KeyData, Source, Source);
  RC6Reset(KeyData);
  RC6Burn(KeyData);
end;

function RC6DataEncode;
var
  KeyData: TRC6Data;
  i: integer;
begin
  if KeyLen = 0 then
    RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6DataIV)
  else
    RC6Init(KeyData, RC6Key, KeyLen, @Rc6DataIV);
  if Count mod 16 > 0 then Result := Count + 16 - Count mod 16
  else Result := Count;

  i := 0;
  while i < Count do
  begin
    RC6EncryptCBC(KeyData, pointer(integer(Source) + i), pointer(integer(Source) + i));
    inc(i, 16);
  end;
  RC6Reset(KeyData);
  RC6Burn(KeyData);
end;

function RC6DataDecode;
var
  KeyData: TRC6Data;
  i: integer;
begin
  if KeyLen = 0 then
    RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6DataIV)
  else
    RC6Init(KeyData, RC6Key, KeyLen, @Rc6DataIV);
  if Count mod 16 > 0 then Result := Count + 16 - Count mod 16
  else Result := Count;

  i := 0;
  while i < Count do
  begin
    RC6DecryptCBC(KeyData, pointer(integer(Source) + i), pointer(integer(Source) + i));
    inc(i, 16);
  end;
  RC6Reset(KeyData);
  RC6Burn(KeyData);
end;

function RC6PacketEncode;
var
  i: integer;
  KeyData: TRC6Data;
  OutLen: integer;
  Context: TRMD160Context;
  Digest: TRMD160Digest;
  Rc6out: array of byte;
  //Êý¾Ý°ü¸ñʽ RMD160 & ( 4Byte³¤¶ÈÖµ & RC6(Ô´Êý¾Ý) )
begin
  if KeyLen = 0 then
    RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6PublicIV)
  else
    RC6Init(KeyData, RC6Key, KeyLen, @Rc6PublicIV); //Ôø¾*´íÎóµØд³É@RC6Key,ÒÔºóҪעÒâ

  if Count mod 16 > 0 then OutLen := Count + 16 - Count mod 16
  else OutLen := Count;
  inc(Outlen, 4); //+4ÊÇΪÁËÔ¤Áô´æ·Å³¤¶ÈÖµµÄλÖÃ
  SetLength(Rc6out, Outlen);
  Copymemory(@Rc6out[0], @Count, 4); //´æÈ볤¶ÈÖµ
  i := 0;
  while i < Count do
  begin
    RC6EncryptOFB(KeyData, pointer(integer(Source) + i), @Rc6out[i + 4]);
    inc(i, 16);
  end;
  RC6Reset(KeyData);
  RC6Burn(KeyData);

  RMD160Init(Context);
  RMD160Update(Context, @Rc6out[0], Outlen);
  RMD160Final(Context, Digest);

  CopyMemory(Destination, @Digest[0], 20);
  CopyMemory(pointer(integer(Destination) + 20), @Rc6out[0], Outlen);
  Result := OutLen + 20;
end;

function RC6PacketDecode;
var
  i: integer;
  KeyData: TRC6Data;
  OutLen: integer;
  Context: TRMD160Context;
  Digest, DigestSrc: TRMD160Digest;
  Rc6out: array of byte;
  //Êý¾Ý°ü¸ñʽ RMD160 & ( 4Byte³¤¶ÈÖµ & RC6(Ô´Êý¾Ý) )
begin
  result := 0;
  if KeyLen = 0 then
    RC6Init(KeyData, @Rc6PublicKey[0], Sizeof(Rc6PublicKey), @Rc6PublicIV)
  else
    RC6Init(KeyData, RC6Key, KeyLen, @Rc6PublicIV);

  CopyMemory(@DigestSrc[0], Source, 20);
  CopyMemory(@OutLen, pointer(integer(Source) + 20), 4);
  if (OutLen <> Count) then Exit;

  if Count mod 16 > 0 then OutLen := Count + 16 - Count mod 16
  else OutLen := Count;
  inc(Outlen, 4); //+4ÊÇΪÁËÔ¤Áô´æ·Å³¤¶ÈÖµµÄλÖÃ
  SetLength(Rc6out, Outlen);
  Copymemory(@Rc6out[0], @Count, 4); //´æÈ볤¶ÈÖµ
  CopyMemory(@Rc6out[4], pointer(integer(Source) + 24), Outlen - 4); //¶ÁÈëÊý¾ÝÌå

  RMD160Init(Context);
  RMD160Update(Context, @Rc6out[0], Length(Rc6out));
  RMD160Final(Context, Digest);

  if not CompareMem(@DigestSrc[0], @Digest[0], 20) then Exit;
  i := 4;
  while i < Length(Rc6out) do
  begin
    RC6DecryptOFB(KeyData, @Rc6out[i], @Rc6out[i]);
    inc(i, 16);
  end;
  RC6Reset(KeyData);
  RC6Burn(KeyData);

  CopyMemory(Destination, @Rc6out[4], Count);
  result := i + 20;
end;


end.