////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Encrypt/Decrypt routines, Encode/Decode, MD5 etc.                          //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20050509 - Creation.                                                       //
// 20050513 - First tested version.                                           //
// 20160922 - GetMD5FromFile modified.                                        //
// 20230509 - Modified for FPC (A.K.)                                         //
// 20240623 - AddBuffer(LongString)                                           //
////////////////////////////////////////////////////////////////////////////////

unit _crw_crypt; // Cryptography routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, strutils,
 _crw_alloc, _crw_fifo, _crw_fpu, _crw_str, _crw_fio, _crw_base64;

 ///////////////////////////////////////////////////////////////////////////////
 // Simple tools usefull for encryption/decryption
 ///////////////////////////////////////////////////////////////////////////////

 // Encode/decode data in hexadecimal format.
 // Decoder ignore all chars except 0..9,A..F,a..f, similar to Mime_Decode.
function  Hex_Encode(const Str:LongString):LongString;
function  Hex_Decode(const Str:LongString):LongString;

 // Encrypt/decrypt string with enhanced XOR encryption.
 // That is simplest encrypt method, not very safe.
function  XorScrambleText(const Str,Key:LongString):LongString;

 // Bit reverse routines.
function  BitReverse(x:Byte):Byte; overload;
function  BitReverse(x:Word):Word; overload;
function  BitReverse(x:LongWord):LongWord; overload;
function  BitReverse(x:LongInt):LongInt; overload;
function  BitReverse(x:Int64):Int64; overload;

 // Find string with reverse bit order.
function  BitReverseText(const Str:LongString):LongString;

 // Find string with reverse char order.
function  CharReverseText(const Str:LongString):LongString;

 // Get file authentification signature (32 byte=256 bit).
 // Uses file name, size and contents MD5 to generate sign.
function  GetFileSign(const FileName:LongString):LongString;

 ///////////////////////////////////////////////////////////////////////////////
 // "Lazy" encryption/decryption interface.
 // Str        is text to encrypt/dectrypt.
 // Key        is encryption security key (password).
 // IV         is any initial vector up to 8(16) bytes. May be used as open key.
 // Kind       is encryption algorithm:
 //   Blowfish 64  bit block, 1..56  byte key, ECB,CBC,CFB,OFB,OFBC mode.
 //   GOST     64  bit block, 32     byte key, ECB,CBC,CFB,OFB,OFBC mode.
 //   RC2      64  bit block, 1..128 byte key, ECB,CBC,CFB,OFB,OFBC mode.
 //   RC4      64  bit block, 1..256 byte key, only stream mode.
 //   RC5      64  bit block, 1..256 byte key, ECB,CBC,CFB,OFB,OFBC mode.
 //   RC6      128 bit block, 1..256 byte key, ECB,CBC,CFB,OFB,OFBC mode.
 // Mode       is encryption mode:
 //   ECB      64(128) bit block, Size=64*n, not supported in "Lazy" interface.
 //   CBC      64(128) bit block, Size=any, default "Lazy" interface encryption mode.
 //   OFB      64(128) bit block, Size=any.
  //  CFB      8       bit block, Size=any.
  //  OFBC     8       bit block, Size=any.
 // InputForm  is data format of Str.
 // OutputForm is data format of Result.
 // In/Out format may be Bin (Binary), Hex (Base16,hexadecinal), Mime (Base64).
 // Data will be decoded to binary format before encryption/decryption.
 // Result will be encoded to wanted format after encryption/decryption.
 ///////////////////////////////////////////////////////////////////////////////
 // Usually you may use very simple code like that:
 //  SecurityText:=EncryptText(OriginalText,Key);
 //  ...send SecurityText thru open channel...
 //  RestoredText:=DecryptText(SecurityText,Key);
 // By default, uses Blowfish, CBC mode, without open key IV, with OriginalText
 // as binary, SecurityText as MIME-encoded (to make it transportable thru text
 // files and channels), OriginalText and RestoredText as binary.
 ///////////////////////////////////////////////////////////////////////////////
 // Most part derived from code written by Dave Barton (davebarton@bigfoot.com).
 // Modified by Alexey Kuryakin to integrate into CRW-DAQ.
 ///////////////////////////////////////////////////////////////////////////////
type
 ECrypt          = class(ESoftException);
 TEncryptionKind = (ek_Blowfish,ek_GOST,ek_RC2,ek_RC4,ek_RC5,ek_RC6);
 TEncryptionMode = (em_CBC, em_OFB, em_CFB, em_OFBC);
 TDataViewFormat = (df_Bin, df_Hex, df_Mime);

function  EncryptText(const Str,Key:LongString; const IV:LongString='';
                      Kind:TEncryptionKind=ek_Blowfish; Mode:TEncryptionMode=em_CBC;
                      InputForm:TDataViewFormat=df_Bin; OutputForm:TDataViewFormat=df_Mime
                      ):LongString;
function  DecryptText(const Str,Key:LongString; const IV:LongString='';
                      Kind:TEncryptionKind=ek_Blowfish; Mode:TEncryptionMode=em_CBC;
                      InputForm:TDataViewFormat=df_Mime; OutputForm:TDataViewFormat=df_Bin
                      ):LongString;

const
 EncryptionKindNames = 'Blowfish,Gost,RC2,RC4,RC5,RC6';
 EncryptionModeNames = 'CBC,OFB,CFB,OFBC';
 DataViewFormatNames = 'Bin,Hex,Mime';

function  GetEncryptionKindName(Kind:TEncryptionKind):LongString;
function  GetEncryptionModeName(Mode:TEncryptionMode):LongString;
function  GetDataViewFormatName(Frmt:TDataViewFormat):LongString;
function  GetEncryptionKindByName(Kind:LongString):TEncryptionKind;
function  GetEncryptionModeByName(Mode:LongString):TEncryptionMode;
function  GetDataViewFormatByName(Frmt:LongString):TDataViewFormat;

 // Application level security constants
const
 FSign_PW : LongString      = 'Yellow Submarine';
 FSign_IV : LongString      = 'John Lennon';
 FSign_EK : TEncryptionKind = ek_Blowfish;
 FSign_EM : TEncryptionMode = em_CBC;

 ///////////////////////////////////////////////////////////////////////////////
 // "Lazy" MD5 interface.
 // MD5 checksumm may be used to check data integrity and to identify data.
 ///////////////////////////////////////////////////////////////////////////////
function  GetMD5FromText(const Buffer:LongString; Form:TDataViewFormat):LongString;
function  GetMD5FromFile(const FileName:LongString; Form:TDataViewFormat):LongString;
function  GetMD5FromBuff(Buffer:Pointer; BufSize:Integer; Form:TDataViewFormat):LongString;

 ///////////////////////////////////////////////////////////////////////////////
 // This code implements the MD5 message-digest algorithm.
 // The algorithm is due to Ron Rivest.	This code was
 // written by Colin Plumb in 1993, no copyright is claimed.
 // This code is in the public domain; do with it what you wish.
 // Modified by Alexey Kuryakin to integrate into CRW-DAQ.
 ///////////////////////////////////////////////////////////////////////////////
type
 TMD5Digest = class(TMasterObject)
 private
  myDigest  : packed array[0..15] of Byte;
  myContext : packed record
   State    : packed array[0..3] of LongWord;
   Count    : packed array[0..1] of LongWord;
   case Integer of
   0: (BufChar : packed array[0..63] of Byte);
   1: (BufLong : packed array[0..15] of LongWord);
  end;
  myBufTmp  : packed array[0..1024*16-1] of Char;
  function    GetDigest(Form:TDataViewFormat):LongString;
  procedure   Update(Data:PChar; Len:LongWord);
  procedure   Transform(var Buf: array of LongWord; const Data: array of LongWord);
 public
  constructor Create;
  procedure   Start;
  procedure   AddBuffer(Buffer:LongString); overload;
  procedure   AddBuffer(Buffer:Pointer; BufSize:Integer); overload;
  procedure   Stop;
  property    Digest[Form:TDataViewFormat] : LongString read GetDigest;
 end;

function  NewMD5Digest:TMD5Digest;
procedure Kill(var TheObject:TMD5Digest); overload;

 ///////////////////////////////////////////////////////////////////////////////
 // Encryption Algorithm Implementations
 // ====================================
 //
 // DISCLAIMER:
 // This implementation was developed totally outside of the USA and so it is free
 // from export restrictions. However if you have laws in your country which prevent
 // the use of strong cryptographical products then please remove this archive from
 // your computer. I retain no responsibly for this implementation.
 //
 // This implementation is FREEWARE, you may use this implementation freely. You
 // have permission to modify any of the files included in this archive provided you
 // do not redistribute these files. If you wish to redistribute these
 // implementations you may do so provided all the files in this archive are kept
 // intact and unmodified. If you do redistribute these files please email me and
 // tell me (if you upload to a BBS/web site/ftp site etc), this is not a requirement
 // but it is nice to know who is using these implementations.
 //
 // For the lastest updates/information try
 // http://web.ukonline.co.uk/david.w32/delphi.html
 // or email davebarton@bigfoot.com
 ///////////////////////////////////////////////////////////////////////////////

 {
 ***************************************************
 * A binary compatible Blowfish implementation     *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * 64bit block encryption                          *
 * Variable size key - up to 448bit                *
 ***************************************************

 Algorithm Details
 -----------------
 Name        Blowfish block cipher
 Author      Bruce Schneier (http://www.counterpane.com)
 Patented    No
 Block size  64bit
 Key size    Variable - upto 448bit
 Modes       ECB, CBC, CFB 8bit, OFB, OFB counter 8bit


 Procedures
 ----------
 function BlowfishSelfTest: Boolean;
   Performs a self test
 procedure BlowfishInit;
   Initializes a TBlowfishData record with key information
 procedure BlowfishBurn;
   Clears a TBlowfishData record of any key information
 procedure BlowfishReset;
   Resets any chaining mode information (needed for CBC, CFB, OFB, OFBC)

 procedure BlowfishEncryptECB;
   Encrypts the data in a 64bit block using the ECB mode
 procedure BlowfishDecryptECB;
   Decrypts the data in a 64bit block using the ECB mode

 procedure BlowfishEncryptCBC;
   Encrypts the data in a 64bit block using the CBC chaining mode
 procedure BlowfishDecryptCBC;
   Decrypts the data in a 64bit block using the CBC chaining mode
 procedure BlowfishEncryptOFB;
   Encrypts the data in a 64bit block using the OFB chaining mode
 procedure BlowfishDecryptOFB;
   Decrypts the data in a 64bit block using the OFB chaining mode
 procedure BlowfishEncryptCFB;
   Encrypts Len bytes of data using the CFB chaining mode
 procedure BlowfishDecryptCFB;
   Decrypts Len bytes of data using the CFB chaining mode
 procedure BlowfishEncryptOFBC;
   Encrypts Len bytes of data using the OFB counter chaining mode
 procedure BlowfishDecryptOFBC;
   Decrypts Len bytes of data using the OFB counter chaining mode


 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.

 Before you can use the encryption routines you must call Init to perform the
 keysetup routines, if you are planning on using any of the chaining modes
 (CBC, CFB, OFB, OFBC) then you need to supply an initialization vector (IV) which
 is the same size as the block size (64bit). The IV is just a block of data used
 to initialize the chaining modes - it doesn't have to be kept secret.

 If you only want to use the ECB encryption mode you can then just call the
 encryption and decryption routines as you want, to encrypt data in blocks.

 If you want to use the chaining modes (which hides patterns in the data) you must
 call the Reset procedure after a series of encryptions/decryptions.

 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
   IV: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
 var
   Data: array[1..8192] of byte;
   i: integer;
   KeyData: TBlowfishData;
 begin
   BlowfishInit(KeyData,@Key,SizeOf(Key),@IV);
   for i:=1 to (8192 div 8) do
     BlowfishEncryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   BlowfishReset(KeyData);
   for i:=1 to (8192 div 8) do
     BlowfishDecryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   BlowfishReset(KeyData);   // not really necessary but just to demonstrate
   BlowfishBurn;
 end;

 Finally you should always call Burn.


 Notes On Encryption Modes
 -------------------------
 ECB, CBC, OFB: These modes encrypt data in blocks of 64bits (8bytes)
 CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte)


 I hope you find this implementation useful!

 Thanks to Michel Brazeau for spotting an error with the original implementation.

 Dave
 davebarton@bigfoot.com
 http://web.ukonline.co.uk/david.w32/delphi.html

 Copyright (c) 1998 David Barton
 *******************************************************************************
 }
type
 TBlowfishData = packed record
  InitBlock    : packed array[0..7] of Byte;    // initial IV
  LastBlock    : packed array[0..7] of Byte;    // current IV
  SBoxM        : packed array[0..3,0..255] of LongWord;
  PBoxM        : packed array[0..17] of LongWord;
 end;

function  BlowfishSelfTest:Boolean;
procedure BlowfishInit(out Data:TBlowfishData; Key:Pointer; Len:Integer; IV:Pointer);
procedure BlowfishBurn(out Data:TBlowfishData);
procedure BlowfishReset(var Data:TBlowfishData);
procedure BlowfishEncryptECB(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishDecryptECB(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishEncryptCBC(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishDecryptCBC(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishEncryptOFB(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishDecryptOFB(var Data:TBlowfishData; InData,OutData:Pointer);
procedure BlowfishEncryptCFB(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
procedure BlowfishDecryptCFB(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
procedure BlowfishEncryptOFBC(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
procedure BlowfishDecryptOFBC(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);

 {
 ***************************************************
 * A binary compatible GOST implementation         *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * 64bit block encryption                          *
 * 256bit key size                                 *
 ***************************************************
 
 Algorithm Details
 -----------------
 Name        GOST block cipher
 Author      Unknown
 Patented    No
 Block size  64bit
 Key size    256bit
 Modes       ECB, CBC, CFB 8bit, OFB, OFB counter 8bit
 
 
 Procedures
 ----------
 function GOSTSelfTest: Boolean;
   Performs a self test
 procedure GOSTInit;
   Initializes a TGOSTData record with key information
 procedure GOSTBurn;
   Clears a TGOSTData record of any key information
 procedure GOSTReset;
   Resets any chaining mode information (needed for CBC, CFB, OFB, OFBC)
   
 procedure GOSTEncryptECB;
   Encrypts the data in a 64bit block using the ECB mode
 procedure GOSTDecryptECB;
   Decrypts the data in a 64bit block using the ECB mode
 
 procedure GOSTEncryptCBC;
   Encrypts the data in a 64bit block using the CBC chaining mode 
 procedure GOSTDecryptCBC;
   Decrypts the data in a 64bit block using the CBC chaining mode 
 procedure GOSTEncryptOFB;
   Encrypts the data in a 64bit block using the OFB chaining mode 
 procedure GOSTDecryptOFB;
   Decrypts the data in a 64bit block using the OFB chaining mode
 procedure GOSTEncryptCFB;
   Encrypts Len bytes of data using the CFB chaining mode
 procedure GOSTDecryptCFB;
   Decrypts Len bytes of data using the CFB chaining mode 
 procedure GOSTEncryptOFBC;
   Encrypts Len bytes of data using the OFB counter chaining mode
 procedure GOSTDecryptOFBC;
   Decrypts Len bytes of data using the OFB counter chaining mode
    
  
 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.
 
 Before you can use the encryption routines you must call Init to perform the
 keysetup routines, if you are planning on using any of the chaining modes 
 (CBC, CFB, OFB, OFBC) then you need to supply an initialization vector (IV) which
 is the same size as the block size (64bit). The IV is just a block of data used
 to initialize the chaining modes - it doesn't have to be kept secret.
 
 If you only want to use the ECB encryption mode you can then just call the 
 encryption and decryption routines as you want, to encrypt data in blocks.
 
 If you want to use the chaining modes (which hides patterns in the data) you must
 call the Reset procedure after a series of encryptions/decryptions.
 
 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..31] of byte=
     ($BE,$5E,$C2,$00,$6C,$FF,$9D,$CF,$52,$35,$49,$59,$F1,$FF,$0C,$BF,$E9,$50,$61,
       $B5,$A6,$48,$C1,$03,$87,$06,$9C,$25,$99,$7C,$06,$72);
   IV: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
 var
   Data: array[0..8191] of byte;
   i: integer;
   KeyData: TGOSTData;
 begin
   GOSTInit(KeyData,@Key,Sizeof(Key),@IV);
   for i:=1 to (8192 div 8) do
     GOSTEncryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   GOSTReset(KeyData);
   for i:=1 to (8192 div 8) do
     GOSTDecryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   GOSTReset(KeyData);   // not really necessary but just to demonstrate
   GOSTBurn;
 end;
 
 Finally you should always call Burn.
 
 
 Notes On Encryption Modes
 -------------------------
 ECB, CBC, OFB: These modes encrypt data in blocks of 64bits (8bytes)
 CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte)
 
 
 I hope you find this implementation useful!
 
 Dave
 davebarton@bigfoot.com
 http://www.hertreg.ac.uk/ss/
 
 Copyright (c) 1998 David Barton
 ********************************************************************************
 }
type
 TGOSTData  = packed record
  InitBlock : packed array[0..7] of Byte;    // initial IV
  LastBlock : packed array[0..7] of Byte;    // current IV
  XKey      : packed array[0..7] of LongWord;
 end;

function  GOSTSelfTest:Boolean;
procedure GOSTInit(out Data:TGOSTData; Key:Pointer; Len:Integer; IV:Pointer);
procedure GOSTBurn(out Data:TGOSTData);
procedure GOSTReset(var Data:TGOSTData);
procedure GOSTEncryptECB(const Data:TGOSTData; InData,OutData:Pointer);
procedure GOSTDecryptECB(const Data:TGOSTData; InData,OutData:Pointer);
procedure GOSTEncryptCBC(var Data:TGOSTData; InData,OutData:Pointer);
procedure GOSTDecryptCBC(var Data:TGOSTData; InData,OutData:Pointer);
procedure GOSTEncryptOFB(var Data:TGOSTData; InData,OutData:Pointer);
procedure GOSTDecryptOFB(var Data: TGOSTData; InData,OutData:Pointer);
procedure GOSTEncryptCFB(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
procedure GOSTDecryptCFB(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
procedure GOSTEncryptOFBC(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
procedure GOSTDecryptOFBC(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);

 {
 ***************************************************
 * A binary compatible RC2 implementation          *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * 64bit block encryption                          *
 * Variable size key - up to 1024bit               *
 ***************************************************
 
 Algorithm Details
 -----------------
 Name        RC2 block cipher
 Author      Ron Rivest
 Patented    No (the name is copyright)
 Block size  64bit
 Key size    Variable - upto 1024bit
 Modes       ECB, CBC, CFB 8bit, OFB, OFB counter 8bit
 
 
 Procedures
 ----------
 function RC2SelfTest: Boolean;
   Performs a self test
 procedure RC2Init;
   Initializes a TRC2Data record with key information
 procedure RC2Burn;
   Clears a TRC2Data record of any key information
 procedure RC2Reset;
   Resets any chaining mode information (needed for CBC, CFB, OFB, OFBC)

 procedure RC2EncryptECB;
   Encrypts the data in a 64bit block using the ECB mode
 procedure RC2DecryptECB;
   Decrypts the data in a 64bit block using the ECB mode
 
 procedure RC2EncryptCBC;
   Encrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC2DecryptCBC;
   Decrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC2EncryptOFB;
   Encrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC2DecryptOFB;
   Decrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC2EncryptCFB;
   Encrypts Len bytes of data using the CFB chaining mode 
 procedure RC2DecryptCFB;
   Decrypts Len bytes of data using the CFB chaining mode
 procedure RC2EncryptOFBC;
   Encrypts Len bytes of data using the OFB counter chaining mode
 procedure RC2DecryptOFBC;
   Decrypts Len bytes of data using the OFB counter chaining mode
    
  
 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.
 
 Before you can use the encryption routines you must call Init to perform the
 keysetup routines, if you are planning on using any of the chaining modes 
 (CBC, CFB, OFB, OFBC) then you need to supply an initialization vector (IV) which
 is the same size as the block size (64bit). The IV is just a block of data used
 to initialize the chaining modes - it doesn't have to be kept secret.
 
 If you only want to use the ECB encryption mode you can then just call the 
 encryption and decryption routines as you want, to encrypt data in blocks.
 
 If you want to use the chaining modes (which hides patterns in the data) you must
 call the Reset procedure after a series of encryptions/decryptions.
 
 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
   IV: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
 var
   Data: array[1..8192] of byte;
   i: integer;
   KeyData: TRC2Data;
 begin
   RC2Init(KeyData,@Key,Sizeof(Key),@IV);
   for i:=1 to (8192 div 8) do
     RC2EncryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   RC2Reset(KeyData);
   for i:=1 to (8192 div 8) do
     RC2DecryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   RC2Reset(KeyData);   // not really necessary but just to demonstrate
   RC2Burn;
 end;
 
 Finally you should always call Burn.
 
 
 Notes On Encryption Modes
 -------------------------
 ECB, CBC, OFB: These modes encrypt data in blocks of 64bits (8bytes)
 CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte)
 
 
 I hope you find this implementation useful!
 
 Dave
 davebarton@bigfoot.com
 http://web.ukonline.co.uk/david.w32/delphi.html
 
 Copyright (c) 1998 David Barton
 ********************************************************************************
 }
type
 TRC2Data   = packed record
  InitBlock : packed array[0..7] of Byte;    // initial IV
  LastBlock : packed array[0..7] of Byte;    // current IV
  case Integer of
   0: (KeyB: packed array[0..127] of Byte);
   1: (KeyW: packed array[0..63]  of Word);
 end;

function  RC2SelfTest:Boolean;
procedure RC2Init(out Data:TRC2Data; Key:Pointer; Len:Integer; IV:Pointer);
procedure RC2Burn(out Data:TRC2Data);
procedure RC2Reset(var Data:TRC2Data);
procedure RC2EncryptECB(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2DecryptECB(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2EncryptCBC(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2DecryptCBC(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2EncryptOFB(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2DecryptOFB(var Data:TRC2Data; InData,OutData:Pointer);
procedure RC2EncryptCFB(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
procedure RC2DecryptCFB(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
procedure RC2EncryptOFBC(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
procedure RC2DecryptOFBC(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);

 {
 ***************************************************
 * A binary compatible RC4 implementation          *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * Stream encryption                               *
 * Variable size key - up to 2048bit               *
 ***************************************************
 
 Algorithm Details
 -----------------
 Name        RC4 stream cipher
 Author      Ron Rivest
 Patented    No, but the name is copyrighted
 Key size    Variable - upto 2048bit
 
 
 Procedures
 ----------
 function RC4SelfTest: Boolean;
   Performs a self test
 procedure RC4Init;
   Initializes a TRC4Data record with key information
 procedure RC4Burn;
   Clears a TRC4Data record of any key information
 procedure RC4Reset;
   Resets the chaining mode information 
   
 procedure RC4Crypt;
   Encrypts/decrypts the data
    
  
 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.
 
 Before you can use the encryption routines you must call Init to perform the
 keysetup routines.
 
 RC4 is a stream cipher and so after a series of encryptions/decryptions you
 must call the Reset procedure to reset the chaining information.
 
 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
 var
   Data: array[1..8192] of byte;
   i: integer;
   KeyData: TRC4Data;
 begin
   RC4Init(KeyData,@Key,Sizeof(Key));
   RC4Crypt(KeyData,@Data,@Data,Sizeof(Data));
   RC4Reset(KeyData);
   RC4Crypt(KeyData,@Data,@Data,Sizeof(Data));
   RC4Reset(KeyData);   // not really necessary but just to demonstrate
   RC4Burn;
 end;
 
 Finally you should always call Burn.
 
 
 I hope you find this implementation useful!
 
 Dave
 davebarton@bigfoot.com
 http://web.ukonline.co.uk/david.w32/delphi.html
 
 Copyright (c) 1998 David Barton
 ********************************************************************************
 }
type
 TRC4Data = packed record
  Key     : packed array[0..255] of Byte;      // current key
  OrgKey  : packed array[0..255] of Byte;      // original key
 end;

function  RC4SelfTest:Boolean;
procedure RC4Init(out Data:TRC4Data; Key:Pointer; Len:Integer);
procedure RC4Burn(out Data:TRC4Data);
procedure RC4Reset(var Data:TRC4Data);
procedure RC4Crypt(var Data:TRC4Data; InData,OutData:Pointer; Len:Integer);

 {
 ***************************************************
 * A binary compatible RC5 implementation          *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * 64bit block encryption                          *
 * Variable size key - up to 2048bit               *
 ***************************************************
 
 Algorithm Details
 -----------------
 Name        RC5 block cipher
 Author      Ron Rivest
 Patented    Yes, see RSA Labs for licensing (http://www.rsa.com)
 Block size  64bit
 Key size    Variable - upto 2048bit
 Modes       ECB, CBC, CFB 8bit, OFB, OFB counter 8bit
 
 
 Procedures
 ----------
 function RC5SelfTest: Boolean;
   Performs a self test
 procedure RC5Init;
   Initializes a TRC5Data record with key information
 procedure RC5Burn;
   Clears a TRC5Data record of any key information
 procedure RC5Reset;
   Resets any chaining mode information (needed for CBC, CFB, OFB, OFBC)
   
 procedure RC5EncryptECB;
   Encrypts the data in a 64bit block using the ECB mode
 procedure RC5DecryptECB;
   Decrypts the data in a 64bit block using the ECB mode
 
 procedure RC5EncryptCBC;
   Encrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC5DecryptCBC;
   Decrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC5EncryptOFB;
   Encrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC5DecryptOFB;
   Decrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC5EncryptCFB;
   Encrypts Len bytes of data using the CFB chaining mode 
 procedure RC5DecryptCFB;
   Decrypts Len bytes of data using the CFB chaining mode 
 procedure RC5EncryptOFBC;
   Encrypts Len bytes of data using the OFB counter chaining mode
 procedure RC5DecryptOFBC;
   Decrypts Len bytes of data using the OFB counter chaining mode
 
  
 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.
 
 Before you can use the encryption routines you must call Init to perform the
 keysetup routines, if you are planning on using any of the chaining modes 
 (CBC, CFB, OFB, OFBC) then you need to supply an initialization vector (IV) which
 is the same size as the block size (64bit). The IV is just a block of data used
 to initialize the chaining modes - it doesn't have to be kept secret.
 
 If you only want to use the ECB encryption mode you can then just call the 
 encryption and decryption routines as you want, to encrypt data in blocks.
 
 If you want to use the chaining modes (which hides patterns in the data) you must
 call the Reset procedure after a series of encryptions/decryptions.
 
 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
   IV: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
 var
   Data: array[1..8192] of byte;
   i: integer;
   KeyData: TRC5Data;
 begin
   RC5Init(KeyData,@Key,Sizeof(Key),@IV);
   for i:=1 to (8192 div 8) do
     RC5EncryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   RC5Reset(KeyData);
   for i:=1 to (8192 div 8) do
     RC5DecryptCBC(KeyData,@Data[(i-1)*8],@Data[(i-1)*8]);
   RC5Reset(KeyData);   // not really necessary but just to demonstrate
   RC5Burn;
 end;
 
 Finally you should always call Burn.
 
 
 Notes On Encryption Modes
 -------------------------
 ECB, CBC, OFB: These modes encrypt data in blocks of 64bits (8bytes)
 CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte)
 
 
 I hope you find this implementation useful!
 
 Dave
 davebarton@bigfoot.com
 http://web.ukonline.co.uk/david.w32/delphi.html
 
 Copyright (c) 1998 David Barton
 ********************************************************************************
 }
const
 RC5NUMROUNDS  = 12;   // number of rounds must be between 12-16
type
 TRC5Data   = packed record
  InitBlock : packed array[0..7] of Byte;    // initial IV
  LastBlock : packed array[0..7] of Byte;    // current IV
  Key       : packed array[0..((RC5NUMROUNDS*2)+1)] of LongWord;
 end;

function  RC5SelfTest:Boolean;
procedure RC5Init(out Data:TRC5Data; Key:Pointer; Len:Integer; IV:Pointer);
procedure RC5Burn(out Data:TRC5Data);
procedure RC5Reset(var Data:TRC5Data);
procedure RC5EncryptECB(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5DecryptECB(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5EncryptCBC(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5DecryptCBC(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5EncryptOFB(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5DecryptOFB(var Data:TRC5Data; InData,OutData:Pointer);
procedure RC5EncryptCFB(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
procedure RC5DecryptCFB(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
procedure RC5EncryptOFBC(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
procedure RC5DecryptOFBC(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);

 {
 **************************************************
 * A binary compatible RC6 implementation          *
 * written by Dave Barton (davebarton@bigfoot.com) *
 ***************************************************
 * 128bit block encryption                         *
 * Variable size key - up to 2048bit               *
 ***************************************************
 
 Algorithm Details
 -----------------
 Name        RC6 block cipher
 Author      Ron Rivest
 Patented    Yes unless it is selected as the AES, see RSA Labs for licensing (http://www.rsa.com)
 Block size  128bit
 Key size    Variable - upto 2048bit
 Modes       ECB, CBC, CFB 8bit, OFB, OFB counter 8bit

 
 Procedures
 ----------
 function RC6SelfTest: Boolean;
   Performs a self test
 procedure RC6Init;
   Initializes a TRC6Data record with key information
 procedure RC6Burn;
   Clears a TRC6Data record of any key information
 procedure RC6Reset;
   Resets any chaining mode information (needed for CBC, CFB, OFB, OFBC)
   
 procedure RC6EncryptECB;
   Encrypts the data in a 64bit block using the ECB mode
 procedure RC6DecryptECB;
   Decrypts the data in a 64bit block using the ECB mode
 
 procedure RC6EncryptCBC;
   Encrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC6DecryptCBC;
   Decrypts the data in a 64bit block using the CBC chaining mode 
 procedure RC6EncryptOFB;
   Encrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC6DecryptOFB;
   Decrypts the data in a 64bit block using the OFB chaining mode 
 procedure RC6EncryptCFB;
   Encrypts Len bytes of data using the CFB chaining mode 
 procedure RC6DecryptCFB;
   Decrypts Len bytes of data using the CFB chaining mode 
 procedure RC6EncryptOFBC;
   Encrypts Len bytes of data using the OFB counter chaining mode
 procedure RC6DecryptOFBC;
   Decrypts Len bytes of data using the OFB counter chaining mode
    
  
 Usage
 -----
 Before usage I recommend that you call the SelfTest function to test that the
 implementation is performing correctly.
 
 Before you can use the encryption routines you must call Init to perform the
 keysetup routines, if you are planning on using any of the chaining modes
 (CBC, CFB, OFB, OFBC) then you need to supply an initialization vector (IV) which
 is the same size as the block size (128bit). The IV is just a block of data used
 to initialize the chaining modes - it doesn't have to be kept secret.
 
 If you only want to use the ECB encryption mode you can then just call the 
 encryption and decryption routines as you want, to encrypt data in blocks.
 
 If you want to use the chaining modes (which hides patterns in the data) you must
 call the Reset procedure after a series of encryptions/decryptions.
 
 eg.
 procedure EncryptAndDecrypt;
 const
   Key: array[0..7] of byte= ($11, $22, $33, $44, $55, $66, $77, $88);
   IV: array[0..7] of byte= 
     ($11, $22, $33, $44, $55, $66, $77, $88, $99, $AA, $BB, $CC, $DD, $EE, $FF, $00);
 var
   Data: array[1..8192] of byte;
   i: integer;
   KeyData: TRC6Data;
 begin
   RC6Init(KeyData,@Key,Sizeof(Key),@IV);
   for i:=1 to (8192 div 16) do
     RC6EncryptCBC(KeyData,@Data[(i-1)*16],@Data[(i-1)*16]);
   RC6Reset(KeyData);
   for i:=1 to (8192 div 16) do
     RC6DecryptCBC(KeyData,@Data[(i-1)*16],@Data[(i-1)*16]);
   RC6Reset(KeyData);   // not really necessary but just to demonstrate
   RC6Burn;
 end;
 
 Finally you should always call Burn.
 
 
 Notes On Encryption Modes
 -------------------------
 ECB, CBC, OFB: These modes encrypt data in blocks of 128bits (16bytes)
 CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte)
 
 
 I hope you find this implementation useful!

 Dave
 davebarton@bigfoot.com
 http://web.ukonline.co.uk/david.w32/delphi.html
 
 Copyright (c) 1998 David Barton
 ********************************************************************************
 }
const
  RC6NUMROUNDS = 20; // number of rounds must be between 16-24
type
 TRC6Data   = packed record
  InitBlock : packed array[0..15] of Byte;    // initial IV
  LastBlock : packed array[0..15] of Byte;    // current IV
  KeyD      : packed array[0..((RC6NUMROUNDS*2)+3)] of LongWord;
 end;

function  RC6SelfTest:Boolean;
procedure RC6Init(out Data:TRC6Data; Key:Pointer; Len:Integer; IV:Pointer);
procedure RC6Burn(out Data:TRC6Data);
procedure RC6Reset(var Data:TRC6Data);
procedure RC6EncryptECB(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6DecryptECB(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6EncryptCBC(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6DecryptCBC(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6EncryptOFB(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6DecryptOFB(var Data:TRC6Data; InData,OutData:Pointer);
procedure RC6EncryptCFB(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
procedure RC6DecryptCFB(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
procedure RC6EncryptOFBC(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
procedure RC6DecryptOFBC(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);

 // Unit self test
procedure Test_Crypt;

implementation

 ///////////////////////////////////////////////////////////////////////////////
 // Internally used tools for encryption/decryption
 ///////////////////////////////////////////////////////////////////////////////

{$DEFINE USES_SYSTEM_ROL_ROR}

function LRot16(X:Word; c:Byte):Word; inline;
begin
 {$IFDEF USES_SYSTEM_ROL_ROR}
 Result := RolWord(X,c);
 {$ELSE}
 Result := (X shl c) or (X shr (16 - c));
 {$ENDIF}
end;

function RRot16(X:Word; c:Byte):Word; inline;
begin
 {$IFDEF USES_SYSTEM_ROL_ROR}
 Result := RorWord(X,c);
 {$ELSE}
 Result := (X shr c) or (X shl (16 - c)) ;
 {$ENDIF}
end;

function LRot32(X:LongWord; c:Byte):LongWord; inline;
begin
 {$IFDEF USES_SYSTEM_ROL_ROR}
 Result := RolDWord(X,c);
 {$ELSE}
 Result := (X shl c) or (X shr (32 - c));
 {$ENDIF}
end;

function RRot32(X:LongWord; c:Byte):LongWord; inline;
begin
 {$IFDEF USES_SYSTEM_ROL_ROR}
 Result := RorDWord(X,c);
 {$ELSE}
 Result := (X shr c) or (X shl (32 - c)) ;
 {$ENDIF}
end;

procedure XorBlock(In1,In2,Out1:PByteArray; Len:Integer);
var i:Integer;
begin
 for i:=0 to Len-1 do Out1[i]:=In1[i] xor In2[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;

function TrimEquals(const Str:LongString):LongString;
begin
 Result:=StringReplace(Str,'=','',[rfReplaceAll]);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // Simple tools usefull for encryption/decryption
 ///////////////////////////////////////////////////////////////////////////////
const
 HexDigits : PChar = '0123456789ABCDEF';
 HexTable  : packed array[Char] of Byte=(
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);

function Hex_Encode(const Str:LongString):LongString;
var i,LStr:Integer;
begin
 Result:='';
 try
  LStr:=Length(Str);
  if LStr>0 then begin
   SetLength(Result,LStr shl 1);
   for i:=0 to LStr-1 do begin
    Result[(i shl 1)+1]:=HexDigits[Byte(Str[i+1]) shr 4];
    Result[(i shl 1)+2]:=HexDigits[Byte(Str[i+1]) and $f];
   end;
  end;
 except
  on E:Exception do begin BugReport(E,nil,'Hex_Encode'); Result:=''; end;
 end;
end;

function Hex_Decode(const Str:LongString):LongString;
var i,j,LStr,LRes,LMax:Integer; c:Byte;
begin
 Result:='';
 try
  if HexTable['0']=$FF then
  for i:=0 to StrLen(HexDigits)-1 do begin
   HexTable[UpCase(HexDigits[i])]:=i;
   HexTable[LoCase(HexDigits[i])]:=i;
  end;
  LStr:=Length(Str);
  if LStr>0 then begin
   j:=0;
   LRes:=0;
   LMax:=(LStr+1) div 2;
   SetLength(Result,LMax);
   for i:=1 to LStr do begin
    c:=HexTable[Str[i]];
    if c<16 then begin
     inc(j);
     if Odd(j) then begin
      inc(LRes);
      if LRes>LMax then RAISE ECrypt.Create('Hex_Decode internal error.');
      Result[LRes]:=Char(c);
     end else begin
      Result[LRes]:=Char(Byte(Result[LRes]) shl 4 or c);
     end;
    end;
   end;
   SetLength(Result,LRes);
  end;
 except
  on E:Exception do begin BugReport(E,nil,'Hex_Decode'); Result:=''; end;
 end;
end;

function XorScrambleText(const Str,Key:LongString):LongString;
var i,j,LKey,LStr:Integer;
begin
 Result:='';
 try
  LStr:=Length(Str);
  if LStr>0 then begin
   LKey:=Length(Key);
   if LKey>0 then begin
    j:=LKey;
    Result:=Str;
    for i:=1 to LStr do begin
     if (Str[i]<>Key[j]) then Result[i]:=Char(Byte(Str[i]) xor Byte(Key[j]));
     if j<2 then j:=LKey else Dec(j);
    end;
   end;
  end;
 except
  on E:Exception do begin BugReport(E,nil,'XorScrambleText'); Result:=''; end;
 end;
end;

function BitReverse(x:Byte):Byte; overload;
const n=SizeOf(x)*8-1;
var i:Integer;
begin
 Result:=0;
 for i:=0 to n do Result:=Result or (((x shr i) and Byte(1)) shl (n-i));
end;

function BitReverse(x:Word):Word; overload;
const n=SizeOf(x)*8-1;
var i:Integer;
begin
 Result:=0;
 for i:=0 to n do Result:=Result or (((x shr i) and Word(1)) shl (n-i));
end;

function BitReverse(x:LongWord):LongWord; overload;
const n=SizeOf(x)*8-1;
var i:Integer;
begin
 Result:=0;
 for i:=0 to n do Result:=Result or (((x shr i) and LongWord(1)) shl (n-i));
end;

function BitReverse(x:LongInt):LongInt; overload;
const n=SizeOf(x)*8-1;
var i:Integer;
begin
 Result:=0;
 for i:=0 to n do Result:=Result or (((x shr i) and LongInt(1)) shl (n-i));
end;

function BitReverse(x:Int64):Int64; overload;
const n=SizeOf(x)*8-1;
var i:Integer;
begin
 Result:=0;
 for i:=0 to n do Result:=Result or (((x shr i) and Int64(1)) shl (n-i));
end;

function BitReverseText(const Str:LongString):LongString;
var i,LStr:Integer;
begin
 Result:='';
 try
  LStr:=Length(Str);
  if LStr>0 then begin
   Result:=Str;
   for i:=1 to LStr do Result[i]:=Char(BitReverse(Byte(Str[i])));
  end;
 except
  on E:Exception do begin BugReport(E,nil,'BitReverseText'); Result:=''; end;
 end;
end;

function CharReverseText(const Str:LongString):LongString;
var i,LStr:Integer;
begin
 Result:='';
 try
  LStr:=Length(Str);
  if LStr>0 then begin
   Result:=Str;
   for i:=1 to LStr do Result[i]:=Str[LStr-i+1];
  end;
 except
  on E:Exception do begin BugReport(E,nil,'CharReverseText'); Result:=''; end;
 end;
end;

function GetFileSign(const FileName:LongString):LongString;
var Size:Int64;
begin
 Result:='';
 try
  Size:=GetFileSize(FileName);
  if Size<>-1 then begin
   Result:=UpcaseStr(Trim(ExtractFileNameExt(FileName)));
   Result:=GetMD5FromText(Dump(Size)+Result,df_Bin)+
           GetMD5FromFile(FileName,df_Bin);
   Result:=EncryptText(Result,FSign_PW,FSign_IV,FSign_EK,FSign_EM,df_Bin,df_Bin);
   if Length(Result)<>32 then Result:='';
  end;
 except
  on E:Exception do begin BugReport(E,nil,'GetFileSign'); Result:=''; end;
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // "Lazy" encryption/decryption interface.
 ///////////////////////////////////////////////////////////////////////////////
function CryptText(const Str,Key,IV:LongString; Encrypt:Boolean;
                  Kind:TEncryptionKind; Mode:TEncryptionMode;
                  InputForm:TDataViewFormat; OutputForm:TDataViewFormat):LongString;
var
 Buff         : PChar;
 Count        : Integer;
 BlockSize    : Integer;
 Block        : packed array[0..15] of Byte;
 InitVect     : packed array[0..15] of Byte;
 Data         : packed record
  case TEncryptionKind of
  ek_BlowFish : (Blowfish : TBlowfishData);
  ek_Gost     : (Gost     : TGostData);
  ek_RC2      : (RC2      : TRC2Data);
  ek_RC4      : (RC4      : TRC4Data);
  ek_RC5      : (RC5      : TRC5Data);
  ek_RC6      : (RC6      : TRC6Data);
 end;
begin
 Result:='';
 try
  if Length(Str)=0 then Exit;
  if Length(Key)=0 then Exit;
  Result:=Str;
  case InputForm of
   df_Bin  : UniqueString(Result);
   df_Hex  : Result:=Hex_Decode(Result);
   df_Mime : Result:=Mime_Decode(Result);
   else RAISE ECrypt.Create(Format('CryptText: unknown InputForm=%d.',[ord(InputForm)]));
  end;
  Buff:=@Result[1];
  Count:=Length(Result);
  SafeFillChar(InitVect,SizeOf(InitVect),0);
  SafeMove(IV[1],InitVect,Min(SizeOf(InitVect),Length(IV)));
  case Kind of
   ek_Blowfish:
    begin
     BlockSize:=8;
     if BlowfishSelfTest
     then BlowfishInit(Data.Blowfish,@Key[1],Length(Key),@InitVect)
     else RAISE ECrypt.Create('CryptText: Blowfish self test failure!');
     while Count>0 do begin
      SafeMove(Buff[0],Block,Min(Count,BlockSize));
      case Mode of
       em_CBC:
        if Count>=BlockSize then begin
         if Encrypt
         then BlowfishEncryptCBC(Data.Blowfish,@Block,@Block)
         else BlowfishDecryptCBC(Data.Blowfish,@Block,@Block);
        end else begin
         BlowfishEncryptECB(Data.Blowfish,@Data.Blowfish.LastBlock,@Block);
         XorBlock(@Block,@Buff[0],@Block,Count);
        end;
       em_OFB:
        begin
         if Encrypt
         then BlowfishEncryptOFB(Data.Blowfish,@Block,@Block)
         else BlowfishDecryptOFB(Data.Blowfish,@Block,@Block);
        end;
       em_CFB:
        begin
         if Encrypt
         then BlowfishEncryptCFB(Data.Blowfish,@Buff[0],@Buff[0],Count)
         else BlowfishDecryptCFB(Data.Blowfish,@Buff[0],@Buff[0],Count);
         Break;
        end;
       em_OFBC:
        begin
         if Encrypt
         then BlowfishEncryptOFBC(Data.Blowfish,@Buff[0],@Buff[0],Count)
         else BlowfishDecryptOFBC(Data.Blowfish,@Buff[0],@Buff[0],Count);
         Break;
        end;
       else
        RAISE ECrypt.Create(Format('CryptText: Unknown encrypt mode %d',[ord(Mode)]));
      end;
      SafeMove(Block,Buff[0],Min(Count,BlockSize));
      Dec(Count,BlockSize);
      Inc(Buff,BlockSize);
     end;
     BlowfishReset(Data.Blowfish);
     BlowfishBurn(Data.Blowfish);
    end;
   ek_Gost:
    begin
     BlockSize:=8;
     if GostSelfTest
     then GostInit(Data.Gost,@Key[1],Length(Key),@InitVect)
     else RAISE ECrypt.Create('CryptText: Gost self test failure!');
     while Count>0 do begin
      SafeMove(Buff[0],Block,Min(Count,BlockSize));
      case Mode of
       em_CBC:
        if Count>=BlockSize then begin
         if Encrypt
         then GostEncryptCBC(Data.Gost,@Block,@Block)
         else GostDecryptCBC(Data.Gost,@Block,@Block);
        end else begin
         GostEncryptECB(Data.Gost,@Data.Gost.LastBlock,@Block);
         XorBlock(@Block,@Buff[0],@Block,Count);
        end;
       em_OFB:
        begin
         if Encrypt
         then GostEncryptOFB(Data.Gost,@Block,@Block)
         else GostDecryptOFB(Data.Gost,@Block,@Block);
        end;
       em_CFB:
        begin
         if Encrypt
         then GostEncryptCFB(Data.Gost,@Buff[0],@Buff[0],Count)
         else GostDecryptCFB(Data.Gost,@Buff[0],@Buff[0],Count);
         Break;
        end;
       em_OFBC:
        begin
         if Encrypt
         then GostEncryptOFBC(Data.Gost,@Buff[0],@Buff[0],Count)
         else GostDecryptOFBC(Data.Gost,@Buff[0],@Buff[0],Count);
         Break;
        end;
       else
        RAISE ECrypt.Create(Format('CryptText: Unknown encrypt mode %d',[ord(Mode)]));
      end;
      SafeMove(Block,Buff[0],Min(Count,BlockSize));
      Dec(Count,BlockSize);
      Inc(Buff,BlockSize);
     end;
     GostReset(Data.Gost);
     GostBurn(Data.Gost);
    end;
   ek_RC2:
    begin
     BlockSize:=8;
     if RC2SelfTest
     then RC2Init(Data.RC2,@Key[1],Length(Key),@InitVect)
     else RAISE ECrypt.Create('CryptText: RC2 self test failure!');
     while Count>0 do begin
      SafeMove(Buff[0],Block,Min(Count,BlockSize));
      case Mode of
       em_CBC:
        if Count>=BlockSize then begin
         if Encrypt
         then RC2EncryptCBC(Data.RC2,@Block,@Block)
         else RC2DecryptCBC(Data.RC2,@Block,@Block);
        end else begin
         RC2EncryptECB(Data.RC2,@Data.RC2.LastBlock,@Block);
         XorBlock(@Block,@Buff[0],@Block,Count);
        end;
       em_OFB:
        begin
         if Encrypt
         then RC2EncryptOFB(Data.RC2,@Block,@Block)
         else RC2DecryptOFB(Data.RC2,@Block,@Block);
        end;
       em_CFB:
        begin
         if Encrypt
         then RC2EncryptCFB(Data.RC2,@Buff[0],@Buff[0],Count)
         else RC2DecryptCFB(Data.RC2,@Buff[0],@Buff[0],Count);
         Break;
        end;
       em_OFBC:
        begin
         if Encrypt
         then RC2EncryptOFBC(Data.RC2,@Buff[0],@Buff[0],Count)
         else RC2DecryptOFBC(Data.RC2,@Buff[0],@Buff[0],Count);
         Break;
        end;
       else
        RAISE ECrypt.Create(Format('CryptText: Unknown encrypt mode %d',[ord(Mode)]));
      end;
      SafeMove(Block,Buff[0],Min(Count,BlockSize));
      Dec(Count,BlockSize);
      Inc(Buff,BlockSize);
     end;
     RC2Reset(Data.RC2);
     RC2Burn(Data.RC2);
    end;
   ek_RC4:
    begin
     if RC4SelfTest
     then RC4Init(Data.RC4,@Key[1],Length(Key))
     else RAISE ECrypt.Create('CryptText: RC4 self test failure!');
     RC4Crypt(Data.RC4,@Buff[0],@Buff[0],Count);
     RC4Reset(Data.RC4);
     RC4Burn(Data.RC4);
    end;
   ek_RC5:
    begin
     BlockSize:=8;
     if RC5SelfTest
     then RC5Init(Data.RC5,@Key[1],Length(Key),@InitVect)
     else RAISE ECrypt.Create('CryptText: RC5 self test failure!');
     while Count>0 do begin
      SafeMove(Buff[0],Block,Min(Count,BlockSize));
      case Mode of
       em_CBC:
        if Count>=BlockSize then begin
         if Encrypt
         then RC5EncryptCBC(Data.RC5,@Block,@Block)
         else RC5DecryptCBC(Data.RC5,@Block,@Block);
        end else begin
         RC5EncryptECB(Data.RC5,@Data.RC5.LastBlock,@Block);
         XorBlock(@Block,@Buff[0],@Block,Count);
        end;
       em_OFB:
        begin
         if Encrypt
         then RC5EncryptOFB(Data.RC5,@Block,@Block)
         else RC5DecryptOFB(Data.RC5,@Block,@Block);
        end;
       em_CFB:
        begin
         if Encrypt
         then RC5EncryptCFB(Data.RC5,@Buff[0],@Buff[0],Count)
         else RC5DecryptCFB(Data.RC5,@Buff[0],@Buff[0],Count);
         Break;
        end;
       em_OFBC:
        begin
         if Encrypt
         then RC5EncryptOFBC(Data.RC5,@Buff[0],@Buff[0],Count)
         else RC5DecryptOFBC(Data.RC5,@Buff[0],@Buff[0],Count);
         Break;
        end;
       else
        RAISE ECrypt.Create(Format('CryptText: Unknown encrypt mode %d',[ord(Mode)]));
      end;
      SafeMove(Block,Buff[0],Min(Count,BlockSize));
      Dec(Count,BlockSize);
      Inc(Buff,BlockSize);
     end;
     RC5Reset(Data.RC5);
     RC5Burn(Data.RC5);
    end;
   ek_RC6:
    begin
     BlockSize:=16;
     if RC6SelfTest
     then RC6Init(Data.RC6,@Key[1],Length(Key),@InitVect)
     else RAISE ECrypt.Create('CryptText: RC6 self test failure!');
     while Count>0 do begin
      SafeMove(Buff[0],Block,Min(Count,BlockSize));
      case Mode of
       em_CBC:
        if Count>=BlockSize then begin
         if Encrypt
         then RC6EncryptCBC(Data.RC6,@Block,@Block)
         else RC6DecryptCBC(Data.RC6,@Block,@Block);
        end else begin
         RC6EncryptECB(Data.RC6,@Data.RC6.LastBlock,@Block);
         XorBlock(@Block,@Buff[0],@Block,Count);
        end;
       em_OFB:
        begin
         if Encrypt
         then RC6EncryptOFB(Data.RC6,@Block,@Block)
         else RC6DecryptOFB(Data.RC6,@Block,@Block);
        end;
       em_CFB:
        begin
         if Encrypt
         then RC6EncryptCFB(Data.RC6,@Buff[0],@Buff[0],Count)
         else RC6DecryptCFB(Data.RC6,@Buff[0],@Buff[0],Count);
         Break;
        end;
       em_OFBC:
        begin
         if Encrypt
         then RC6EncryptOFBC(Data.RC6,@Buff[0],@Buff[0],Count)
         else RC6DecryptOFBC(Data.RC6,@Buff[0],@Buff[0],Count);
         Break;
        end;
       else
        RAISE ECrypt.Create(Format('CryptText: Unknown encrypt mode %d',[ord(Mode)]));
      end;
      SafeMove(Block,Buff[0],Min(Count,BlockSize));
      Dec(Count,BlockSize);
      Inc(Buff,BlockSize);
     end;
     RC6Reset(Data.RC6);
     RC6Burn(Data.RC6);
    end;
   else RAISE ECrypt.Create(Format('CryptText: Unknown encrypt kind %d',[ord(Kind)]));
  end;
  case OutputForm of
   df_Bin  : ;
   df_Hex  : Result:=Hex_Encode(Result);
   df_Mime : Result:=TrimEquals(Mime_Encode(Result));
   else RAISE ECrypt.Create(Format('CryptText: unknown OutputForm=%d.',[ord(InputForm)]));
  end;
 except
  on E:Exception do begin BugReport(E,nil,'CryptText'); Result:=''; end;
 end;
end;

function EncryptText(const Str,Key:LongString; const IV:LongString;
                     Kind:TEncryptionKind; Mode:TEncryptionMode;
                     InputForm:TDataViewFormat; OutputForm:TDataViewFormat):LongString;
begin
 Result:=CryptText(Str,Key,IV,true,Kind,Mode,InputForm,OutputForm);
end;

function DecryptText(const Str,Key:LongString; const IV:LongString;
                     Kind:TEncryptionKind; Mode:TEncryptionMode;
                     InputForm:TDataViewFormat; OutputForm:TDataViewFormat):LongString;
begin
 Result:=CryptText(Str,Key,IV,false,Kind,Mode,InputForm,OutputForm);
end;

function GetEncryptionKindName(Kind:TEncryptionKind):LongString;
begin
 Result:=ExtractWord(1+ord(Kind),EncryptionKindNames,[',']);
end;

function GetEncryptionModeName(Mode:TEncryptionMode):LongString;
begin
 Result:=ExtractWord(1+ord(Mode),EncryptionModeNames,[',']);
end;

function GetDataViewFormatName(Frmt:TDataViewFormat):LongString;
begin
 Result:=ExtractWord(1+ord(Frmt),DataViewFormatNames,[',']);
end;

function GetEncryptionKindByName(Kind:LongString):TEncryptionKind;
begin
 for Result:=High(Result) downto Low(Result) do
 if SameText(Trim(Kind),GetEncryptionKindName(Result)) then Exit;
 Result:=ek_Blowfish;
end;

function GetEncryptionModeByName(Mode:LongString):TEncryptionMode;
begin
 for Result:=High(Result) downto Low(Result) do
 if SameText(Trim(Mode),GetEncryptionModeName(Result)) then Exit;
 Result:=em_CBC;
end;

function GetDataViewFormatByName(Frmt:LongString):TDataViewFormat;
begin
 for Result:=High(Result) downto Low(Result) do
 if SameText(Trim(Frmt),GetDataViewFormatName(Result)) then Exit;
 Result:=df_Bin;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // "Lazy" MD5 interface.
 ///////////////////////////////////////////////////////////////////////////////
function GetMD5FromBuff(Buffer:Pointer; BufSize:Integer; Form:TDataViewFormat):LongString;
var
 MD5 : TMD5Digest;
begin
 Result:='';
 try
  MD5:=NewMD5Digest;
  try
   MD5.Start;
   MD5.AddBuffer(Buffer, BufSize);
   MD5.Stop;
   Result:=MD5.Digest[Form];
  finally
   Kill(MD5);
  end;
 except
  on E:Exception do begin BugReport(E,nil,'GetMD5FromBuff'); Result:=''; end;
 end;
end;

function GetMD5FromText(const Buffer:LongString; Form:TDataViewFormat):LongString;
begin
 Result:=GetMD5FromBuff(@Buffer[1],Length(Buffer),Form);
end;

function GetMD5FromFile(const FileName:LongString; Form:TDataViewFormat):LongString;
const BuffSize = 1024*1024;
var
 f   : Integer;
 Len : Integer;
 Buf : LongString;
 MD5 : TMD5Digest;
begin
 Result:='';
 try
  Buf:='';
  if FileExists(Trim(FileName)) then begin
   MD5:=NewMD5Digest;
   SetLength(Buf,BuffSize);
   f:=FileOpen(Trim(FileName),fmOpenRead+fmShareDenyNone);
   try
    MD5.Start;
    if f=-1 then Exit;
    while true do begin
     Len:=FileRead(f,Buf[1],Length(Buf));
     if Len>0 then MD5.AddBuffer(@Buf[1],Len) else
     if Len=0 then Break else begin
      Result:=''; // Could not read file
      Exit;
     end;
    end;
    MD5.Stop;
    Result:=MD5.Digest[Form];
   finally
    if f<>-1 then FileClose(f) else begin
     Result:=''; // Could not open file
    end;
    Finalize(Buf);
    Kill(MD5);
   end;
  end;
 except
  on E:Exception do begin BugReport(E,nil,'GetMD5FromFile'); Result:=''; end;
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // MD5 implementation.
 ///////////////////////////////////////////////////////////////////////////////
constructor TMD5Digest.Create;
begin
 inherited;
 Start;
end;

procedure TMD5Digest.Start;
begin
 if Assigned(Self) then begin
  SafeFillChar(myDigest,  SizeOf(myDigest),  0);
  SafeFillChar(myContext, SizeOf(myContext), 0);
  myContext.State[0] := $67452301;
  myContext.State[1] := $efcdab89;
  myContext.State[2] := $98badcfe;
  myContext.State[3] := $10325476;
 end;
end;

procedure TMD5Digest.Update(Data:PChar; Len:LongWord);
var
 Index : Word;
 T     : LongWord;
begin
 if Len>0 then
 if Assigned(Self) then
 try
  with myContext do begin
   T := Count[0];
   Inc(Count[0], Len shl 3);
   if Count[0] < T then Inc(Count[1]);
   Inc(Count[1], Len shr 29);
   T := (T shr 3) and $3f;
   Index := 0;
   if T <> 0 then begin
    Index := T;
    T := 64 - T;
    if Len < T then begin
     SafeMove(Data[0], BufChar[Index], Len);
     Exit;
    end;
    SafeMove(Data[0], BufChar[Index], T);
    Transform(State, BufLong);
    Dec(Len, T);
    Index := T;
   end;
   while Len >= 64 do begin
    SafeMove(Data[Index], BufChar, 64);
    Transform(State, BufLong);
    Inc(Index, 64);
    Dec(Len, 64);
   end;
   SafeMove(Data[Index], BufChar, Len);
  end;
 except
  on E:Exception do BugReport(E,Self,'Update');
 end;
end;

procedure TMD5Digest.Stop;
var
 P   : Byte;
 Cnt : Word;
begin
 if Assigned(Self) then
 try
  with myContext do begin
   Cnt := (Count[0] shr 3) and $3f;
   P := Cnt;
   BufChar[P] := $80;
   Inc(P);
   Cnt := 64 - 1 - Cnt;
   if Cnt < 8 then begin
    SafeFillChar(BufChar[P], Cnt, 0);
    Transform(State, BufLong);
    SafeFillChar(BufChar, 56, 0);
   end else SafeFillChar(BufChar[P], Cnt - 8, 0);
   BufLong[14] := Count[0];
   BufLong[15] := Count[1];
   Transform(State, BufLong);
   SafeMove(State, myDigest, 16);
  end;
  SafeFillChar(myContext, SizeOf(myContext), 0);
 except
  on E:Exception do BugReport(E,Self,'Stop');
 end;
end;

procedure TMD5Digest.Transform(var Buf: array of LongWord; const Data: array of LongWord);
var
 A,B,C,D:LongWord;
 procedure Step1(var W:LongWord; X,Y,Z,Data:LongWord; S:Byte);
 begin
  Inc(W, (Z xor (X and (Y xor Z))) + Data);
  W := (W shl S) or (W shr (32 - S));
  Inc(W, X)
 end;
 procedure Step2(var W:LongWord; X,Y,Z,Data:LongWord; S:Byte);
 begin
  Inc(W, (Y xor (Z and (X xor Y))) + Data);
  W := (W shl S) or (W shr (32 - S));
  Inc(W, X)
 end;
 procedure Step3(var W:LongWord; X,Y,Z,Data:LongWord; S:Byte);
 begin
  Inc(W, (X xor Y xor Z) + Data);
  W := (W shl S) or (W shr (32 - S));
  Inc(W, X)
 end;
 procedure Step4(var W:LongWord; X,Y,Z,Data:LongWord; S:Byte);
 begin
  Inc(W, (Y xor (X or not Z)) + Data);
  W := (W shl S) or (W shr (32 - S));
  Inc(W, X)
 end;
begin
 if Assigned(Self) then
 try
  A := Buf[0];
  B := Buf[1];
  C := Buf[2];
  D := Buf[3];
  Step1(A, B, C, D, Data[ 0] + $d76aa478,  7);
  Step1(D, A, B, C, Data[ 1] + $e8c7b756, 12);
  Step1(C, D, A, B, Data[ 2] + $242070db, 17);
  Step1(B, C, D, A, Data[ 3] + $c1bdceee, 22);
  Step1(A, B, C, D, Data[ 4] + $f57c0faf,  7);
  Step1(D, A, B, C, Data[ 5] + $4787c62a, 12);
  Step1(C, D, A, B, Data[ 6] + $a8304613, 17);
  Step1(B, C, D, A, Data[ 7] + $fd469501, 22);
  Step1(A, B, C, D, Data[ 8] + $698098d8,  7);
  Step1(D, A, B, C, Data[ 9] + $8b44f7af, 12);
  Step1(C, D, A, B, Data[10] + $ffff5bb1, 17);
  Step1(B, C, D, A, Data[11] + $895cd7be, 22);
  Step1(A, B, C, D, Data[12] + $6b901122,  7);
  Step1(D, A, B, C, Data[13] + $fd987193, 12);
  Step1(C, D, A, B, Data[14] + $a679438e, 17);
  Step1(B, C, D, A, Data[15] + $49b40821, 22);
  Step2(A, B, C, D, Data[ 1] + $f61e2562,  5);
  Step2(D, A, B, C, Data[ 6] + $c040b340,  9);
  Step2(C, D, A, B, Data[11] + $265e5a51, 14);
  Step2(B, C, D, A, Data[ 0] + $e9b6c7aa, 20);
  Step2(A, B, C, D, Data[ 5] + $d62f105d,  5);
  Step2(D, A, B, C, Data[10] + $02441453,  9);
  Step2(C, D, A, B, Data[15] + $d8a1e681, 14);
  Step2(B, C, D, A, Data[ 4] + $e7d3fbc8, 20);
  Step2(A, B, C, D, Data[ 9] + $21e1cde6,  5);
  Step2(D, A, B, C, Data[14] + $c33707d6,  9);
  Step2(C, D, A, B, Data[ 3] + $f4d50d87, 14);
  Step2(B, C, D, A, Data[ 8] + $455a14ed, 20);
  Step2(A, B, C, D, Data[13] + $a9e3e905,  5);
  Step2(D, A, B, C, Data[ 2] + $fcefa3f8,  9);
  Step2(C, D, A, B, Data[ 7] + $676f02d9, 14);
  Step2(B, C, D, A, Data[12] + $8d2a4c8a, 20);
  Step3(A, B, C, D, Data[ 5] + $fffa3942,  4);
  Step3(D, A, B, C, Data[ 8] + $8771f681, 11);
  Step3(C, D, A, B, Data[11] + $6d9d6122, 16);
  Step3(B, C, D, A, Data[14] + $fde5380c, 23);
  Step3(A, B, C, D, Data[ 1] + $a4beea44,  4);
  Step3(D, A, B, C, Data[ 4] + $4bdecfa9, 11);
  Step3(C, D, A, B, Data[ 7] + $f6bb4b60, 16);
  Step3(B, C, D, A, Data[10] + $bebfbc70, 23);
  Step3(A, B, C, D, Data[13] + $289b7ec6,  4);
  Step3(D, A, B, C, Data[ 0] + $eaa127fa, 11);
  Step3(C, D, A, B, Data[ 3] + $d4ef3085, 16);
  Step3(B, C, D, A, Data[ 6] + $04881d05, 23);
  Step3(A, B, C, D, Data[ 9] + $d9d4d039,  4);
  Step3(D, A, B, C, Data[12] + $e6db99e5, 11);
  Step3(C, D, A, B, Data[15] + $1fa27cf8, 16);
  Step3(B, C, D, A, Data[ 2] + $c4ac5665, 23);
  Step4(A, B, C, D, Data[ 0] + $f4292244,  6);
  Step4(D, A, B, C, Data[ 7] + $432aff97, 10);
  Step4(C, D, A, B, Data[14] + $ab9423a7, 15);
  Step4(B, C, D, A, Data[ 5] + $fc93a039, 21);
  Step4(A, B, C, D, Data[12] + $655b59c3,  6);
  Step4(D, A, B, C, Data[ 3] + $8f0ccc92, 10);
  Step4(C, D, A, B, Data[10] + $ffeff47d, 15);
  Step4(B, C, D, A, Data[ 1] + $85845dd1, 21);
  Step4(A, B, C, D, Data[ 8] + $6fa87e4f,  6);
  Step4(D, A, B, C, Data[15] + $fe2ce6e0, 10);
  Step4(C, D, A, B, Data[ 6] + $a3014314, 15);
  Step4(B, C, D, A, Data[13] + $4e0811a1, 21);
  Step4(A, B, C, D, Data[ 4] + $f7537e82,  6);
  Step4(D, A, B, C, Data[11] + $bd3af235, 10);
  Step4(C, D, A, B, Data[ 2] + $2ad7d2bb, 15);
  Step4(B, C, D, A, Data[ 9] + $eb86d391, 21);
  Inc(Buf[0], A);
  Inc(Buf[1], B);
  Inc(Buf[2], C);
  Inc(Buf[3], D);
 except
  on E:Exception do BugReport(E,Self,'Transform');
 end;
end;

procedure TMD5Digest.AddBuffer(Buffer:Pointer; BufSize:Integer);
var
 BufPtr : PChar;
 Bytes  : Word;
begin
 if Assigned(Self) then
 if Assigned(Buffer) then
 if (BufSize>0) then
 try
  BufPtr := Buffer;
  repeat
   if BufSize > SizeOf(myBufTmp)
   then Bytes := SizeOf(myBufTmp)
   else Bytes := BufSize;
   SafeMove(BufPtr[0], myBufTmp[0], Bytes);
   Inc(BufPtr, Bytes);
   Dec(BufSize, Bytes);
   if Bytes > 0 then Update(myBufTmp, Bytes);
  until Bytes < SizeOf(myBufTmp);
 except
  on E:Exception do BugReport(E,Self,'AddBuffer');
 end;
end;

procedure TMD5Digest.AddBuffer(Buffer:LongString);
begin
 if Assigned(Self) then
 if (Buffer<>'') then AddBuffer(PChar(Buffer),Length(Buffer));
end;

function TMD5Digest.GetDigest(Form:TDataViewFormat):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Result:=Dump(myDigest,SizeOf(myDigest));
  case Form of
   df_Hex  : Result:=Hex_Encode(Result);
   df_Mime : Result:=Mime_Encode(Result);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetDigest');
 end;
end;

function NewMD5Digest:TMD5Digest;
begin
 Result:=TMD5Digest.Create;
end;

procedure Kill(var TheObject:TMD5Digest); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 ///////////////////////////////////////////////////////////////////////////////
 // Blowfish encription implementation
 ///////////////////////////////////////////////////////////////////////////////
const
 Blowfish_PBox: packed array[0..17] of LongWord= (
  $243f6a88,$85a308d3,$13198a2e,$03707344,$a4093822,$299f31d0,$082efa98,$ec4e6c89,
  $452821e6,$38d01377,$be5466cf,$34e90c6c,$c0ac29b7,$c97c50dd,$3f84d5b5,$b5470917,
  $9216d5d9,$8979fb1b);
 Blowfish_SBox: packed array[0..3,0..255] of LongWord= ((
  $d1310ba6,$98dfb5ac,$2ffd72db,$d01adfb7,$b8e1afed,$6a267e96,$ba7c9045,$f12c7f99,
  $24a19947,$b3916cf7,$0801f2e2,$858efc16,$636920d8,$71574e69,$a458fea3,$f4933d7e,
  $0d95748f,$728eb658,$718bcd58,$82154aee,$7b54a41d,$c25a59b5,$9c30d539,$2af26013,
  $c5d1b023,$286085f0,$ca417918,$b8db38ef,$8e79dcb0,$603a180e,$6c9e0e8b,$b01e8a3e,
  $d71577c1,$bd314b27,$78af2fda,$55605c60,$e65525f3,$aa55ab94,$57489862,$63e81440,
  $55ca396a,$2aab10b6,$b4cc5c34,$1141e8ce,$a15486af,$7c72e993,$b3ee1411,$636fbc2a,
  $2ba9c55d,$741831f6,$ce5c3e16,$9b87931e,$afd6ba33,$6c24cf5c,$7a325381,$28958677,
  $3b8f4898,$6b4bb9af,$c4bfe81b,$66282193,$61d809cc,$fb21a991,$487cac60,$5dec8032,
  $ef845d5d,$e98575b1,$dc262302,$eb651b88,$23893e81,$d396acc5,$0f6d6ff3,$83f44239,
  $2e0b4482,$a4842004,$69c8f04a,$9e1f9b5e,$21c66842,$f6e96c9a,$670c9c61,$abd388f0,
  $6a51a0d2,$d8542f68,$960fa728,$ab5133a3,$6eef0b6c,$137a3be4,$ba3bf050,$7efb2a98,
  $a1f1651d,$39af0176,$66ca593e,$82430e88,$8cee8619,$456f9fb4,$7d84a5c3,$3b8b5ebe,
  $e06f75d8,$85c12073,$401a449f,$56c16aa6,$4ed3aa62,$363f7706,$1bfedf72,$429b023d,
  $37d0d724,$d00a1248,$db0fead3,$49f1c09b,$075372c9,$80991b7b,$25d479d8,$f6e8def7,
  $e3fe501a,$b6794c3b,$976ce0bd,$04c006ba,$c1a94fb6,$409f60c4,$5e5c9ec2,$196a2463,
  $68fb6faf,$3e6c53b5,$1339b2eb,$3b52ec6f,$6dfc511f,$9b30952c,$cc814544,$af5ebd09,
  $bee3d004,$de334afd,$660f2807,$192e4bb3,$c0cba857,$45c8740f,$d20b5f39,$b9d3fbdb,
  $5579c0bd,$1a60320a,$d6a100c6,$402c7279,$679f25fe,$fb1fa3cc,$8ea5e9f8,$db3222f8,
  $3c7516df,$fd616b15,$2f501ec8,$ad0552ab,$323db5fa,$fd238760,$53317b48,$3e00df82,
  $9e5c57bb,$ca6f8ca0,$1a87562e,$df1769db,$d542a8f6,$287effc3,$ac6732c6,$8c4f5573,
  $695b27b0,$bbca58c8,$e1ffa35d,$b8f011a0,$10fa3d98,$fd2183b8,$4afcb56c,$2dd1d35b,
  $9a53e479,$b6f84565,$d28e49bc,$4bfb9790,$e1ddf2da,$a4cb7e33,$62fb1341,$cee4c6e8,
  $ef20cada,$36774c01,$d07e9efe,$2bf11fb4,$95dbda4d,$ae909198,$eaad8e71,$6b93d5a0,
  $d08ed1d0,$afc725e0,$8e3c5b2f,$8e7594b7,$8ff6e2fb,$f2122b64,$8888b812,$900df01c,
  $4fad5ea0,$688fc31c,$d1cff191,$b3a8c1ad,$2f2f2218,$be0e1777,$ea752dfe,$8b021fa1,
  $e5a0cc0f,$b56f74e8,$18acf3d6,$ce89e299,$b4a84fe0,$fd13e0b7,$7cc43b81,$d2ada8d9,
  $165fa266,$80957705,$93cc7314,$211a1477,$e6ad2065,$77b5fa86,$c75442f5,$fb9d35cf,
  $ebcdaf0c,$7b3e89a0,$d6411bd3,$ae1e7e49,$00250e2d,$2071b35e,$226800bb,$57b8e0af,
  $2464369b,$f009b91e,$5563911d,$59dfa6aa,$78c14389,$d95a537f,$207d5ba2,$02e5b9c5,
  $83260376,$6295cfa9,$11c81968,$4e734a41,$b3472dca,$7b14a94a,$1b510052,$9a532915,
  $d60f573f,$bc9bc6e4,$2b60a476,$81e67400,$08ba6fb5,$571be91f,$f296ec6b,$2a0dd915,
  $b6636521,$e7b9f9b6,$ff34052e,$c5855664,$53b02d5d,$a99f8fa1,$08ba4799,$6e85076a),(
  $4b7a70e9,$b5b32944,$db75092e,$c4192623,$ad6ea6b0,$49a7df7d,$9cee60b8,$8fedb266,
  $ecaa8c71,$699a17ff,$5664526c,$c2b19ee1,$193602a5,$75094c29,$a0591340,$e4183a3e,
  $3f54989a,$5b429d65,$6b8fe4d6,$99f73fd6,$a1d29c07,$efe830f5,$4d2d38e6,$f0255dc1,
  $4cdd2086,$8470eb26,$6382e9c6,$021ecc5e,$09686b3f,$3ebaefc9,$3c971814,$6b6a70a1,
  $687f3584,$52a0e286,$b79c5305,$aa500737,$3e07841c,$7fdeae5c,$8e7d44ec,$5716f2b8,
  $b03ada37,$f0500c0d,$f01c1f04,$0200b3ff,$ae0cf51a,$3cb574b2,$25837a58,$dc0921bd,
  $d19113f9,$7ca92ff6,$94324773,$22f54701,$3ae5e581,$37c2dadc,$c8b57634,$9af3dda7,
  $a9446146,$0fd0030e,$ecc8c73e,$a4751e41,$e238cd99,$3bea0e2f,$3280bba1,$183eb331,
  $4e548b38,$4f6db908,$6f420d03,$f60a04bf,$2cb81290,$24977c79,$5679b072,$bcaf89af,
  $de9a771f,$d9930810,$b38bae12,$dccf3f2e,$5512721f,$2e6b7124,$501adde6,$9f84cd87,
  $7a584718,$7408da17,$bc9f9abc,$e94b7d8c,$ec7aec3a,$db851dfa,$63094366,$c464c3d2,
  $ef1c1847,$3215d908,$dd433b37,$24c2ba16,$12a14d43,$2a65c451,$50940002,$133ae4dd,
  $71dff89e,$10314e55,$81ac77d6,$5f11199b,$043556f1,$d7a3c76b,$3c11183b,$5924a509,
  $f28fe6ed,$97f1fbfa,$9ebabf2c,$1e153c6e,$86e34570,$eae96fb1,$860e5e0a,$5a3e2ab3,
  $771fe71c,$4e3d06fa,$2965dcb9,$99e71d0f,$803e89d6,$5266c825,$2e4cc978,$9c10b36a,
  $c6150eba,$94e2ea78,$a5fc3c53,$1e0a2df4,$f2f74ea7,$361d2b3d,$1939260f,$19c27960,
  $5223a708,$f71312b6,$ebadfe6e,$eac31f66,$e3bc4595,$a67bc883,$b17f37d1,$018cff28,
  $c332ddef,$be6c5aa5,$65582185,$68ab9802,$eecea50f,$db2f953b,$2aef7dad,$5b6e2f84,
  $1521b628,$29076170,$ecdd4775,$619f1510,$13cca830,$eb61bd96,$0334fe1e,$aa0363cf,
  $b5735c90,$4c70a239,$d59e9e0b,$cbaade14,$eecc86bc,$60622ca7,$9cab5cab,$b2f3846e,
  $648b1eaf,$19bdf0ca,$a02369b9,$655abb50,$40685a32,$3c2ab4b3,$319ee9d5,$c021b8f7,
  $9b540b19,$875fa099,$95f7997e,$623d7da8,$f837889a,$97e32d77,$11ed935f,$16681281,
  $0e358829,$c7e61fd6,$96dedfa1,$7858ba99,$57f584a5,$1b227263,$9b83c3ff,$1ac24696,
  $cdb30aeb,$532e3054,$8fd948e4,$6dbc3128,$58ebf2ef,$34c6ffea,$fe28ed61,$ee7c3c73,
  $5d4a14d9,$e864b7e3,$42105d14,$203e13e0,$45eee2b6,$a3aaabea,$db6c4f15,$facb4fd0,
  $c742f442,$ef6abbb5,$654f3b1d,$41cd2105,$d81e799e,$86854dc7,$e44b476a,$3d816250,
  $cf62a1f2,$5b8d2646,$fc8883a0,$c1c7b6a3,$7f1524c3,$69cb7492,$47848a0b,$5692b285,
  $095bbf00,$ad19489d,$1462b174,$23820e00,$58428d2a,$0c55f5ea,$1dadf43e,$233f7061,
  $3372f092,$8d937e41,$d65fecf1,$6c223bdb,$7cde3759,$cbee7460,$4085f2a7,$ce77326e,
  $a6078084,$19f8509e,$e8efd855,$61d99735,$a969a7aa,$c50c06c2,$5a04abfc,$800bcadc,
  $9e447a2e,$c3453484,$fdd56705,$0e1e9ec9,$db73dbd3,$105588cd,$675fda79,$e3674340,
  $c5c43465,$713e38d8,$3d28f89e,$f16dff20,$153e21e7,$8fb03d4a,$e6e39f2b,$db83adf7),(
  $e93d5a68,$948140f7,$f64c261c,$94692934,$411520f7,$7602d4f7,$bcf46b2e,$d4a20068,
  $d4082471,$3320f46a,$43b7d4b7,$500061af,$1e39f62e,$97244546,$14214f74,$bf8b8840,
  $4d95fc1d,$96b591af,$70f4ddd3,$66a02f45,$bfbc09ec,$03bd9785,$7fac6dd0,$31cb8504,
  $96eb27b3,$55fd3941,$da2547e6,$abca0a9a,$28507825,$530429f4,$0a2c86da,$e9b66dfb,
  $68dc1462,$d7486900,$680ec0a4,$27a18dee,$4f3ffea2,$e887ad8c,$b58ce006,$7af4d6b6,
  $aace1e7c,$d3375fec,$ce78a399,$406b2a42,$20fe9e35,$d9f385b9,$ee39d7ab,$3b124e8b,
  $1dc9faf7,$4b6d1856,$26a36631,$eae397b2,$3a6efa74,$dd5b4332,$6841e7f7,$ca7820fb,
  $fb0af54e,$d8feb397,$454056ac,$ba489527,$55533a3a,$20838d87,$fe6ba9b7,$d096954b,
  $55a867bc,$a1159a58,$cca92963,$99e1db33,$a62a4a56,$3f3125f9,$5ef47e1c,$9029317c,
  $fdf8e802,$04272f70,$80bb155c,$05282ce3,$95c11548,$e4c66d22,$48c1133f,$c70f86dc,
  $07f9c9ee,$41041f0f,$404779a4,$5d886e17,$325f51eb,$d59bc0d1,$f2bcc18f,$41113564,
  $257b7834,$602a9c60,$dff8e8a3,$1f636c1b,$0e12b4c2,$02e1329e,$af664fd1,$cad18115,
  $6b2395e0,$333e92e1,$3b240b62,$eebeb922,$85b2a20e,$e6ba0d99,$de720c8c,$2da2f728,
  $d0127845,$95b794fd,$647d0862,$e7ccf5f0,$5449a36f,$877d48fa,$c39dfd27,$f33e8d1e,
  $0a476341,$992eff74,$3a6f6eab,$f4f8fd37,$a812dc60,$a1ebddf8,$991be14c,$db6e6b0d,
  $c67b5510,$6d672c37,$2765d43b,$dcd0e804,$f1290dc7,$cc00ffa3,$b5390f92,$690fed0b,
  $667b9ffb,$cedb7d9c,$a091cf0b,$d9155ea3,$bb132f88,$515bad24,$7b9479bf,$763bd6eb,
  $37392eb3,$cc115979,$8026e297,$f42e312d,$6842ada7,$c66a2b3b,$12754ccc,$782ef11c,
  $6a124237,$b79251e7,$06a1bbe6,$4bfb6350,$1a6b1018,$11caedfa,$3d25bdd8,$e2e1c3c9,
  $44421659,$0a121386,$d90cec6e,$d5abea2a,$64af674e,$da86a85f,$bebfe988,$64e4c3fe,
  $9dbc8057,$f0f7c086,$60787bf8,$6003604d,$d1fd8346,$f6381fb0,$7745ae04,$d736fccc,
  $83426b33,$f01eab71,$b0804187,$3c005e5f,$77a057be,$bde8ae24,$55464299,$bf582e61,
  $4e58f48f,$f2ddfda2,$f474ef38,$8789bdc2,$5366f9c3,$c8b38e74,$b475f255,$46fcd9b9,
  $7aeb2661,$8b1ddf84,$846a0e79,$915f95e2,$466e598e,$20b45770,$8cd55591,$c902de4c,
  $b90bace1,$bb8205d0,$11a86248,$7574a99e,$b77f19b6,$e0a9dc09,$662d09a1,$c4324633,
  $e85a1f02,$09f0be8c,$4a99a025,$1d6efe10,$1ab93d1d,$0ba5a4df,$a186f20f,$2868f169,
  $dcb7da83,$573906fe,$a1e2ce9b,$4fcd7f52,$50115e01,$a70683fa,$a002b5c4,$0de6d027,
  $9af88c27,$773f8641,$c3604c06,$61a806b5,$f0177a28,$c0f586e0,$006058aa,$30dc7d62,
  $11e69ed7,$2338ea63,$53c2dd94,$c2c21634,$bbcbee56,$90bcb6de,$ebfc7da1,$ce591d76,
  $6f05e409,$4b7c0188,$39720a3d,$7c927c24,$86e3725f,$724d9db9,$1ac15bb4,$d39eb8fc,
  $ed545578,$08fca5b5,$d83d7cd3,$4dad0fc4,$1e50ef5e,$b161e6f8,$a28514d9,$6c51133c,
  $6fd5c7e7,$56e14ec4,$362abfce,$ddc6c837,$d79a3234,$92638212,$670efa8e,$406000e0),(
  $3a39ce37,$d3faf5cf,$abc27737,$5ac52d1b,$5cb0679e,$4fa33742,$d3822740,$99bc9bbe,
  $d5118e9d,$bf0f7315,$d62d1c7e,$c700c47b,$b78c1b6b,$21a19045,$b26eb1be,$6a366eb4,
  $5748ab2f,$bc946e79,$c6a376d2,$6549c2c8,$530ff8ee,$468dde7d,$d5730a1d,$4cd04dc6,
  $2939bbdb,$a9ba4650,$ac9526e8,$be5ee304,$a1fad5f0,$6a2d519a,$63ef8ce2,$9a86ee22,
  $c089c2b8,$43242ef6,$a51e03aa,$9cf2d0a4,$83c061ba,$9be96a4d,$8fe51550,$ba645bd6,
  $2826a2f9,$a73a3ae1,$4ba99586,$ef5562e9,$c72fefd3,$f752f7da,$3f046f69,$77fa0a59,
  $80e4a915,$87b08601,$9b09e6ad,$3b3ee593,$e990fd5a,$9e34d797,$2cf0b7d9,$022b8b51,
  $96d5ac3a,$017da67d,$d1cf3ed6,$7c7d2d28,$1f9f25cf,$adf2b89b,$5ad6b472,$5a88f54c,
  $e029ac71,$e019a5e6,$47b0acfd,$ed93fa9b,$e8d3c48d,$283b57cc,$f8d56629,$79132e28,
  $785f0191,$ed756055,$f7960e44,$e3d35e8c,$15056dd4,$88f46dba,$03a16125,$0564f0bd,
  $c3eb9e15,$3c9057a2,$97271aec,$a93a072a,$1b3f6d9b,$1e6321f5,$f59c66fb,$26dcf319,
  $7533d928,$b155fdf5,$03563482,$8aba3cbb,$28517711,$c20ad9f8,$abcc5167,$ccad925f,
  $4de81751,$3830dc8e,$379d5862,$9320f991,$ea7a90c2,$fb3e7bce,$5121ce64,$774fbe32,
  $a8b6e37e,$c3293d46,$48de5369,$6413e680,$a2ae0810,$dd6db224,$69852dfd,$09072166,
  $b39a460a,$6445c0dd,$586cdecf,$1c20c8ae,$5bbef7dd,$1b588d40,$ccd2017f,$6bb4e3bb,
  $dda26a7e,$3a59ff45,$3e350a44,$bcb4cdd5,$72eacea8,$fa6484bb,$8d6612ae,$bf3c6f47,
  $d29be463,$542f5d9e,$aec2771b,$f64e6370,$740e0d8d,$e75b1357,$f8721671,$af537d5d,
  $4040cb08,$4eb4e2cc,$34d2466a,$0115af84,$e1b00428,$95983a1d,$06b89fb4,$ce6ea048,
  $6f3f3b82,$3520ab82,$011a1d4b,$277227f8,$611560b1,$e7933fdc,$bb3a792b,$344525bd,
  $a08839e1,$51ce794b,$2f32c9b7,$a01fbac9,$e01cc87e,$bcc7d1f6,$cf0111c3,$a1e8aac7,
  $1a908749,$d44fbd9a,$d0dadecb,$d50ada38,$0339c32a,$c6913667,$8df9317c,$e0b12b4f,
  $f79e59b7,$43f5bb3a,$f2d519ff,$27d9459c,$bf97222c,$15e6fc2a,$0f91fc71,$9b941525,
  $fae59361,$ceb69ceb,$c2a86459,$12baa8d1,$b6c1075e,$e3056a0c,$10d25065,$cb03a442,
  $e0ec6e0e,$1698db3b,$4c98a0be,$3278e964,$9f1f9532,$e0d392df,$d3a0342b,$8971f21e,
  $1b0a7441,$4ba3348c,$c5be7120,$c37632d8,$df359f8d,$9b992f2e,$e60b6f47,$0fe3f11d,
  $e54cda54,$1edad891,$ce6279cf,$cd3e7e6f,$1618b166,$fd2c1d05,$848fd2c5,$f6fb2299,
  $f523f357,$a6327623,$93a83531,$56cccd02,$acf08162,$5a75ebb5,$6e163697,$88d273cc,
  $de966292,$81b949d0,$4c50901b,$71c65614,$e6c6c7bd,$327a140a,$45e1d006,$c3f27b9a,
  $c9aa53fd,$62a80f00,$bb25bfe2,$35bdd2f6,$71126905,$b2040222,$b6cbcf7c,$cd769c2b,
  $53113ec0,$1640e3d3,$38abbd60,$2547adf0,$ba38209c,$f746ce76,$77afa1c5,$20756060,
  $85cbfe4e,$8ae88dd8,$7aaaf9b0,$4cf9aa7e,$1948c25c,$02fb8a8c,$01c36ae4,$d6ebe1f9,
  $90d4f869,$a65cdea0,$3f09252d,$c208e69f,$b74e6132,$ce77e25b,$578fdfe3,$3ac372e6));

function BlowfishSelfTest:Boolean;
const
 Key      : packed array[0..7] of Byte = ($01,$23,$45,$67,$89,$AB,$CD,$EF);
 InBlock  : packed array[0..7] of Byte = ($11,$11,$11,$11,$11,$11,$11,$11);
 OutBlock : packed array[0..7] of Byte = ($61,$F9,$C3,$80,$22,$81,$B0,$96);
var
 Data  : TBlowfishData;
 Block : packed array[0..7] of Byte;
begin
 Result:=False;
 try
  BlowfishInit(Data,@Key,SizeOf(Key),nil);
  BlowfishEncryptECB(Data,@InBlock,@Block);
  Result:=CompareMem(@Block,@OutBlock,SizeOf(Block));
  BlowfishDecryptECB(Data,@Block,@Block);
  Result:=Result and CompareMem(@Block,@InBlock,SizeOf(Block));
  BlowfishBurn(Data);
 except
  on E:Exception do BugReport(E,nil,'BlowfishSelfTest');
 end;
end;

procedure BlowfishInit(out Data:TBlowfishData; Key:Pointer; Len:Integer; IV:Pointer);
var
 i,k   : Integer;
 A     : LongWord;
 KeyB  : PByteArray;
 Block : packed array[0..7] of Byte;
begin
 if (Len<=0) or (Len>56)
 then RAISE ECrypt.Create('Blowfish: Key must be between 1 and 56 bytes long');
 KeyB:=Key;
 SafeMove(Blowfish_SBox,Data.SBoxM,SizeOf(Blowfish_SBox));
 SafeMove(Blowfish_PBox,Data.PBoxM,SizeOf(Blowfish_PBox));
 with Data do begin
  if IV=nil then begin
   SafeFillChar(InitBlock,8,0);
   SafeFillChar(LastBlock,8,0);
  end else begin
   SafeMove(IV^,InitBlock,8);
   SafeMove(IV^,LastBlock,8);
  end;
  k:=0;
  for i:=0 to 17 do begin
   A:=KeyB[(k+3) mod Len];
   A:=A + (KeyB[(k+2) mod Len] shl 8);
   A:=A + (KeyB[(k+1) mod Len] shl 16);
   A:=A + (KeyB[k] shl 24);
   PBoxM[i]:=PBoxM[i] xor A;
   k:=(k+4) mod Len;
  end;
  SafeFillChar(Block,SizeOf(Block),0);
  for i:=0 to 8 do begin
   BlowfishEncryptECB(Data,@Block,@Block);
   PBoxM[i*2]:=Block[3] + (Block[2] shl 8) + (Block[1] shl 16) + (Block[0] shl 24);
   PBoxM[i*2+1]:=Block[7] + (Block[6] shl 8) + (Block[5] shl 16) + (Block[4] shl 24);
  end;
  for k:=0 to 3 do begin
   for i:=0 to 127 do begin
    BlowfishEncryptECB(Data,@Block,@Block);
    SBoxM[k,i*2]:=Block[3] + (Block[2] shl 8) + (Block[1] shl 16) + (Block[0] shl 24);
    SBoxM[k,i*2+1]:=Block[7] + (Block[6] shl 8) + (Block[5] shl 16) + (Block[4] shl 24);
   end;
  end;
 end;
end;

procedure BlowfishBurn(out Data:TBlowfishData);
begin
 SafeFillChar(Data,SizeOf(Data),0);
end;

function Blowfish_F(Data: TBlowfishData; xL: LongWord): LongWord;
begin
 Result:=(((Data.SBoxM[0,(xL shr 24) and $FF] +
            Data.SBoxM[1,(xL shr 16) and $FF]) xor
            Data.SBoxM[2,(xL shr 8) and $FF]) +
            Data.SBoxM[3,xL and $FF]);
end;

procedure Blowfish_DoRound(Data: TBlowfishData; var xL, xR: LongWord; RNum: Integer);
begin
 xL:=xL xor Blowfish_F(Data,xR) xor Data.PBoxM[RNum];
end;

procedure BlowfishEncryptECB(var Data:TBlowfishData; InData,OutData:Pointer);
var
 xL, xR : LongWord;
begin
 SafeMove(InData^,xL,4);
 SafeMove(IncPtr(InData,4)^,xR,4);
 xL:=(xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24);
 xR:=(xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24);
 xL:=xL xor Data.PBoxM[0];
 Blowfish_DoRound(Data,xR,xL,1);
 Blowfish_DoRound(Data,xL,xR,2);
 Blowfish_DoRound(Data,xR,xL,3);
 Blowfish_DoRound(Data,xL,xR,4);
 Blowfish_DoRound(Data,xR,xL,5);
 Blowfish_DoRound(Data,xL,xR,6);
 Blowfish_DoRound(Data,xR,xL,7);
 Blowfish_DoRound(Data,xL,xR,8);
 Blowfish_DoRound(Data,xR,xL,9);
 Blowfish_DoRound(Data,xL,xR,10);
 Blowfish_DoRound(Data,xR,xL,11);
 Blowfish_DoRound(Data,xL,xR,12);
 Blowfish_DoRound(Data,xR,xL,13);
 Blowfish_DoRound(Data,xL,xR,14);
 Blowfish_DoRound(Data,xR,xL,15);
 Blowfish_DoRound(Data,xL,xR,16);
 xR:=xR xor Data.PBoxM[17];
 xL:=(xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24);
 xR:=(xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24);
 SafeMove(xR,OutData^,4);
 SafeMove(xL,IncPtr(OutData,4)^,4);
end;

procedure BlowfishDecryptECB(var Data:TBlowfishData; InData,OutData:Pointer);
var
 xL, xR : LongWord;
begin
 SafeMove(InData^,xL,4);
 SafeMove(IncPtr(InData,4)^,xR,4);
 xL:=(xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24);
 xR:=(xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24);
 xL:=xL xor Data.PBoxM[17];
 Blowfish_DoRound(Data,xR,xL,16);
 Blowfish_DoRound(Data,xL,xR,15);
 Blowfish_DoRound(Data,xR,xL,14);
 Blowfish_DoRound(Data,xL,xR,13);
 Blowfish_DoRound(Data,xR,xL,12);
 Blowfish_DoRound(Data,xL,xR,11);
 Blowfish_DoRound(Data,xR,xL,10);
 Blowfish_DoRound(Data,xL,xR,9);
 Blowfish_DoRound(Data,xR,xL,8);
 Blowfish_DoRound(Data,xL,xR,7);
 Blowfish_DoRound(Data,xR,xL,6);
 Blowfish_DoRound(Data,xL,xR,5);
 Blowfish_DoRound(Data,xR,xL,4);
 Blowfish_DoRound(Data,xL,xR,3);
 Blowfish_DoRound(Data,xR,xL,2);
 Blowfish_DoRound(Data,xL,xR,1);
 xR:=xR xor Data.PBoxM[0];
 xL:=(xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24);
 xR:=(xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24);
 SafeMove(xR,OutData^,4);
 SafeMove(xL,IncPtr(OutData,4)^,4);
end;

procedure BlowfishEncryptCBC(var Data:TBlowfishData; InData,OutData:Pointer);
begin
 XorBlock(InData,@Data.LastBlock,OutData,8);
 BlowfishEncryptECB(Data,OutData,OutData);
 SafeMove(OutData^,Data.LastBlock,8);
end;

procedure BlowfishDecryptCBC(var Data:TBlowfishData; InData,OutData:Pointer);
var
 TempBlock : packed array[0..7] of Byte;
begin
 SafeMove(InData^,TempBlock,8);
 BlowfishDecryptECB(Data,InData,OutData);
 XorBlock(OutData,@Data.LastBlock,OutData,8);
 SafeMove(TempBlock,Data.LastBlock,8);
end;

procedure BlowfishEncryptCFB(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  BlowfishEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=PByteArray(OutData)[i];
 end;
end;

procedure BlowfishDecryptCFB(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
var
 b         : Byte;
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  b:=PByteArray(InData)[i];
  BlowfishEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=b;
 end;
end;

procedure BlowfishEncryptOFB(var Data:TBlowfishData; InData,OutData:Pointer);
begin
 BlowfishEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure BlowfishDecryptOFB(var Data:TBlowfishData; InData,OutData:Pointer);
begin
 BlowfishEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure BlowfishEncryptOFBC(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  BlowfishEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure BlowfishDecryptOFBC(var Data:TBlowfishData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  BlowfishEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure BlowfishReset(var Data:TBlowfishData);
begin
 SafeMove(Data.InitBlock,Data.LastBlock,8);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // GOST encription
 ///////////////////////////////////////////////////////////////////////////////
const
 GOST_sTable: packed array[0..3, 0..255] of LongWord= (
 ($00072000,$00075000,$00074800,$00071000,$00076800,$00074000,$00070000,$00077000,
  $00073000,$00075800,$00070800,$00076000,$00073800,$00077800,$00072800,$00071800,
  $0005A000,$0005D000,$0005C800,$00059000,$0005E800,$0005C000,$00058000,$0005F000,
  $0005B000,$0005D800,$00058800,$0005E000,$0005B800,$0005F800,$0005A800,$00059800,
  $00022000,$00025000,$00024800,$00021000,$00026800,$00024000,$00020000,$00027000,
  $00023000,$00025800,$00020800,$00026000,$00023800,$00027800,$00022800,$00021800,
  $00062000,$00065000,$00064800,$00061000,$00066800,$00064000,$00060000,$00067000,
  $00063000,$00065800,$00060800,$00066000,$00063800,$00067800,$00062800,$00061800,
  $00032000,$00035000,$00034800,$00031000,$00036800,$00034000,$00030000,$00037000,
  $00033000,$00035800,$00030800,$00036000,$00033800,$00037800,$00032800,$00031800,
  $0006A000,$0006D000,$0006C800,$00069000,$0006E800,$0006C000,$00068000,$0006F000,
  $0006B000,$0006D800,$00068800,$0006E000,$0006B800,$0006F800,$0006A800,$00069800,
  $0007A000,$0007D000,$0007C800,$00079000,$0007E800,$0007C000,$00078000,$0007F000,
  $0007B000,$0007D800,$00078800,$0007E000,$0007B800,$0007F800,$0007A800,$00079800,
  $00052000,$00055000,$00054800,$00051000,$00056800,$00054000,$00050000,$00057000,
  $00053000,$00055800,$00050800,$00056000,$00053800,$00057800,$00052800,$00051800,
  $00012000,$00015000,$00014800,$00011000,$00016800,$00014000,$00010000,$00017000,
  $00013000,$00015800,$00010800,$00016000,$00013800,$00017800,$00012800,$00011800,
  $0001A000,$0001D000,$0001C800,$00019000,$0001E800,$0001C000,$00018000,$0001F000,
  $0001B000,$0001D800,$00018800,$0001E000,$0001B800,$0001F800,$0001A800,$00019800,
  $00042000,$00045000,$00044800,$00041000,$00046800,$00044000,$00040000,$00047000,
  $00043000,$00045800,$00040800,$00046000,$00043800,$00047800,$00042800,$00041800,
  $0000A000,$0000D000,$0000C800,$00009000,$0000E800,$0000C000,$00008000,$0000F000,
  $0000B000,$0000D800,$00008800,$0000E000,$0000B800,$0000F800,$0000A800,$00009800,
  $00002000,$00005000,$00004800,$00001000,$00006800,$00004000,$00000000,$00007000,
  $00003000,$00005800,$00000800,$00006000,$00003800,$00007800,$00002800,$00001800,
  $0003A000,$0003D000,$0003C800,$00039000,$0003E800,$0003C000,$00038000,$0003F000,
  $0003B000,$0003D800,$00038800,$0003E000,$0003B800,$0003F800,$0003A800,$00039800,
  $0002A000,$0002D000,$0002C800,$00029000,$0002E800,$0002C000,$00028000,$0002F000,
  $0002B000,$0002D800,$00028800,$0002E000,$0002B800,$0002F800,$0002A800,$00029800,
  $0004A000,$0004D000,$0004C800,$00049000,$0004E800,$0004C000,$00048000,$0004F000,
  $0004B000,$0004D800,$00048800,$0004E000,$0004B800,$0004F800,$0004A800,$00049800),
 ($03A80000,$03C00000,$03880000,$03E80000,$03D00000,$03980000,$03A00000,$03900000,
  $03F00000,$03F80000,$03E00000,$03B80000,$03B00000,$03800000,$03C80000,$03D80000,
  $06A80000,$06C00000,$06880000,$06E80000,$06D00000,$06980000,$06A00000,$06900000,
  $06F00000,$06F80000,$06E00000,$06B80000,$06B00000,$06800000,$06C80000,$06D80000,
  $05280000,$05400000,$05080000,$05680000,$05500000,$05180000,$05200000,$05100000,
  $05700000,$05780000,$05600000,$05380000,$05300000,$05000000,$05480000,$05580000,
  $00A80000,$00C00000,$00880000,$00E80000,$00D00000,$00980000,$00A00000,$00900000,
  $00F00000,$00F80000,$00E00000,$00B80000,$00B00000,$00800000,$00C80000,$00D80000,
  $00280000,$00400000,$00080000,$00680000,$00500000,$00180000,$00200000,$00100000,
  $00700000,$00780000,$00600000,$00380000,$00300000,$00000000,$00480000,$00580000,
  $04280000,$04400000,$04080000,$04680000,$04500000,$04180000,$04200000,$04100000,
  $04700000,$04780000,$04600000,$04380000,$04300000,$04000000,$04480000,$04580000,
  $04A80000,$04C00000,$04880000,$04E80000,$04D00000,$04980000,$04A00000,$04900000,
  $04F00000,$04F80000,$04E00000,$04B80000,$04B00000,$04800000,$04C80000,$04D80000,
  $07A80000,$07C00000,$07880000,$07E80000,$07D00000,$07980000,$07A00000,$07900000,
  $07F00000,$07F80000,$07E00000,$07B80000,$07B00000,$07800000,$07C80000,$07D80000,
  $07280000,$07400000,$07080000,$07680000,$07500000,$07180000,$07200000,$07100000,
  $07700000,$07780000,$07600000,$07380000,$07300000,$07000000,$07480000,$07580000,
  $02280000,$02400000,$02080000,$02680000,$02500000,$02180000,$02200000,$02100000,
  $02700000,$02780000,$02600000,$02380000,$02300000,$02000000,$02480000,$02580000,
  $03280000,$03400000,$03080000,$03680000,$03500000,$03180000,$03200000,$03100000,
  $03700000,$03780000,$03600000,$03380000,$03300000,$03000000,$03480000,$03580000,
  $06280000,$06400000,$06080000,$06680000,$06500000,$06180000,$06200000,$06100000,
  $06700000,$06780000,$06600000,$06380000,$06300000,$06000000,$06480000,$06580000,
  $05A80000,$05C00000,$05880000,$05E80000,$05D00000,$05980000,$05A00000,$05900000,
  $05F00000,$05F80000,$05E00000,$05B80000,$05B00000,$05800000,$05C80000,$05D80000,
  $01280000,$01400000,$01080000,$01680000,$01500000,$01180000,$01200000,$01100000,
  $01700000,$01780000,$01600000,$01380000,$01300000,$01000000,$01480000,$01580000,
  $02A80000,$02C00000,$02880000,$02E80000,$02D00000,$02980000,$02A00000,$02900000,
  $02F00000,$02F80000,$02E00000,$02B80000,$02B00000,$02800000,$02C80000,$02D80000,
  $01A80000,$01C00000,$01880000,$01E80000,$01D00000,$01980000,$01A00000,$01900000,
  $01F00000,$01F80000,$01E00000,$01B80000,$01B00000,$01800000,$01C80000,$01D80000),
 ($30000002,$60000002,$38000002,$08000002,$28000002,$78000002,$68000002,$40000002,
  $20000002,$50000002,$48000002,$70000002,$00000002,$18000002,$58000002,$10000002,
  $B0000005,$E0000005,$B8000005,$88000005,$A8000005,$F8000005,$E8000005,$C0000005,
  $A0000005,$D0000005,$C8000005,$F0000005,$80000005,$98000005,$D8000005,$90000005,
  $30000005,$60000005,$38000005,$08000005,$28000005,$78000005,$68000005,$40000005,
  $20000005,$50000005,$48000005,$70000005,$00000005,$18000005,$58000005,$10000005,
  $30000000,$60000000,$38000000,$08000000,$28000000,$78000000,$68000000,$40000000,
  $20000000,$50000000,$48000000,$70000000,$00000000,$18000000,$58000000,$10000000,
  $B0000003,$E0000003,$B8000003,$88000003,$A8000003,$F8000003,$E8000003,$C0000003,
  $A0000003,$D0000003,$C8000003,$F0000003,$80000003,$98000003,$D8000003,$90000003,
  $30000001,$60000001,$38000001,$08000001,$28000001,$78000001,$68000001,$40000001,
  $20000001,$50000001,$48000001,$70000001,$00000001,$18000001,$58000001,$10000001,
  $B0000000,$E0000000,$B8000000,$88000000,$A8000000,$F8000000,$E8000000,$C0000000,
  $A0000000,$D0000000,$C8000000,$F0000000,$80000000,$98000000,$D8000000,$90000000,
  $B0000006,$E0000006,$B8000006,$88000006,$A8000006,$F8000006,$E8000006,$C0000006,
  $A0000006,$D0000006,$C8000006,$F0000006,$80000006,$98000006,$D8000006,$90000006,
  $B0000001,$E0000001,$B8000001,$88000001,$A8000001,$F8000001,$E8000001,$C0000001,
  $A0000001,$D0000001,$C8000001,$F0000001,$80000001,$98000001,$D8000001,$90000001,
  $30000003,$60000003,$38000003,$08000003,$28000003,$78000003,$68000003,$40000003,
  $20000003,$50000003,$48000003,$70000003,$00000003,$18000003,$58000003,$10000003,
  $30000004,$60000004,$38000004,$08000004,$28000004,$78000004,$68000004,$40000004,
  $20000004,$50000004,$48000004,$70000004,$00000004,$18000004,$58000004,$10000004,
  $B0000002,$E0000002,$B8000002,$88000002,$A8000002,$F8000002,$E8000002,$C0000002,
  $A0000002,$D0000002,$C8000002,$F0000002,$80000002,$98000002,$D8000002,$90000002,
  $B0000004,$E0000004,$B8000004,$88000004,$A8000004,$F8000004,$E8000004,$C0000004,
  $A0000004,$D0000004,$C8000004,$F0000004,$80000004,$98000004,$D8000004,$90000004,
  $30000006,$60000006,$38000006,$08000006,$28000006,$78000006,$68000006,$40000006,
  $20000006,$50000006,$48000006,$70000006,$00000006,$18000006,$58000006,$10000006,
  $B0000007,$E0000007,$B8000007,$88000007,$A8000007,$F8000007,$E8000007,$C0000007,
  $A0000007,$D0000007,$C8000007,$F0000007,$80000007,$98000007,$D8000007,$90000007,
  $30000007,$60000007,$38000007,$08000007,$28000007,$78000007,$68000007,$40000007,
  $20000007,$50000007,$48000007,$70000007,$00000007,$18000007,$58000007,$10000007),
 ($000000E8,$000000D8,$000000A0,$00000088,$00000098,$000000F8,$000000A8,$000000C8,
  $00000080,$000000D0,$000000F0,$000000B8,$000000B0,$000000C0,$00000090,$000000E0,
  $000007E8,$000007D8,$000007A0,$00000788,$00000798,$000007F8,$000007A8,$000007C8,
  $00000780,$000007D0,$000007F0,$000007B8,$000007B0,$000007C0,$00000790,$000007E0,
  $000006E8,$000006D8,$000006A0,$00000688,$00000698,$000006F8,$000006A8,$000006C8,
  $00000680,$000006D0,$000006F0,$000006B8,$000006B0,$000006C0,$00000690,$000006E0,
  $00000068,$00000058,$00000020,$00000008,$00000018,$00000078,$00000028,$00000048,
  $00000000,$00000050,$00000070,$00000038,$00000030,$00000040,$00000010,$00000060,
  $000002E8,$000002D8,$000002A0,$00000288,$00000298,$000002F8,$000002A8,$000002C8,
  $00000280,$000002D0,$000002F0,$000002B8,$000002B0,$000002C0,$00000290,$000002E0,
  $000003E8,$000003D8,$000003A0,$00000388,$00000398,$000003F8,$000003A8,$000003C8,
  $00000380,$000003D0,$000003F0,$000003B8,$000003B0,$000003C0,$00000390,$000003E0,
  $00000568,$00000558,$00000520,$00000508,$00000518,$00000578,$00000528,$00000548,
  $00000500,$00000550,$00000570,$00000538,$00000530,$00000540,$00000510,$00000560,
  $00000268,$00000258,$00000220,$00000208,$00000218,$00000278,$00000228,$00000248,
  $00000200,$00000250,$00000270,$00000238,$00000230,$00000240,$00000210,$00000260,
  $000004E8,$000004D8,$000004A0,$00000488,$00000498,$000004F8,$000004A8,$000004C8,
  $00000480,$000004D0,$000004F0,$000004B8,$000004B0,$000004C0,$00000490,$000004E0,
  $00000168,$00000158,$00000120,$00000108,$00000118,$00000178,$00000128,$00000148,
  $00000100,$00000150,$00000170,$00000138,$00000130,$00000140,$00000110,$00000160,
  $000001E8,$000001D8,$000001A0,$00000188,$00000198,$000001F8,$000001A8,$000001C8,
  $00000180,$000001D0,$000001F0,$000001B8,$000001B0,$000001C0,$00000190,$000001E0,
  $00000768,$00000758,$00000720,$00000708,$00000718,$00000778,$00000728,$00000748,
  $00000700,$00000750,$00000770,$00000738,$00000730,$00000740,$00000710,$00000760,
  $00000368,$00000358,$00000320,$00000308,$00000318,$00000378,$00000328,$00000348,
  $00000300,$00000350,$00000370,$00000338,$00000330,$00000340,$00000310,$00000360,
  $000005E8,$000005D8,$000005A0,$00000588,$00000598,$000005F8,$000005A8,$000005C8,
  $00000580,$000005D0,$000005F0,$000005B8,$000005B0,$000005C0,$00000590,$000005E0,
  $00000468,$00000458,$00000420,$00000408,$00000418,$00000478,$00000428,$00000448,
  $00000400,$00000450,$00000470,$00000438,$00000430,$00000440,$00000410,$00000460,
  $00000668,$00000658,$00000620,$00000608,$00000618,$00000678,$00000628,$00000648,
  $00000600,$00000650,$00000670,$00000638,$00000630,$00000640,$00000610,$00000660));

function GOSTSelfTest:Boolean;
const
 Key       : packed array[0..31] of Byte=($BE,$5E,$C2,$00,$6C,$FF,$9D,$CF,$52,$35,
                                          $49,$59,$F1,$FF,$0C,$BF,$E9,$50,$61,$B5,
                                          $A6,$48,$C1,$03,$87,$06,$9C,$25,$99,$7C,
                                          $06,$72);
  InBlock  : packed array[0..7] of Byte=($0D,$F8,$28,$02,$B7,$41,$A2,$92);
  OutBlock : packed array[0..7] of Byte=($07,$F9,$02,$7D,$F7,$F7,$DF,$89);
var
  Data  : TGOSTData;
  Block : packed array[0..7] of Byte;
begin
 Result:=false;
 try
  GOSTInit(Data,@Key,Sizeof(Key),nil);
  GOSTEncryptECB(Data,@InBlock,@Block);
  Result:=CompareMem(@Block,@OutBlock,Sizeof(Block));
  GOSTDecryptECB(Data,@Block,@Block);
  Result:=Result and CompareMem(@Block,@InBlock,Sizeof(Block));
  GOSTBurn(Data);
 except
  on E:Exception do BugReport(E,nil,'GOSTSelfTest');
 end;
end;

procedure GOSTInit(out Data:TGOSTData; Key:Pointer; Len:Integer; IV:Pointer);
var
 i       : Integer;
 UserKey : PByteArray;
begin
 if (Len<>32) then RAISE ECrypt.Create('GOST: Invalid key length');
 UserKey:=Key;
 with Data do begin
  if IV=nil then begin
   SafeFillChar(InitBlock,8,0);
   SafeFillChar(LastBlock,8,0);
  end else begin
   SafeMove(IV^,InitBlock,8);
   SafeMove(IV^,LastBlock,8);
  end;
  for i:=0 to 7 do
  XKey[i]:=(UserKey[4*i+3] shl 24) or (UserKey[4*i+2] shl 16) or
           (UserKey[4*i+1] shl 8) or (UserKey[4*i+0]);
 end;
end;

procedure GOSTBurn(out Data:TGOSTData);
begin
 SafeFillChar(Data,Sizeof(Data),0);
end;

function GOST_F(const x:LongWord):LongWord;
begin
 Result:=GOST_sTable[3,x shr 24] xor
         GOST_sTable[2,(x shr 16) and $FF] xor
         GOST_sTable[1,(x shr 8) and $FF] xor
         GOST_sTable[0,x and $FF];
end;

procedure GOSTEncryptECB(const Data:TGOSTData; InData,OutData:Pointer);
var
 i      : Integer;
 n1, n2 : LongWord;
begin
 SafeMove(InData^,n1,4);
 SafeMove(IncPtr(InData,4)^,n2,4);
 for i:=0 to 2 do begin
  n2:=n2 xor GOST_F(n1+Data.XKey[0]);
  n1:=n1 xor GOST_F(n2+Data.XKey[1]);
  n2:=n2 xor GOST_F(n1+Data.XKey[2]);
  n1:=n1 xor GOST_F(n2+Data.XKey[3]);
  n2:=n2 xor GOST_F(n1+Data.XKey[4]);
  n1:=n1 xor GOST_F(n2+Data.XKey[5]);
  n2:=n2 xor GOST_F(n1+Data.XKey[6]);
  n1:=n1 xor GOST_F(n2+Data.XKey[7]);
 end;
 n2:=n2 xor GOST_F(n1+Data.XKey[7]);
 n1:=n1 xor GOST_F(n2+Data.XKey[6]);
 n2:=n2 xor GOST_F(n1+Data.XKey[5]);
 n1:=n1 xor GOST_F(n2+Data.XKey[4]);
 n2:=n2 xor GOST_F(n1+Data.XKey[3]);
 n1:=n1 xor GOST_F(n2+Data.XKey[2]);
 n2:=n2 xor GOST_F(n1+Data.XKey[1]);
 n1:=n1 xor GOST_F(n2+Data.XKey[0]);
 SafeMove(n2,OutData^,4);
 SafeMove(n1,IncPtr(OutData,4)^,4);
end;

procedure GOSTDecryptECB(const Data:TGOSTData; InData,OutData:Pointer);
var
 i: Integer;
 n1, n2: LongWord;
begin
 SafeMove(InData^,n1,4);
 SafeMove(IncPtr(InData,4)^,n2,4);
 n2:=n2 xor GOST_F(n1+Data.XKey[0]);
 n1:=n1 xor GOST_F(n2+Data.XKey[1]);
 n2:=n2 xor GOST_F(n1+Data.XKey[2]);
 n1:=n1 xor GOST_F(n2+Data.XKey[3]);
 n2:=n2 xor GOST_F(n1+Data.XKey[4]);
 n1:=n1 xor GOST_F(n2+Data.XKey[5]);
 n2:=n2 xor GOST_F(n1+Data.XKey[6]);
 n1:=n1 xor GOST_F(n2+Data.XKey[7]);
 for i:=0 to 2 do begin
  n2:=n2 xor GOST_F(n1+Data.XKey[7]);
  n1:=n1 xor GOST_F(n2+Data.XKey[6]);
  n2:=n2 xor GOST_F(n1+Data.XKey[5]);
  n1:=n1 xor GOST_F(n2+Data.XKey[4]);
  n2:=n2 xor GOST_F(n1+Data.XKey[3]);
  n1:=n1 xor GOST_F(n2+Data.XKey[2]);
  n2:=n2 xor GOST_F(n1+Data.XKey[1]);
  n1:=n1 xor GOST_F(n2+Data.XKey[0]);
 end;
 SafeMove(n2,OutData^,4);
 SafeMove(n1,IncPtr(OutData,4)^,4);
end;

procedure GOSTEncryptCBC(var Data:TGOSTData; InData,OutData:Pointer);
begin
 XorBlock(InData,@Data.LastBlock,OutData,8);
 GOSTEncryptECB(Data,OutData,OutData);
 SafeMove(OutData^,Data.LastBlock,8);
end;

procedure GOSTDecryptCBC(var Data:TGOSTData; InData,OutData:Pointer);
var
 TempBlock: packed array[0..7] of Byte;
begin
 SafeMove(InData^,TempBlock,8);
 GOSTDecryptECB(Data,InData,OutData);
 XorBlock(OutData,@Data.LastBlock,OutData,8);
 SafeMove(TempBlock,Data.LastBlock,8);
end;

procedure GOSTEncryptCFB(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  GOSTEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=PByteArray(OutData)[i];
 end;
end;

procedure GOSTDecryptCFB(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
var
 b         : Byte;
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  b:=PByteArray(InData)[i];
  GOSTEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=b;
 end;
end;

procedure GOSTEncryptOFB(var Data:TGOSTData; InData,OutData:Pointer);
begin
 GOSTEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure GOSTDecryptOFB(var Data: TGOSTData; InData,OutData:Pointer);
begin
 GOSTEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure GOSTEncryptOFBC(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  GOSTEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure GOSTDecryptOFBC(var Data:TGOSTData; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  GOSTEncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure GOSTReset(var Data:TGOSTData);
begin
 SafeMove(Data.InitBlock,Data.LastBlock,8);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // RC2 encription
 ///////////////////////////////////////////////////////////////////////////////
const
 RC2_sBox: array[0..255] of Byte= (
  $D9,$78,$F9,$C4,$19,$DD,$B5,$ED,$28,$E9,$FD,$79,$4A,$A0,$D8,$9D,
  $C6,$7E,$37,$83,$2B,$76,$53,$8E,$62,$4C,$64,$88,$44,$8B,$FB,$A2,
  $17,$9A,$59,$F5,$87,$B3,$4F,$13,$61,$45,$6D,$8D,$09,$81,$7D,$32,
  $BD,$8F,$40,$EB,$86,$B7,$7B,$0B,$F0,$95,$21,$22,$5C,$6B,$4E,$82,
  $54,$D6,$65,$93,$CE,$60,$B2,$1C,$73,$56,$C0,$14,$A7,$8C,$F1,$DC,
  $12,$75,$CA,$1F,$3B,$BE,$E4,$D1,$42,$3D,$D4,$30,$A3,$3C,$B6,$26,
  $6F,$BF,$0E,$DA,$46,$69,$07,$57,$27,$F2,$1D,$9B,$BC,$94,$43,$03,
  $F8,$11,$C7,$F6,$90,$EF,$3E,$E7,$06,$C3,$D5,$2F,$C8,$66,$1E,$D7,
  $08,$E8,$EA,$DE,$80,$52,$EE,$F7,$84,$AA,$72,$AC,$35,$4D,$6A,$2A,
  $96,$1A,$D2,$71,$5A,$15,$49,$74,$4B,$9F,$D0,$5E,$04,$18,$A4,$EC,
  $C2,$E0,$41,$6E,$0F,$51,$CB,$CC,$24,$91,$AF,$50,$A1,$F4,$70,$39,
  $99,$7C,$3A,$85,$23,$B8,$B4,$7A,$FC,$02,$36,$5B,$25,$55,$97,$31,
  $2D,$5D,$FA,$98,$E3,$8A,$92,$AE,$05,$DF,$29,$10,$67,$6C,$BA,$C9,
  $D3,$00,$E6,$CF,$E1,$9E,$A8,$2C,$63,$16,$01,$3F,$58,$E2,$89,$A9,
  $0D,$38,$34,$1B,$AB,$33,$FF,$B0,$BB,$48,$0C,$5F,$B9,$B1,$CD,$2E,
  $C5,$F3,$DB,$47,$E5,$A5,$9C,$77,$0A,$A6,$20,$68,$FE,$7F,$C1,$AD);

function RC2SelfTest:Boolean;
const
 Key      : packed array[0..15] of Byte=
    ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F);
 InBlock  : packed array[0..7] of Byte=($00,$00,$00,$00,$00,$00,$00,$00);
 OutBlock : packed array[0..7] of Byte=($50,$DC,$01,$62,$BD,$75,$7F,$31);
var
 Data  : TRC2Data;
 Block : packed array[0..7] of Byte;
begin
 Result:=false;
 try
  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);
 except
  on E:Exception do BugReport(E,nil,'RC2SelfTest');
 end;
end;

procedure RC2Init(out Data:TRC2Data; Key:Pointer; Len:Integer; IV:Pointer);
var
  i: Integer;
begin
 if (Len<1) or (Len>128) then RAISE ECrypt.Create('RC2: Invalid key length');
 with Data do begin
  if IV= nil then begin
   SafeFillChar(InitBlock,8,0);
   SafeFillChar(LastBlock,8,0);
  end else begin
   SafeMove(IV^,InitBlock,8);
   SafeMove(IV^,LastBlock,8);
  end;
  SafeMove(Key^,KeyB,Len);
  for i:=Len to 127 do KeyB[i]:=RC2_sBox[(KeyB[i-Len]+KeyB[i-1]) and $FF];
  KeyB[0]:=RC2_sBox[KeyB[0]];
 end;
end;

procedure RC2Burn(out Data:TRC2Data);
begin
 SafeFillChar(Data,Sizeof(Data),0);
end;

procedure RC2EncryptECB(var Data:TRC2Data; InData,OutData:Pointer);
var
 i, j           : Integer;
 w0, w1, w2, w3 : Word;
begin
 SafeMove(InData^,w0,2);
 SafeMove(IncPtr(InData,2)^,w1,2);
 SafeMove(IncPtr(InData,4)^,w2,2);
 SafeMove(IncPtr(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;
 SafeMove(w0,OutData^,2);
 SafeMove(w1,IncPtr(OutData,2)^,2);
 SafeMove(w2,IncPtr(OutData,4)^,2);
 SafeMove(w3,IncPtr(OutData,6)^,2);
end;

procedure RC2DecryptECB(var Data:TRC2Data; InData,OutData:Pointer);
var
 i, j           : Integer;
 w0, w1, w2, w3 : Word;
begin
 SafeMove(InData^,w0,2);
 SafeMove(IncPtr(InData,2)^,w1,2);
 SafeMove(IncPtr(InData,4)^,w2,2);
 SafeMove(IncPtr(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;
 SafeMove(w0,OutData^,2);
 SafeMove(w1,IncPtr(OutData,2)^,2);
 SafeMove(w2,IncPtr(OutData,4)^,2);
 SafeMove(w3,IncPtr(OutData,6)^,2);
end;

procedure RC2EncryptCBC(var Data:TRC2Data; InData,OutData:Pointer);
begin
 XorBlock(InData,@Data.LastBlock,OutData,8);
 RC2EncryptECB(Data,OutData,OutData);
 SafeMove(OutData^,Data.LastBlock,8);
end;

procedure RC2DecryptCBC(var Data:TRC2Data; InData,OutData:Pointer);
var
 TempBlock : packed array[0..7] of Byte;
begin
 SafeMove(InData^,TempBlock,8);
 RC2DecryptECB(Data,InData,OutData);
 XorBlock(OutData,@Data.LastBlock,OutData,8);
 SafeMove(TempBlock,Data.LastBlock,8);
end;

procedure RC2EncryptCFB(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=PByteArray(OutData)[i];
 end;
end;

procedure RC2DecryptCFB(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
var
 b         : Byte;
 i         : Integer;
 TempBlock : packed array[0..7] of 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];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=b;
 end;
end;

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

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

procedure RC2EncryptOFBC(var Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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 Data:TRC2Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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(var Data:TRC2Data);
begin
 SafeMove(Data.InitBlock,Data.LastBlock,8);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // RC4 encription
 ///////////////////////////////////////////////////////////////////////////////
function RC4SelfTest:Boolean;
const
 InBlock  : packed array[0..4] of Byte = ($dc,$ee,$4c,$f9,$2c);
 OutBlock : packed array[0..4] of Byte = ($f1,$38,$29,$c9,$de);
 Key      : packed array[0..4] of Byte = ($61,$8a,$63,$d2,$fb);
var
 Data  : TRC4Data;
 Block : packed array[0..4] of Byte;
begin
 Result:=false;
 try
  RC4Init(Data,@Key,5);
  RC4Crypt(Data,@InBlock,@Block,5);
  Result:=CompareMem(@Block,@OutBlock,5);
  RC4Reset(Data);
  RC4Crypt(Data,@Block,@Block,5);
  Result:=Result and CompareMem(@Block,@InBlock,5);
  RC4Burn(Data);
 except
  on E:Exception do BugReport(E,nil,'RC4SelfTest');
 end;
end;

procedure RC4Init(out Data:TRC4Data; Key:Pointer; Len:Integer);
var
 t    : Byte;
 i, j : Integer;
 xKey : packed array[0..255] of Byte;
begin
 if (Len<1) or (Len>256) then RAISE ECrypt.Create('RC4: Invalid key length');
 for i:=0 to 255 do begin
  Data.Key[i]:=i;
  xKey[i]:=PByteArray(Key)^[i mod Len];
 end;
 j:=0;
 for i:=0 to 255 do begin
  j:=(j+Data.Key[i]+xKey[i]) and $FF;
  t:=Data.Key[i];
  Data.Key[i]:=Data.Key[j];
  Data.Key[j]:=t;
 end;
 SafeMove(Data.Key,Data.OrgKey,256);
end;

procedure RC4Burn(out Data:TRC4Data);
begin
 SafeFillChar(Data,Sizeof(Data),$FF);
end;

procedure RC4Crypt(var Data:TRC4Data; InData,OutData:Pointer; Len:Integer);
var
 t, i, j : Byte;
 k       : Integer;
begin
 i:=0;
 j:=0;
 for k:=0 to Len-1 do begin
  i:=(i+1) and $FF;
  j:=(j+Data.Key[i]) and $FF;
  t:=Data.Key[i];
  Data.Key[i]:=Data.Key[j];
  Data.Key[j]:=t;
  t:=(Data.Key[i]+Data.Key[j]) and $FF;
  PByteArray(OutData)[k]:=PByteArray(InData)[k] xor Data.Key[t];
 end;
end;

procedure RC4Reset(var Data:TRC4Data);
begin
 SafeMove(Data.OrgKey,Data.Key,256);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // RC5 encription
 ///////////////////////////////////////////////////////////////////////////////
const
 RC5_sBox: packed array[0..33] of LongWord= (
  $B7E15163,$5618CB1C,$F45044D5,$9287BE8E,$30BF3847,$CEF6B200,
  $6D2E2BB9,$0B65A572,$A99D1F2B,$47D498E4,$E60C129D,$84438C56,
  $227B060F,$C0B27FC8,$5EE9F981,$FD21733A,$9B58ECF3,$399066AC,
  $D7C7E065,$75FF5A1E,$1436D3D7,$B26E4D90,$50A5C749,$EEDD4102,
  $8D14BABB,$2B4C3474,$C983AE2D,$67BB27E6,$05F2A19F,$A42A1B58,
  $42619511,$E0990ECA,$7ED08883,$1D08023C);

function RC5SelfTest:Boolean;
const
  Key      : packed array[0..15] of Byte=
    ($91,$5F,$46,$19,$BE,$41,$B2,$51,$63,$55,$A5,$01,$10,$A9,$CE,$91);
  InBlock  : packed array[0..1] of LongWord = ($EEDBA521,$6D8F4B15);
  OutBlock : packed array[0..1] of LongWord = ($AC13C0F7,$52892B5B);
var
 Data  : TRC5Data;
 Block : packed array[0..7] of Byte;
begin
 Result:=false;
 try
  RC5Init(Data,@Key,Sizeof(Key),nil);
  RC5EncryptECB(Data,@InBlock,@Block);
  Result:=CompareMem(@Block,@OutBlock,Sizeof(Block)) or not (RC5NUMROUNDS=12);
  RC5DecryptECB(Data,@Block,@Block);
  Result:=Result and CompareMem(@Block,@InBlock,Sizeof(Block));
  RC5Burn(Data);
 except
  on E:Exception do BugReport(E,nil,'RC5SelfTest');
 end;
end;

procedure RC5Init(out Data:TRC5Data; Key:Pointer; Len:Integer; IV:Pointer);
var
 A, B             : LongWord;
 i, j, k, xKeyLen : Integer;
 xKeyD            : packed array[0..63] of LongWord;
begin
 if (Len<1) or (Len>256)
 then RAISE ECrypt.Create('RC5: Key length must be between 1 and 256 bytes');
 if IV=nil then begin
  SafeFillChar(Data.InitBlock,8,0);
  SafeFillChar(Data.LastBlock,8,0);
 end else begin
  SafeMove(IV^,Data.InitBlock,8);
  SafeMove(IV^,Data.LastBlock,8);
 end;
 SafeFillChar(xKeyD,Sizeof(xKeyD),0);
 SafeMove(Key^,xKeyD,Len);
 with Data do begin
  xKeyLen:=Len div 4;
  if (Len mod 4)<>0 then Inc(xKeyLen);
  SafeMove(RC5_sBox,Key,(RC5NUMROUNDS+1)*8);
  i:=0; j:=0;
  A:=0; B:=0;
  if xKeyLen>((RC5NUMROUNDS+1)*2) then k:=xKeyLen*3 else k:=(RC5NUMROUNDS+1)*6;
  for k:=k downto 1 do begin
   A:=LRot32(Key[i]+A+B,3);
   Key[i]:=A;
   B:=LRot32(xKeyD[j]+A+B,A+B);
   xKeyD[j]:=B;
   i:=(i+1) mod ((RC5NUMROUNDS+1)*2);
   j:=(j+1) mod xKeyLen;
  end;
  SafeFillChar(xKeyD,Sizeof(xKeyD),0);
 end;
end;

procedure RC5Burn(out Data:TRC5Data);
begin
 SafeFillChar(Data,Sizeof(Data),0);
end;

procedure RC5EncryptECB(var Data:TRC5Data; InData,OutData:Pointer);
var
 i    : Integer;
 A, B : LongWord;
begin
 SafeMove(InData^,A,4);
 SafeMove(IncPtr(InData,4)^,B,4);
 A:=A + Data.Key[0];
 B:=B + Data.Key[1];
 for i:=1 to RC5NUMROUNDS do begin
  A:=A xor B;
  A:=LRot32(A,B)+Data.Key[2*i];
  B:=B xor A;
  B:=LRot32(B,A)+Data.Key[(2*i)+1];
 end;
 SafeMove(A,OutData^,4);
 SafeMove(B,IncPtr(OutData,4)^,4);
end;

procedure RC5DecryptECB(var Data:TRC5Data; InData,OutData:Pointer);
var
 i    : Integer;
 A, B : LongWord;
begin
 SafeMove(InData^,A,4);
 SafeMove(IncPtr(InData,4)^,B,4);
 for i:=RC5NUMROUNDS downto 1 do begin
  B:=RRot32(B-Data.Key[(2*i)+1],A);
  B:=B xor A;
  A:=RRot32(A-Data.Key[2*i],B);
  A:=A xor B;
 end;
 B:=B - Data.Key[1];
 A:=A - Data.Key[0];
 SafeMove(A,OutData^,4);
 SafeMove(B,IncPtr(OutData,4)^,4);
end;

procedure RC5EncryptCBC(var Data:TRC5Data; InData,OutData:Pointer);
begin
 XorBlock(InData,@Data.LastBlock,OutData,8);
 RC5EncryptECB(Data,OutData,OutData);
 SafeMove(OutData^,Data.LastBlock,8);
end;

procedure RC5DecryptCBC(var Data:TRC5Data; InData,OutData:Pointer);
var
 TempBlock : packed array[0..7] of Byte;
begin
 SafeMove(InData^,TempBlock,8);
 RC5DecryptECB(Data,InData,OutData);
 XorBlock(OutData,@Data.LastBlock,OutData,8);
 SafeMove(TempBlock,Data.LastBlock,8);
end;

procedure RC5EncryptCFB(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  RC5EncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=PByteArray(OutData)[i];
 end;
end;

procedure RC5DecryptCFB(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
var
 b         : Byte;
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  b:=PByteArray(InData)[i];
  RC5EncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],7);
  Data.LastBlock[7]:=b;
 end;
end;

procedure RC5EncryptOFB(var Data:TRC5Data; InData,OutData:Pointer);
begin
 RC5EncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure RC5DecryptOFB(var Data:TRC5Data; InData,OutData:Pointer);
begin
 RC5EncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
 XorBlock(@Data.LastBlock,InData,OutData,8);
end;

procedure RC5EncryptOFBC(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  RC5EncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure RC5DecryptOFBC(var Data:TRC5Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed array[0..7] of Byte;
begin
 for i:=0 to Len-1 do begin
  RC5EncryptECB(Data,@Data.LastBlock,@TempBlock);
  PByteArray(OutData)[i]:=PByteArray(InData)[i] xor TempBlock[0];
  IncBlock(@Data.LastBlock,8);
 end;
end;

procedure RC5Reset(var Data:TRC5Data);
begin
 SafeMove(Data.InitBlock,Data.LastBlock,8);
end;

 ///////////////////////////////////////////////////////////////////////////////
 // RC6 encription
 ///////////////////////////////////////////////////////////////////////////////
const
 RC6_sBox: packed array[0..51] of LongWord= (
  $B7E15163,$5618CB1C,$F45044D5,$9287BE8E,$30BF3847,$CEF6B200,
  $6D2E2BB9,$0B65A572,$A99D1F2B,$47D498E4,$E60C129D,$84438C56,
  $227B060F,$C0B27FC8,$5EE9F981,$FD21733A,$9B58ECF3,$399066AC,
  $D7C7E065,$75FF5A1E,$1436D3D7,$B26E4D90,$50A5C749,$EEDD4102,
  $8D14BABB,$2B4C3474,$C983AE2D,$67BB27E6,$05F2A19F,$A42A1B58,
  $42619511,$E0990ECA,$7ED08883,$1D08023C,$BB3F7BF5,$5976F5AE,
  $F7AE6F67,$95E5E920,$341D62D9,$D254DC92,$708C564B,$0EC3D004,
  $ACFB49BD,$4B32C376,$E96A3D2F,$87A1B6E8,$25D930A1,$C410AA5A,
  $62482413,$007F9DCC,$9EB71785,$3CEE913E);

function  RC6SelfTest:Boolean;
const
 Key      : packed array[0..15] of Byte=
    ($01,$23,$45,$67,$89,$ab,$cd,$ef,$01,$12,$23,$34,$45,$56,$67,$78);
 InBlock  : packed array[0..15] of Byte=
    ($02,$13,$24,$35,$46,$57,$68,$79,$8a,$9b,$ac,$bd,$ce,$df,$e0,$f1);
 OutBlock : packed array[0..15] of Byte=
    ($52,$4e,$19,$2f,$47,$15,$c6,$23,$1f,$51,$f6,$36,$7e,$a4,$3f,$18);
var
 Data  : TRC6Data;
 Block : packed array[0..15] of Byte;
begin
 Result:=false;
 try
  RC6Init(Data,@Key,Sizeof(Key),nil);
  RC6EncryptECB(Data,@InBlock,@Block);
  Result:=CompareMem(@Block,@OutBlock,Sizeof(Block)) or not (RC6NUMROUNDS=20);
  RC6DecryptECB(Data,@Block,@Block);
  Result:=Result and CompareMem(@Block,@InBlock,Sizeof(Block));
  RC6Burn(Data);
 except
  on E:Exception do BugReport(E,nil,'RC6SelfTest');
 end;
end;

procedure RC6Init(out Data:TRC6Data; Key:Pointer; Len:Integer; IV:Pointer);
var
 A, B             : LongWord;
 i, j, k, xKeyLen : Integer;
 xKeyD            : packed array[0..63] of LongWord;
begin
 if (Len<1) or (Len>256)
 then RAISE ECrypt.Create('RC6: Key length must be between 1 and 256 bytes');
 with Data do begin
  if IV= nil then begin
   SafeFillChar(InitBlock,16,0);
   SafeFillChar(LastBlock,16,0);
  end else begin
   SafeMove(IV^,InitBlock,16);
   SafeMove(IV^,LastBlock,16);
  end;
  SafeFillChar(xKeyD,Sizeof(xKeyD),0);
  SafeMove(Key^,xKeyD,Len);
  xKeyLen:=Len div 4;
  if (Len mod 4)<>0 then Inc(xKeyLen);
  SafeMove(RC6_sBox,KeyD,((RC6NUMROUNDS*2)+4)*4);
  i:=0; j:=0;
  A:=0; B:=0;
  if xKeyLen>((RC6NUMROUNDS*2)+4) then k:=xKeyLen*3 else k:=((RC6NUMROUNDS*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 ((RC6NUMROUNDS*2)+4);
   j:=(j+1) mod xKeyLen;
  end;
  SafeFillChar(xKeyD,Sizeof(xKeyD),0);
 end;
end;

procedure RC6Burn(out Data:TRC6Data);
begin
 SafeFillChar(Data,Sizeof(Data),0);
end;

procedure RC6EncryptECB(var Data:TRC6Data; InData,OutData:Pointer);
var
 i                : Integer;
 A, B, C, D, t, u : LongWord;
begin
 SafeMove(InData^,A,4);
 SafeMove(IncPtr(InData,4)^,B,4);
 SafeMove(IncPtr(InData,8)^,C,4);
 SafeMove(IncPtr(InData,12)^,D,4);
 B:=B + Data.KeyD[0];
 D:=D + Data.KeyD[1];
 for i:=1 to RC6NUMROUNDS 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*RC6NUMROUNDS)+2];
 C:=C + Data.KeyD[(2*RC6NUMROUNDS)+3];
 SafeMove(A,OutData^,4);
 SafeMove(B,IncPtr(OutData,4)^,4);
 SafeMove(C,IncPtr(OutData,8)^,4);
 SafeMove(D,IncPtr(OutData,12)^,4);
end;

procedure RC6DecryptECB(var Data:TRC6Data; InData,OutData:Pointer);
var
 i                : Integer;
 A, B, C, D, t, u : LongWord;
begin
 SafeMove(InData^,A,4);
 SafeMove(IncPtr(InData,4)^,B,4);
 SafeMove(IncPtr(InData,8)^,C,4);
 SafeMove(IncPtr(InData,12)^,D,4);
 C:=C - Data.KeyD[(2*RC6NUMROUNDS)+3];
 A:=A - Data.KeyD[(2*RC6NUMROUNDS)+2];
 for i:=RC6NUMROUNDS 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];
 SafeMove(A,OutData^,4);
 SafeMove(B,IncPtr(OutData,4)^,4);
 SafeMove(C,IncPtr(OutData,8)^,4);
 SafeMove(D,IncPtr(OutData,12)^,4);
end;

procedure RC6EncryptCBC(var Data:TRC6Data; InData,OutData:Pointer);
begin
 XorBlock(InData,@Data.LastBlock,OutData,16);
 RC6EncryptECB(Data,OutData,OutData);
 SafeMove(OutData^,Data.LastBlock,16);
end;

procedure RC6DecryptCBC(var Data:TRC6Data; InData,OutData:Pointer);
var
 TempBlock : packed array[0..15] of Byte;
begin
 SafeMove(InData^,TempBlock,16);
 RC6DecryptECB(Data,InData,OutData);
 XorBlock(OutData,@Data.LastBlock,OutData,16);
 SafeMove(TempBlock,Data.LastBlock,16);
end;

procedure RC6EncryptCFB(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],15);
  Data.LastBlock[15]:=PByteArray(OutData)[i];
 end;
end;

procedure RC6DecryptCFB(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
var
 b         : Byte;
 i         : Integer;
 TempBlock : packed array[0..15] of 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];
  SafeMove(Data.LastBlock[1],Data.LastBlock[0],15);
  Data.LastBlock[15]:=b;
 end;
end;

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

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

procedure RC6EncryptOFBC(var Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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 Data:TRC6Data; InData,OutData:Pointer; Len:Integer);
var
 i         : Integer;
 TempBlock : packed 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(var Data:TRC6Data);
begin
 SafeMove(Data.InitBlock,Data.LastBlock,16);
end;

// Temporary!
procedure readln;
begin
end;

procedure Test_Crypt;
const
 isOk : array[Boolean] of PChar = ('ERROR','Ok');
var
 a,b:LongString; i,j,len,n,mem:Integer;
 errors:int64; s,s1,key,fname:longstring;
 kind:TEncryptionKind; Mode:TEncryptionMode;
begin
 errors:=0;
 mem:=GetAllocMemSize;
 writeln;
 writeln('********** test of _crypt unit ***************');
 writeln;
 //
 // MD5
 //
 writeln;
 writeln('MD5 test.');
 writeln('*********');
 writeln('Press enter...'); readln;
 a:='';
 writeln('1. MD5 of ""');
 a:=GetMD5FromText('',df_Hex);
 writeln('   ',a,' ',a='D41D8CD98F00B204E9800998ECF8427E');
 writeln('2. MD5 of "nil"');
 a:=GetMD5FromBuff(nil,0,df_Hex);
 writeln('   ',a,' ',a='D41D8CD98F00B204E9800998ECF8427E');
 fname:='dic_win32.txt';
 a:=GetMd5FromFile(fname,df_Hex);
 writeln('3. MD5 of "'+fname+'"');
 writeln('   ',a,' ',a='3F926D7AF2C40CCC1BD9272218FD2025');
 writeln;
 a:='';
 //
 // Hex encode/decode
 //
 writeln;
 writeln('Hex encode/decode test');
 writeln('**********************');
 writeln('Press enter...'); readln;
 a:='';
 b:='';
 n:=0;
 for i:=0 to 100000 do begin
  len:=1+random(160);
  SetLength(a,len);
  for j:=1 to length(a) do a[j]:=Chr(random(256));
  a:=a;
  b:=hex_encode(a);
  if a=hex_decode(b+StringOfChar(' ',5)) then inc(n) else inc(errors);
  if i mod 10000 = 0 then writeln('b=',b);
 end;
 writeln('Success=',n,',Errors=',errors);
 i:=$46464952;
 b:=hex_encode(dump(i));
 writeln(b,' - ',isOk[b='52494646']);
 a:=hex_decode('52494646');
 writeln(a,' - ',isOk[a='RIFF']);
 a:='';
 b:='';
 //
 // Encrypt/DecryptText
 //
 writeln;
 writeln('Encrypt strings test');
 writeln('********************');
 writeln('Press enter...'); readln;
 key:='0123456789abcdef0123456789ABCDEF';
 writeln('Let assume that:');
 s:='Some user defined string 12345';
 writeln(Format(' Password key: "%s"',[key]));
 writeln(Format(' Origin string: "%s"',[s]));
 //
 // FileSign test
 //
 writeln;
 writeln('FileSign test');
 writeln('*************');
 writeln('Press enter...'); readln;
 fname:='dic_win32.txt';
 a:=GetFileSign(fname);
 writeln('FileSign of "'+fname+'" = ',hex_encode(a));
 s1:=EncryptText(s,GetFileSign(fname));
 errors:=errors+ord(s1=s)+ord(s1='');
 writeln(Format('Encrypted: "%s"',[s1]));
 s1:=DecryptText(s1,GetFileSign(fname));
 errors:=errors+ord(s1<>s);
 writeln(Format('Decrypted: "%s"',[s1]));
 writeln('Errors found:',errors);
 a:='';
 //
 // XorScrambleText test
 //
 writeln;
 writeln('XorScrambleText test');
 writeln('********************');
 writeln('Press enter...'); readln;
 s1:=XorScrambleText(s,key);
 errors:=errors+ord(s1=s)+ord(s1='');
 writeln(Format('Scramble string: "%s"',[s1]));
 s1:=XorScrambleText(s1,key);
 errors:=errors+ord(s1<>s);
 writeln(Format('Unscramble string: "%s"',[s1]));
 writeln('Errors found:',errors);
 //
 // CharReverseText test
 //
 writeln;
 writeln('CharReverseText test');
 writeln('********************');
 writeln('Press enter...'); readln;
 s1:=CharReverseText(s);
 errors:=errors+ord(s1=s)+ord(s1='');
 writeln(Format('CharReverse string: "%s"',[s1]));
 s1:=CharReverseText(s1);
 errors:=errors+ord(s1<>s);
 writeln(Format('CharReverse string: "%s"',[s1]));
 writeln('Errors found:',errors);
 //
 // BitReverseText test
 //
 writeln;
 writeln('BitReverseText test');
 writeln('*******************');
 writeln('Press enter...'); readln;
 s1:=BitReverseText(s);
 errors:=errors+ord(s1=s)+ord(s1='');
 writeln(Format('BitReverse string: "%s"',[s1]));
 s1:=BitReverseText(s1);
 errors:=errors+ord(s1<>s);
 writeln(Format('BitReverse string: "%s"',[s1]));
 writeln('Errors found:',errors);
 //
 // Short encryption test
 //
 writeln;
 writeln('Short encryption test');
 writeln('*********************');
 writeln('Press enter...'); readln;
 for kind:=Low(kind) to High(kind) do
 for mode:=Low(mode) to High(mode) do begin
  s1:=EncryptText(s,key,'',kind,mode);
  writeln(Format('Encript[%d,%d]: "%s"',[ord(kind),ord(mode),s1]));
  errors:=errors+ord(s1=s)+ord(s1='');
  s1:=DecryptText(s1,key,'',kind,mode);
  writeln(Format('Decript[%d,%d]: "%s"',[ord(kind),ord(mode),s1]));
  errors:=errors+ord(s1<>s);
  writeln('Errors found:',errors);
 end;
 writeln('Errors found:',errors);
 writeln;
 //
 // Long encryption test
 //
 writeln;
 writeln('Long encryption test');
 writeln('********************');
 writeln('Press enter...'); readln;
 for i:=1 to 20 do begin
  SetLength(s,1+random(190));
  for j:=1 to Length(s) do s[j]:=char(random(256));
  for kind:=Low(kind) to High(kind) do
  for mode:=Low(mode) to High(mode) do begin
   s1:=EncryptText(s,key,'',kind,mode);
   errors:=errors+ord(s1=s)+ord(s1='');
   s1:=DecryptText(s1,key,'',kind,mode);
   errors:=errors+ord(s1<>s);
  end;
  writeln(i:5,' Check string len=',Length(s):3,' Err=',errors);
 end;
 writeln('Errors found:',errors);
 writeln;
 //
 // Test done.
 //
 mem:=GetAllocMemSize-mem;
 if mem<>0
 then writeln('Memory leak ',mem)
 else writeln('Memory leak not found.');
 writeln('ERRORS:',errors);
 writeln;
 writeln('********** end of test *************************');
 writeln;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_crypt;
begin
end;

procedure Free_crw_crypt;
begin
end;

initialization

 Init_crw_crypt;

finalization

 Free_crw_crypt;

end.

//////////////
// END OF FILE
//////////////

