decoder
alarming
autosfx
aysalia
calllib
checksum-tools
colormanager
cryptochat
currency_converter
delphiutils
distributed
dpcstudio
dpg2
fastphp
fileformats
filter_foundry
forest
gridgame
ht46f47_simulator
indexer_suite
ipe_artfile_utils
javautils
jumper
lightgame
logviewer
musikbox
mystic_house
oidconverter
oidinfo_api
oidinfo_new_design
oidplus
personal-webbase
php_antispam
php_clientchallenge
php_guestbook
php_utils
plumbers
prepend
recyclebinunit
simple_log_event
sokoban
spacemission
stackman
userdetect2
uuid_mac_utils
vgwhois
vnag
webcounter
winbugtracker
yt_downloader
BlueGrey
calm
Elegant
Català-Valencià – Catalan
中文 – Chinese (Simplified)
中文 – Chinese (Traditional)
Česky – Czech
Dansk – Danish
Nederlands – Dutch
English – English
Suomi – Finnish
Français – French
Deutsch – German
עברית – Hebrew
हिंदी – Hindi
Magyar – Hungarian
Bahasa Indonesia – Indonesian
Italiano – Italian
日本語 – Japanese
한국어 – Korean
Македонски – Macedonian
मराठी – Marathi
Norsk – Norwegian
Polski – Polish
Português – Portuguese
Português – Portuguese (Brazil)
Русский – Russian
Slovenčina – Slovak
Slovenščina – Slovenian
Español – Spanish
Svenska – Swedish
Türkçe – Turkish
Українська – Ukrainian
Oëzbekcha – Uzbek
Subversion Repositories
decoder
decoder
/
trunk
/
VCL_DEC
/
DECCipher.pas
– Rev 2
Rev
Blame
|
Last modification
|
View Log
|
RSS feed
{Copyright: Hagen Reddmann HaReddmann at T-Online dot de
Author: Hagen Reddmann
Remarks: freeware, but this Copyright must be included
known Problems: none
Version: 5.1, Part I from Delphi Encryption Compendium ( DEC Part I)
Delphi 5
* THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
* OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
* BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
* OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
unit
DECCipher
;
interface
uses
SysUtils
,
Classes
,
DECUtil
,
DECFmt
;
{$I VER.INC}
type
TCipher_Null
=
class
;
// Null cipher, does'nt encrypt, copying only
TCipher_Blowfish
=
class
;
TCipher_Twofish
=
class
;
{AES Round 2 Final Candidate}
TCipher_IDEA
=
class
;
TCipher_Cast256
=
class
;
TCipher_Mars
=
class
;
{AES Round 2 Final Candidate}
TCipher_RC4
=
class
;
{Streamcipher in as Block Cipher}
TCipher_RC6
=
class
;
{AES Round 2 Final Candidate}
TCipher_Rijndael
=
class
;
{AES Round 2 Final Candidate}
TCipher_Square
=
class
;
TCipher_SCOP
=
class
;
{Streamcipher on Longword, very fast}
TCipher_Sapphire
=
class
;
{Stream Cipher, eq. Design from german ENIGMA Machine}
TCipher_1DES
=
class
;
{Single DES 8 byte Blocksize, 8 byte Keysize 56 bits relevant}
TCipher_2DES
=
class
;
{Triple DES 8 byte Blocksize, 16 byte Keysize 112 bits relevant}
TCipher_3DES
=
class
;
{Triple DES 8 byte Blocksize, 24 byte Keysize 168 bits relevant}
TCipher_2DDES
=
class
;
{Triple DES 16 byte Blocksize, 16 byte Keysize 112 bits relevant}
TCipher_3DDES
=
class
;
{Triple DES 16 byte Blocksize, 24 byte Keysize 168 bits relevant}
TCipher_3TDES
=
class
;
{Triple DES 24 byte Blocksize, 24 byte Keysize 168 bits relevant}
TCipher_3Way
=
class
;
TCipher_Cast128
=
class
;
TCipher_Gost
=
class
;
TCipher_Misty
=
class
;
TCipher_NewDES
=
class
;
TCipher_Q128
=
class
;
TCipher_RC2
=
class
;
TCipher_RC5
=
class
;
TCipher_SAFER
=
class
;
TCipher_Shark
=
class
;
TCipher_Skipjack
=
class
;
TCipher_TEA
=
class
;
TCipher_TEAN
=
class
;
TCipherContext
=
packed
record
KeySize
:
Integer
;
// maximal key size in bytes
BlockSize
:
Integer
;
// mininmal block size in bytes, eg. 1 = Streamcipher
BufferSize
:
Integer
;
// internal buffersize in bytes
UserSize
:
Integer
;
// internal size in bytes of cipher dependend structures
UserSave
:
Boolean
;
end
;
TCipherState
=
(
csNew
,
csInitialized
,
csEncode
,
csDecode
,
csPadded
,
csDone
)
;
TCipherStates
=
set
of
TCipherState
;
{ TCipher.State represents the internal state of processing
csNew = cipher isn't initialized, .Init() must be called before en/decode
csInitialized = cipher is initialized by .Init(), eg. Keysetup was processed
csEncode = Encodeing was started, and more chunks can be encoded, but not decoded
csDecode = Decodeing was started, and more chunks can be decoded, but not encoded
csPadded = trough En/Decodeing the messagechunks are padded, no more chunks can
be processed, the cipher is blocked.
csDone = Processing is finished and Cipher.Done was called. Now new En/Decoding
can be started without calling .Init() before. csDone is basicaly
identical to csInitialized, except Cipher.Buffer holds the encrypted
last state of Cipher.Feedback, thus Cipher.Buffer can be used as C-MAC.}
TCipherMode
=
(
cmCTSx
,
cmCBCx
,
cmCFB8
,
cmCFBx
,
cmOFB8
,
cmOFBx
,
cmCFS8
,
cmCFSx
,
cmECBx
)
;
{ cmCTSx = double CBC, with CFS8 padding of truncated final block
cmCBCx = Cipher Block Chainung, with CFB8 padding of truncated final block
cmCFB8 = 8bit Cipher Feedback mode
cmCFBx = CFB on Blocksize of Cipher
cmOFB8 = 8bit Output Feedback mode
cmOFBx = OFB on Blocksize bytes
cmCFS8 = 8Bit CFS, double CFB
cmCFSx = CFS on Blocksize bytes
cmECBx = Electronic Code Book
Modes cmCBCx, cmCTSx, cmCFBx, cmOFBx, cmCFSx, cmECBx working on Blocks of
Cipher.BufferSize bytes, on Blockcipher that's equal to Cipher.BlockSize.
Modes cmCFB8, cmOFB8, cmCFS8 work on 8 bit Feedback Shift Registers.
Modes cmCTSx, cmCFSx, cmCFS8 are prohibitary modes developed by me. These modes
works such as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the inputstream
into Feedback register.
Mode cmECBx need message padding to a multiple of Cipher.BlockSize and should
be only used in 1byte Streamciphers.
Modes cmCTSx, cmCBCx need no external padding, because internal the last truncated
block is padded by cmCFS8 or cmCFB8. After padding these Mode can't be used to
process more data. If it needed to process chunks of data then each chunk must
be algined to Cipher.BufferSize bytes.
Modes cmCFBx,cmCFB8,cmOFBx,cmOFB8,cmCFSx,cmCFS8 need no padding.
}
TDECCipherCodeEvent
=
procedure
(
const
Source
;
var
Dest
;
DataSize
:
Integer
)
of
object
;
TDECCipherClass
=
class
of
TDECCipher
;
TDECCipher
=
class
(
TDECObject
)
private
FState
:
TCipherState
;
FMode
:
TCipherMode
;
FData
:
PByteArray
;
FDataSize
:
Integer
;
procedure
SetMode
(
Value
:
TCipherMode
)
;
protected
FBufferSize
:
Integer
;
FBufferIndex
:
Integer
;
FUserSize
:
Integer
;
FBuffer
:
PByteArray
;
FVector
:
PByteArray
;
FFeedback
:
PByteArray
;
FUser
:
Pointer
;
FUserSave
:
Pointer
;
procedure
CheckState
(
States
:
TCipherStates
)
;
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
virtual
;
abstract
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
virtual
;
abstract
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
virtual
;
abstract
;
public
constructor
Create
;
override
;
destructor
Destroy
;
override
;
class
function
Context
:
TCipherContext
;
virtual
;
abstract
;
procedure
Init
(
const
Key
;
Size
:
Integer
;
const
IVector
;
IVectorSize
:
Integer
;
IFiller
:
Byte
=
$FF
)
;
overload
;
procedure
Init
(
const
Key
:
Binary
;
const
IVector
:
Binary
=
''
;
IFiller
:
Byte
=
$FF
)
;
overload
;
procedure
Done
;
procedure
Protect
;
virtual
;
procedure
Encode
(
const
Source
;
var
Dest
;
DataSize
:
Integer
)
;
procedure
Decode
(
const
Source
;
var
Dest
;
DataSize
:
Integer
)
;
function
EncodeBinary
(
const
Source
:
Binary
;
Format
:
TDECFormatClass
=
nil
)
:
Binary
;
function
DecodeBinary
(
const
Source
:
Binary
;
Format
:
TDECFormatClass
=
nil
)
:
Binary
;
procedure
EncodeFile
(
const
Source
,
Dest
:
String
;
const
Progress
:
IDECProgress
=
nil
)
;
procedure
DecodeFile
(
const
Source
,
Dest
:
String
;
const
Progress
:
IDECProgress
=
nil
)
;
procedure
EncodeStream
(
const
Source
,
Dest
:
TStream
;
const
DataSize
:
Int64
;
const
Progress
:
IDECProgress
=
nil
)
;
procedure
DecodeStream
(
const
Source
,
Dest
:
TStream
;
const
DataSize
:
Int64
;
const
Progress
:
IDECProgress
=
nil
)
;
function
CalcMAC
(
Format
:
TDECFormatClass
=
nil
)
:
Binary
;
property
InitVectorSize
:
Integer
read
FBufferSize
;
property
InitVector
:
PByteArray
read
FVector
;
// buffer size bytes
property
Feedback
:
PByteArray
read
FFeedback
;
// buffer size bytes
property
State
:
TCipherState
read
FState
;
published
property
Mode
:
TCipherMode
read
FMode
write
SetMode
;
end
;
TCipher_Null
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Blowfish
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Twofish
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_IDEA
=
class
(
TDECCipher
)
{International Data Encryption Algorithm }
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Cast256
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Mars
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_RC4
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_RC6
=
class
(
TDECCipher
)
private
FRounds
:
Integer
;
{16-24, default 20}
procedure
SetRounds
(
Value
:
Integer
)
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
write
SetRounds
;
end
;
TCipher_Rijndael
=
class
(
TDECCipher
)
private
FRounds
:
Integer
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
;
end
;
TCipher_Square
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_SCOP
=
class
(
TDECCipher
)
{Stream Cipher in Blockmode}
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Sapphire
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_1DES
=
class
(
TDECCipher
)
protected
procedure
DoInitKey
(
const
Data
:
array
of
Byte
;
Key
:
PLongArray
;
Reverse
:
Boolean
)
;
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_2DES
=
class
(
TCipher_1DES
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_3DES
=
class
(
TCipher_1DES
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_2DDES
=
class
(
TCipher_2DES
)
protected
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_3DDES
=
class
(
TCipher_3DES
)
protected
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_3TDES
=
class
(
TCipher_3DES
)
protected
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_3Way
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Cast128
=
class
(
TDECCipher
)
{Carlisle Adams and Stafford Tavares }
private
FRounds
:
Integer
;
procedure
SetRounds
(
Value
:
Integer
)
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
write
SetRounds
;
end
;
TCipher_Gost
=
class
(
TDECCipher
)
{russian Cipher}
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Misty
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
{ This algorithm resembles the Data Encryption Standard (DES), but is easier
to implement in software and is supposed to be more secure.
It is not to be confused with another algorithm--known by the
same name--which is simply DES without the initial and final
permutations. The NewDES here is a completely different algorithm.}
TCipher_NewDES
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Q128
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_RC2
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_RC5
=
class
(
TDECCipher
)
private
FRounds
:
Integer
;
{8-16, default 12}
procedure
SetRounds
(
Value
:
Integer
)
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
write
SetRounds
;
end
;
TSAFERVersion
=
(
svSK128
,
svSK64
,
svSK40
,
svK128
,
svK64
,
svK40
)
;
{svK40 SAFER K-40 Keysize is 40bit -> 5 Byte
svK64 SAFER K-64 Keysize is 64bit -> 8 Byte
svK128 SAFER K-128 KeySize is 128bit -> 16 Byte
svSK40 SAFER SK-40 stronger Version from K-40 with better Keyscheduling
svSK64 SAFER SK-64 stronger Version from K-64 with better Keyscheduling
svSK128 SAFER SK-128 stronger Version from K-128 with better Keyscheduling}
TCipher_SAFER
=
class
(
TDECCipher
)
{SAFER = Secure And Fast Encryption Routine}
private
FRounds
:
Integer
;
FVersion
:
TSAFERVersion
;
procedure
SetRounds
(
Value
:
Integer
)
;
procedure
SetVersion
(
Value
:
TSAFERVersion
)
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
write
SetRounds
;
property
Version
:
TSAFERVersion
read
FVersion
write
SetVersion
;
end
;
TCipher_Shark
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_Skipjack
=
class
(
TDECCipher
)
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
end
;
TCipher_TEA
=
class
(
TDECCipher
)
{Tiny Encryption Algorithm}
private
FRounds
:
Integer
;
{16 - 32, default 16 is sufficient, 32 is ample}
procedure
SetRounds
(
Value
:
Integer
)
;
protected
procedure
DoInit
(
const
Key
;
Size
:
Integer
)
;
override
;
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
public
class
function
Context
:
TCipherContext
;
override
;
published
property
Rounds
:
Integer
read
FRounds
write
SetRounds
;
end
;
TCipher_TEAN
=
class
(
TCipher_TEA
)
{Tiny Encryption Algorithm, extended Version}
protected
procedure
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
procedure
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
override
;
end
;
function
ValidCipher
(
CipherClass
:
TDECCipherClass
=
nil
)
:
TDECCipherClass
;
function
CipherByName
(
const
Name
:
String
)
:
TDECCipherClass
;
function
CipherByIdentity
(
Identity
:
LongWord
)
:
TDECCipherClass
;
procedure
SetDefaultCipherClass
(
CipherClass
:
TDECCipherClass
=
nil
)
;
var
StreamBufferSize
:
Integer
=
8192
;
implementation
uses
TypInfo
,
DECData
;
resourcestring
sAlreadyPadded
=
'Cipher have already padded, can not process message'
;
sInvalidState
=
'Cipher is not in valid state for this action'
;
sInvalidMessageLength
=
'Messagelength for %s must be a multiple of %d bytes'
;
sKeyMaterialToLarge
=
'Keymaterial is to large as can be used, security issue'
;
sIVMaterialToLarge
=
'Initvector is to large as can be used, security issue'
;
sInvalidMACMode
=
'Invalid Cipher mode to compute MAC'
;
sCipherNoDefault
=
'No default cipher are registered'
;
var
FDefaultCipherClass
:
TDECCipherClass
=
nil
;
function
ValidCipher
(
CipherClass
:
TDECCipherClass
)
:
TDECCipherClass
;
begin
if
CipherClass <>
nil
then
Result
:
=
CipherClass
else
Result
:
=
FDefaultCipherClass
;
if
Result
=
nil
then
raise
EDECException
.
Create
(
sCipherNoDefault
)
;
end
;
function
CipherByName
(
const
Name
:
String
)
:
TDECCipherClass
;
begin
Result
:
=
TDECCipherClass
(
DECClassByName
(
Name
,
TDECCipher
)
)
;
end
;
function
CipherByIdentity
(
Identity
:
LongWord
)
:
TDECCipherClass
;
begin
Result
:
=
TDECCipherClass
(
DECClassByIdentity
(
Identity
,
TDECCipher
)
)
;
end
;
procedure
SetDefaultCipherClass
(
CipherClass
:
TDECCipherClass
)
;
begin
if
CipherClass <>
nil
then
CipherClass
.
Register
;
FDefaultCipherClass
:
=
CipherClass
;
end
;
procedure
TDECCipher
.
SetMode
(
Value
:
TCipherMode
)
;
begin
if
Value <> FMode
then
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
FMode
:
=
Value
;
end
;
end
;
procedure
TDECCipher
.
CheckState
(
States
:
TCipherStates
)
;
var
S
:
String
;
begin
if
not
(
FState
in
States
)
then
begin
if
FState
=
csPadded
then
S
:
=
sAlreadyPadded
else
S
:
=
sInvalidState
;
raise
EDECException
.
Create
(
S
)
;
end
;
end
;
constructor
TDECCipher
.
Create
;
var
MustUserSaved
:
Boolean
;
begin
inherited
Create
;
with
Context
do
begin
FBufferSize
:
=
BufferSize
;
FUserSize
:
=
UserSize
;
MustUserSaved
:
=
UserSave
;
end
;
FDataSize
:
=
FBufferSize
*
3
+
FUserSize
;
if
MustUserSaved
then
Inc
(
FDataSize
,
FUserSize
)
;
ReallocMem
(
FData
,
FDataSize
)
;
FVector
:
=
@
FData
[
0
]
;
FFeedback
:
=
@
FVector
[
FBufferSize
]
;
FBuffer
:
=
@
FFeedback
[
FBufferSize
]
;
FUser
:
=
@
FBuffer
[
FBufferSize
]
;
if
MustUserSaved
then
FUserSave
:
=
@
PByteArray
(
FUser
)
[
FUserSize
]
else
FUserSave
:
=
nil
;
Protect
;
end
;
destructor
TDECCipher
.
Destroy
;
begin
Protect
;
ReallocMem
(
FData
,
0
)
;
FVector
:
=
nil
;
FFeedback
:
=
nil
;
FBuffer
:
=
nil
;
FUser
:
=
nil
;
FUserSave
:
=
nil
;
inherited
Destroy
;
end
;
procedure
TDECCipher
.
Init
(
const
Key
;
Size
:
Integer
;
const
IVector
;
IVectorSize
:
Integer
;
IFiller
:
Byte
)
;
begin
Protect
;
if
Size > Context
.
KeySize
then
raise
EDECException
.
Create
(
sKeyMaterialToLarge
)
;
if
IVectorSize > FBufferSize
then
raise
EDECException
.
Create
(
sIVMaterialToLarge
)
;
DoInit
(
Key
,
Size
)
;
if
FUserSave <>
nil
then
Move
(
FUser
^
,
FUserSave
^
,
FUserSize
)
;
FillChar
(
FVector
^
,
FBufferSize
,
IFiller
)
;
if
IVectorSize
=
0
then
begin
DoEncode
(
FVector
,
FVector
,
FBufferSize
)
;
if
FUserSave <>
nil
then
Move
(
FUserSave
^
,
FUser
^
,
FUserSize
)
;
end
else
Move
(
IVector
,
FVector
^
,
IVectorSize
)
;
Move
(
FVector
^
,
FFeedback
^
,
FBufferSize
)
;
FState
:
=
csInitialized
;
end
;
procedure
TDECCipher
.
Init
(
const
Key
:
Binary
;
const
IVector
:
Binary
;
IFiller
:
Byte
)
;
begin
Init
(
Key
[
1
]
,
Length
(
Key
)
,
IVector
[
1
]
,
Length
(
IVector
)
,
IFiller
)
;
end
;
procedure
TDECCipher
.
Done
;
begin
if
FState <> csDone
then
begin
FState
:
=
csDone
;
FBufferIndex
:
=
0
;
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FVector
^
,
FFeedback
^
,
FBufferSize
)
;
if
FUserSave <>
nil
then
Move
(
FUserSave
^
,
FUser
^
,
FUserSize
)
;
end
;
end
;
procedure
TDECCipher
.
Protect
;
begin
FState
:
=
csNew
;
ProtectBuffer
(
FData
[
0
]
,
FDataSize
)
;
end
;
procedure
InvalidMessageLength
(
Cipher
:
TDECCipher
)
;
begin
with
Cipher
do
raise
EDECException
.
CreateFmt
(
sInvalidMessageLength
,
[
TypInfo
.
GetEnumName
(
TypeInfo
(
TCipherMode
)
,
Integer
(
FMode
)
)
,
Context
.
BlockSize
]
)
;
end
;
procedure
TDECCipher
.
Encode
(
const
Source
;
var
Dest
;
DataSize
:
Integer
)
;
procedure
EncodeECBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
begin
if
Context
.
BlockSize
=
1
then
begin
DoEncode
(
S
,
D
,
Size
)
;
FState
:
=
csEncode
;
end
else
begin
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I <
=
Size
do
begin
DoEncode
(
@
S
[
I
]
,
@
D
[
I
]
,
FBufferSize
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
if
Size
mod
Context
.
BlockSize
=
0
then
begin
DoEncode
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csEncode
;
end
else
begin
FState
:
=
csPadded
;
InvalidMessageLength
(
Self
)
;
end
;
end
;
end
;
procedure
EncodeCFB8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFB-8
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
FFeedback
[
FBufferSize
-
1
]
:
=
D
[
I
]
;
Inc
(
I
)
;
end
;
FState
:
=
csEncode
;
end
;
procedure
EncodeOFB8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
FFeedback
[
FBufferSize
-
1
]
:
=
FBuffer
[
0
]
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
Inc
(
I
)
;
end
;
FState
:
=
csEncode
;
end
;
procedure
EncodeCFS8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFS-8, CTS as CFB
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
FFeedback
[
FBufferSize
-
1
]
:
=
FFeedback
[
FBufferSize
-
1
]
xor
D
[
I
]
;
Inc
(
I
)
;
end
;
FState
:
=
csEncode
;
end
;
procedure
EncodeCFBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFB-BlockSize
var
I
:
Integer
;
F
:
PByteArray
;
begin
FState
:
=
csEncode
;
if
FBufferIndex >
0
then
begin
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
XORBuffers
(
S
[
0
]
,
FBuffer
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
Move
(
D
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
Dec
(
Size
,
FBufferSize
)
;
F
:
=
FFeedback
;
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
F
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
F
:
=
@
D
[
I
]
;
Inc
(
I
,
FBufferSize
)
;
end
;
if
F <> FFeedback
then
Move
(
F
^
,
FFeedback
^
,
FBufferSize
)
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
Size
,
D
[
I
]
)
;
Move
(
D
[
I
]
,
FFeedback
[
0
]
,
Size
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
EncodeOFBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// OFB-BlockSize
var
I
:
Integer
;
begin
FState
:
=
csEncode
;
if
FBufferIndex >
0
then
begin
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
XORBuffers
(
S
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FFeedback
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DoEncode
(
FFeedback
,
FFeedback
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
Size
,
D
[
I
]
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
EncodeCFSx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFS-BlockSize
var
I
:
Integer
;
begin
FState
:
=
csEncode
;
if
FBufferIndex >
0
then
begin
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
XORBuffers
(
S
[
0
]
,
FBuffer
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
XORBuffers
(
D
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
,
FFeedback
[
FBufferIndex
]
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
XORBuffers
(
D
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
FFeedback
[
0
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
Size
,
D
[
I
]
)
;
XORBuffers
(
D
[
I
]
,
FFeedback
[
0
]
,
Size
,
FFeedback
[
0
]
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
EncodeCBCx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
F
:
PByteArray
;
I
:
Integer
;
begin
Dec
(
Size
,
FBufferSize
)
;
F
:
=
FFeedback
;
I
:
=
0
;
while
I <
=
Size
do
begin
XORBuffers
(
S
[
I
]
,
F
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
F
:
=
@
D
[
I
]
;
DoEncode
(
F
,
F
,
FBufferSize
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
if
F <> FFeedback
then
Move
(
F
[
0
]
,
FFeedback
[
0
]
,
FBufferSize
)
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
// padding
EncodeCFB8
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csPadded
;
end
else
FState
:
=
csEncode
;
end
;
procedure
EncodeCTSx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
begin
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I <
=
Size
do
begin
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
DoEncode
(
@
D
[
I
]
,
@
D
[
I
]
,
FBufferSize
)
;
XORBuffers
(
D
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
FFeedback
[
0
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
// padding
EncodeCFS8
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csPadded
;
end
else
FState
:
=
csEncode
;
end
;
begin
CheckState
(
[
csInitialized
,
csEncode
,
csDone
]
)
;
case
FMode
of
cmECBx
:
EncodeECBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCBCx
:
EncodeCBCx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCTSx
:
EncodeCTSx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFB8
:
EncodeCFB8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFBx
:
EncodeCFBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmOFB8
:
EncodeOFB8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmOFBx
:
EncodeOFBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFS8
:
EncodeCFS8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFSx
:
EncodeCFSx
(
@
Source
,
@
Dest
,
DataSize
)
;
end
;
end
;
procedure
TDECCipher
.
Decode
(
const
Source
;
var
Dest
;
DataSize
:
Integer
)
;
procedure
DecodeECBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
begin
if
Context
.
BlockSize
=
1
then
begin
DoDecode
(
S
,
D
,
Size
)
;
FState
:
=
csDecode
;
end
else
begin
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I <
=
Size
do
begin
DoDecode
(
@
S
[
I
]
,
@
D
[
I
]
,
FBufferSize
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
if
Size
mod
Context
.
BlockSize
=
0
then
begin
DoDecode
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csDecode
;
end
else
begin
FState
:
=
csPadded
;
InvalidMessageLength
(
Self
)
;
end
;
end
;
end
;
procedure
DecodeCFB8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFB-8
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
FFeedback
[
FBufferSize
-
1
]
:
=
S
[
I
]
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
Inc
(
I
)
;
end
;
FState
:
=
csDecode
;
end
;
procedure
DecodeOFB8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// same as EncodeOFB
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
FFeedback
[
FBufferSize
-
1
]
:
=
FBuffer
[
0
]
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
Inc
(
I
)
;
end
;
FState
:
=
csDecode
;
end
;
procedure
DecodeCFS8
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
begin
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
FFeedback
[
1
]
,
FFeedback
[
0
]
,
FBufferSize
-
1
)
;
FFeedback
[
FBufferSize
-
1
]
:
=
FFeedback
[
FBufferSize
-
1
]
xor
S
[
I
]
;
D
[
I
]
:
=
S
[
I
]
xor
FBuffer
[
0
]
;
Inc
(
I
)
;
end
;
FState
:
=
csDecode
;
end
;
procedure
DecodeCFBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFB-BlockSize
var
I
:
Integer
;
F
:
PByteArray
;
begin
FState
:
=
csDecode
;
if
FBufferIndex >
0
then
begin
// remain bytes of last decode
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
Move
(
S
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
)
;
XORBuffers
(
S
[
0
]
,
FBuffer
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
// process chunks of FBufferSize bytes
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
if
S <> D
then
begin
F
:
=
FFeedback
;
while
I < Size
do
begin
DoEncode
(
F
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
F
:
=
@
S
[
I
]
;
Inc
(
I
,
FBufferSize
)
;
end
;
if
F <> FFeedback
then
Move
(
F
^
,
FFeedback
^
,
FBufferSize
)
;
end
else
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
S
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
// remain bytes
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
Move
(
S
[
I
]
,
FFeedback
[
0
]
,
Size
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
Size
,
D
[
I
]
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
DecodeOFBx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// OFB-BlockSize, same as EncodeOFBx
var
I
:
Integer
;
begin
FState
:
=
csDecode
;
if
FBufferIndex >
0
then
begin
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
XORBuffers
(
S
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FFeedback
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DoEncode
(
FFeedback
,
FFeedback
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
Size
,
D
[
I
]
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
DecodeCFSx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
// CFS-BlockSize
var
I
:
Integer
;
begin
FState
:
=
csDecode
;
if
FBufferIndex >
0
then
begin
// remain bytes of last decode
I
:
=
FBufferSize
-
FBufferIndex
;
if
I > Size
then
I
:
=
Size
;
XORBuffers
(
S
[
0
]
,
FFeedback
[
FBufferIndex
]
,
I
,
FFeedback
[
FBufferIndex
]
)
;
XORBuffers
(
S
[
0
]
,
FBuffer
[
FBufferIndex
]
,
I
,
D
[
0
]
)
;
Inc
(
FBufferIndex
,
I
)
;
if
FBufferIndex < FBufferSize
then
Exit
;
Dec
(
Size
,
I
)
;
S
:
=
@
S
[
I
]
;
D
:
=
@
D
[
I
]
;
FBufferIndex
:
=
0
end
;
// process chunks of FBufferSize bytes
Dec
(
Size
,
FBufferSize
)
;
I
:
=
0
;
while
I < Size
do
begin
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
FBufferSize
,
FFeedback
[
0
]
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
Inc
(
I
,
FBufferSize
)
;
end
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
// remain bytes
DoEncode
(
FFeedback
,
FBuffer
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
FFeedback
[
0
]
,
Size
,
FFeedback
[
0
]
)
;
XORBuffers
(
S
[
I
]
,
FBuffer
[
0
]
,
Size
,
D
[
I
]
)
;
FBufferIndex
:
=
Size
;
end
;
end
;
procedure
DecodeCBCx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
F
,
B
,
T
:
PByteArray
;
begin
Dec
(
Size
,
FBufferSize
)
;
F
:
=
FFeedback
;
I
:
=
0
;
if
S
=
D
then
begin
B
:
=
FBuffer
;
while
I <
=
Size
do
begin
Move
(
S
[
I
]
,
B
[
0
]
,
FBufferSize
)
;
DoDecode
(
@
S
[
I
]
,
@
S
[
I
]
,
FBufferSize
)
;
XORBuffers
(
S
[
I
]
,
F
[
0
]
,
FBufferSize
,
S
[
I
]
)
;
T
:
=
F
;
F
:
=
B
;
B
:
=
T
;
Inc
(
I
,
FBufferSize
)
;
end
;
end
else
while
I <
=
Size
do
begin
DoDecode
(
@
S
[
I
]
,
@
D
[
I
]
,
FBufferSize
)
;
XORBuffers
(
F
[
0
]
,
D
[
I
]
,
FBufferSize
,
D
[
I
]
)
;
F
:
=
@
S
[
I
]
;
Inc
(
I
,
FBufferSize
)
;
end
;
if
F <> FFeedback
then
Move
(
F
[
0
]
,
FFeedback
[
0
]
,
FBufferSize
)
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DecodeCFB8
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csPadded
;
end
else
FState
:
=
csDecode
;
end
;
procedure
DecodeCTSx
(
S
,
D
:
PByteArray
;
Size
:
Integer
)
;
var
I
:
Integer
;
F
,
B
,
T
:
PByteArray
;
begin
Dec
(
Size
,
FBufferSize
)
;
F
:
=
FFeedback
;
B
:
=
FBuffer
;
I
:
=
0
;
while
I <
=
Size
do
begin
XORBuffers
(
S
[
I
]
,
F
[
0
]
,
FBufferSize
,
B
[
0
]
)
;
DoDecode
(
@
S
[
I
]
,
@
D
[
I
]
,
FBufferSize
)
;
XORBuffers
(
D
[
I
]
,
F
[
0
]
,
FBufferSize
,
D
[
I
]
)
;
T
:
=
B
;
B
:
=
F
;
F
:
=
T
;
Inc
(
I
,
FBufferSize
)
;
end
;
if
F <> FFeedback
then
Move
(
F
[
0
]
,
FFeedback
[
0
]
,
FBufferSize
)
;
Dec
(
Size
,
I
-
FBufferSize
)
;
if
Size >
0
then
begin
DecodeCFS8
(
@
S
[
I
]
,
@
D
[
I
]
,
Size
)
;
FState
:
=
csPadded
;
end
else
FState
:
=
csDecode
;
end
;
begin
CheckState
(
[
csInitialized
,
csDecode
,
csDone
]
)
;
case
FMode
of
cmECBx
:
DecodeECBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCBCx
:
DecodeCBCx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCTSx
:
DecodeCTSx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFB8
:
DecodeCFB8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFBx
:
DecodeCFBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmOFB8
:
DecodeOFB8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmOFBx
:
DecodeOFBx
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFS8
:
DecodeCFS8
(
@
Source
,
@
Dest
,
DataSize
)
;
cmCFSx
:
DecodeCFSx
(
@
Source
,
@
Dest
,
DataSize
)
;
end
;
end
;
function
TDECCipher
.
EncodeBinary
(
const
Source
:
Binary
;
Format
:
TDECFormatClass
)
:
Binary
;
begin
SetLength
(
Result
,
Length
(
Source
)
)
;
Encode
(
Source
[
1
]
,
Result
[
1
]
,
Length
(
Source
)
)
;
Result
:
=
ValidFormat
(
Format
)
.
Encode
(
Result
)
;
end
;
function
TDECCipher
.
DecodeBinary
(
const
Source
:
Binary
;
Format
:
TDECFormatClass
)
:
Binary
;
begin
Result
:
=
ValidFormat
(
Format
)
.
Decode
(
Source
)
;
Decode
(
Result
[
1
]
,
Result
[
1
]
,
Length
(
Result
)
)
;
end
;
procedure
DoCodeStream
(
Source
,
Dest
:
TStream
;
Size
:
Int64
;
BlockSize
:
Integer
;
const
Proc
:
TDECCipherCodeEvent
;
const
Progress
:
IDECProgress
)
;
var
Buffer
:
Binary
;
BufferSize
,
Bytes
:
Integer
;
Min
,
Max
,
Pos
:
Int64
;
begin
Pos
:
=
Source
.
Position
;
if
Size <
0
then
Size
:
=
Source
.
Size
-
Pos
;
Min
:
=
Pos
;
Max
:
=
Pos
+
Size
;
if
Size >
0
then
try
if
StreamBufferSize <
=
0
then
StreamBufferSize
:
=
8192
;
BufferSize
:
=
StreamBufferSize
mod
BlockSize
;
if
BufferSize
=
0
then
BufferSize
:
=
StreamBufferSize
else
BufferSize
:
=
StreamBufferSize
+
BlockSize
-
BufferSize
;
if
Size > BufferSize
then
SetLength
(
Buffer
,
BufferSize
)
else
SetLength
(
Buffer
,
Size
)
;
while
Size >
0
do
begin
if
Assigned
(
Progress
)
then
Progress
.
Process
(
Min
,
Max
,
Pos
)
;
Bytes
:
=
BufferSize
;
if
Bytes > Size
then
Bytes
:
=
Size
;
Source
.
ReadBuffer
(
Buffer
[
1
]
,
Bytes
)
;
Proc
(
Buffer
[
1
]
,
Buffer
[
1
]
,
Bytes
)
;
Dest
.
WriteBuffer
(
Buffer
[
1
]
,
Bytes
)
;
Dec
(
Size
,
Bytes
)
;
Inc
(
Pos
,
Bytes
)
;
end
;
finally
ProtectBinary
(
Buffer
)
;
if
Assigned
(
Progress
)
then
Progress
.
Process
(
Min
,
Max
,
Max
)
;
end
;
end
;
procedure
DoCodeFile
(
const
Source
,
Dest
:
String
;
BlockSize
:
Integer
;
const
Proc
:
TDECCipherCodeEvent
;
const
Progress
:
IDECProgress
)
;
var
S
,
D
:
TStream
;
begin
S
:
=
TFileStream
.
Create
(
Source
,
fmOpenRead
or
fmShareDenyNone
)
;
try
D
:
=
TFileStream
.
Create
(
Dest
,
fmCreate
)
;
try
DoCodeStream
(
S
,
D
,
S
.
Size
,
BlockSize
,
Proc
,
Progress
)
;
finally
D
.
Free
;
end
;
finally
S
.
Free
;
end
;
end
;
procedure
TDECCipher
.
EncodeFile
(
const
Source
,
Dest
:
String
;
const
Progress
:
IDECProgress
)
;
begin
DoCodeFile
(
Source
,
Dest
,
Context
.
BlockSize
,
Encode
,
Progress
)
;
end
;
procedure
TDECCipher
.
DecodeFile
(
const
Source
,
Dest
:
String
;
const
Progress
:
IDECProgress
)
;
begin
DoCodeFile
(
Source
,
Dest
,
Context
.
BlockSize
,
Decode
,
Progress
)
;
end
;
procedure
TDECCipher
.
EncodeStream
(
const
Source
,
Dest
:
TStream
;
const
DataSize
:
Int64
;
const
Progress
:
IDECProgress
)
;
begin
DoCodeStream
(
Source
,
Dest
,
DataSize
,
Context
.
BlockSize
,
Encode
,
Progress
)
;
end
;
procedure
TDECCipher
.
DecodeStream
(
const
Source
,
Dest
:
TStream
;
const
DataSize
:
Int64
;
const
Progress
:
IDECProgress
)
;
begin
DoCodeStream
(
Source
,
Dest
,
DataSize
,
Context
.
BlockSize
,
Decode
,
Progress
)
;
end
;
function
TDECCipher
.
CalcMAC
(
Format
:
TDECFormatClass
)
:
Binary
;
begin
Done
;
if
FMode
in
[
cmECBx
]
then
raise
EDECException
.
Create
(
sInvalidMACMode
)
else
Result
:
=
ValidFormat
(
Format
)
.
Encode
(
FBuffer
^
,
FBufferSize
)
;
end
;
// .TCipher_Null
class
function
TCipher_Null
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
0
;
Result
.
BlockSize
:
=
1
;
Result
.
BufferSize
:
=
32
;
Result
.
UserSize
:
=
0
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Null
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
begin
end
;
procedure
TCipher_Null
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
if
Source <> Dest
then
Move
(
Source
^
,
Dest
^
,
Size
)
;
end
;
procedure
TCipher_Null
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
if
Source <> Dest
then
Move
(
Source
^
,
Dest
^
,
Size
)
;
end
;
// .TCipher_Blowfish
{$IFDEF UseASM}
{$IFDEF 486GE}
{$DEFINE Blowfish_asm}
{$ENDIF}
{$ENDIF}
type
PBlowfish
=
^
TBlowfish
;
TBlowfish
=
array
[
0
..
3
,
0
..
255
]
of
LongWord
;
class
function
TCipher_Blowfish
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
56
;
Result
.
BufferSize
:
=
8
;
Result
.
BlockSize
:
=
8
;
Result
.
UserSize
:
=
SizeOf
(
Blowfish_Data
)
+
SizeOf
(
Blowfish_Key
)
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Blowfish
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
I
,
J
:
Integer
;
B
:
array
[
0
..
1
]
of
LongWord
;
K
:
PByteArray
;
P
:
PLongArray
;
S
:
PBlowfish
;
begin
K
:
=
@
Key
;
S
:
=
FUser
;
P
:
=
Pointer
(
PChar
(
FUser
)
+
SizeOf
(
Blowfish_Data
)
)
;
Move
(
Blowfish_Data
,
S
^
,
SizeOf
(
Blowfish_Data
)
)
;
Move
(
Blowfish_Key
,
P
^
,
Sizeof
(
Blowfish_Key
)
)
;
J
:
=
0
;
if
Size >
0
then
for
I
:
=
0
to
17
do
begin
P
[
I
]
:
=
P
[
I
]
xor
(
K
[
(
J
+
0
)
mod
Size
]
shl
24
+
K
[
(
J
+
1
)
mod
Size
]
shl
16
+
K
[
(
J
+
2
)
mod
Size
]
shl
8
+
K
[
(
J
+
3
)
mod
Size
]
shl
0
)
;
J
:
=
(
J
+
4
)
mod
Size
;
end
;
FillChar
(
B
,
SizeOf
(
B
)
,
0
)
;
for
I
:
=
0
to
8
do
begin
DoEncode
(
@
B
,
@
B
,
SizeOf
(
B
)
)
;
P
[
I
*
2
+
0
]
:
=
SwapLong
(
B
[
0
]
)
;
P
[
I
*
2
+
1
]
:
=
SwapLong
(
B
[
1
]
)
;
end
;
for
I
:
=
0
to
3
do
for
J
:
=
0
to
127
do
begin
DoEncode
(
@
B
,
@
B
,
SizeOf
(
B
)
)
;
S
[
I
,
J
*
2
+
0
]
:
=
SwapLong
(
B
[
0
]
)
;
S
[
I
,
J
*
2
+
1
]
:
=
SwapLong
(
B
[
1
]
)
;
end
;
FillChar
(
B
,
SizeOf
(
B
)
,
0
)
;
end
;
procedure
TCipher_Blowfish
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF Blowfish_asm}
// specialy for CPU >= 486
// Source = EDX, Dest=ECX, Size on Stack
asm
PUSH EDI
PUSH ESI
PUSH EBX
PUSH EBP
PUSH ECX
MOV ESI
,
[
EAX
]
.
TCipher_Blowfish
.
FUser
MOV EBX
,
[
EDX
+
0
]
// A
MOV EBP
,
[
EDX
+
4
]
// B
BSWAP EBX
// CPU >= 486
BSWAP EBP
XOR
EBX
,
[
ESI
+
4
*
256
*
4
]
XOR
EDI
,
EDI
@@
1
:
MOV EAX
,
EBX
SHR
EBX
,
16
MOVZX ECX
,
BH
AND
EBX
,
0FFh
MOV ECX
,
[
ESI
+
ECX
*
4
+
1024
*
0
]
MOV EBX
,
[
ESI
+
EBX
*
4
+
1024
*
1
]
MOVZX EDX
,
AH
ADD EBX
,
ECX
MOVZX ECX
,
AL
MOV EDX
,
[
ESI
+
EDX
*
4
+
1024
*
2
]
MOV ECX
,
[
ESI
+
ECX
*
4
+
1024
*
3
]
XOR
EBX
,
EDX
XOR
EBP
,
[
ESI
+
4
*
256
*
4
+
4
+
EDI
*
4
]
ADD EBX
,
ECX
INC EDI
XOR
EBX
,
EBP
TEST EDI
,
010h
MOV EBP
,
EAX
JZ
@@
1
POP EAX
XOR
EBP
,
[
ESI
+
4
*
256
*
4
+
17
*
4
]
BSWAP EBX
BSWAP EBP
MOV
[
EAX
+
4
]
,
EBX
MOV
[
EAX
+
0
]
,
EBP
POP EBP
POP EBX
POP ESI
POP EDI
end
;
{$ELSE}
var
I
,
A
,
B
:
LongWord
;
P
:
PLongArray
;
D
:
PBlowfish
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
D
:
=
FUser
;
P
:
=
Pointer
(
PChar
(
FUser
)
+
SizeOf
(
Blowfish_Data
)
)
;
A
:
=
SwapLong
(
PLongArray
(
Source
)
[
0
]
)
xor
P
[
0
]
;
P
:
=
@
P
[
1
]
;
B
:
=
SwapLong
(
PLongArray
(
Source
)
[
1
]
)
;
for
I
:
=
0
to
7
do
begin
B
:
=
B
xor
P
[
0
]
xor
(
D
[
0
,
A
shr
24
]
+
D
[
1
,
A
shr
16
and
$FF
]
xor
D
[
2
,
A
shr
8
and
$FF
]
+
D
[
3
,
A
and
$FF
]
)
;
A
:
=
A
xor
P
[
1
]
xor
(
D
[
0
,
B
shr
24
]
+
D
[
1
,
B
shr
16
and
$FF
]
xor
D
[
2
,
B
shr
8
and
$FF
]
+
D
[
3
,
B
and
$FF
]
)
;
P
:
=
@
P
[
2
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
SwapLong
(
B
xor
P
[
0
]
)
;
PLongArray
(
Dest
)
[
1
]
:
=
SwapLong
(
A
)
;
end
;
{$ENDIF}
procedure
TCipher_Blowfish
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF Blowfish_asm}
asm
PUSH EDI
PUSH ESI
PUSH EBX
PUSH EBP
PUSH ECX
MOV ESI
,
[
EAX
]
.
TCipher_Blowfish
.
FUser
MOV EBX
,
[
EDX
+
0
]
// A
MOV EBP
,
[
EDX
+
4
]
// B
BSWAP EBX
BSWAP EBP
XOR
EBX
,
[
ESI
+
4
*
256
*
4
+
17
*
4
]
MOV EDI
,
16
@@
1
:
MOV EAX
,
EBX
SHR
EBX
,
16
MOVZX ECX
,
BH
MOVZX EDX
,
BL
MOV EBX
,
[
ESI
+
ECX
*
4
+
1024
*
0
]
MOV EDX
,
[
ESI
+
EDX
*
4
+
1024
*
1
]
MOVZX ECX
,
AH
LEA EBX
,
[
EBX
+
EDX
]
MOVZX EDX
,
AL
MOV ECX
,
[
ESI
+
ECX
*
4
+
1024
*
2
]
MOV EDX
,
[
ESI
+
EDX
*
4
+
1024
*
3
]
XOR
EBX
,
ECX
XOR
EBP
,
[
ESI
+
4
*
256
*
4
+
EDI
*
4
]
LEA EBX
,
[
EBX
+
EDX
]
XOR
EBX
,
EBP
DEC EDI
MOV EBP
,
EAX
JNZ
@@
1
POP EAX
XOR
EBP
,
[
ESI
+
4
*
256
*
4
]
BSWAP EBX
BSWAP EBP
MOV
[
EAX
+
0
]
,
EBP
MOV
[
EAX
+
4
]
,
EBX
POP EBP
POP EBX
POP ESI
POP EDI
end
;
{$ELSE}
var
I
,
A
,
B
:
LongWord
;
P
:
PLongArray
;
D
:
PBlowfish
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
D
:
=
FUser
;
P
:
=
Pointer
(
PChar
(
FUser
)
+
SizeOf
(
Blowfish_Data
)
+
SizeOf
(
Blowfish_Key
)
-
SizeOf
(
Integer
)
)
;
A
:
=
SwapLong
(
PLongArray
(
Source
)
[
0
]
)
xor
P
[
0
]
;
B
:
=
SwapLong
(
PLongArray
(
Source
)
[
1
]
)
;
for
I
:
=
0
to
7
do
begin
Dec
(
PLongWord
(
P
)
,
2
)
;
B
:
=
B
xor
P
[
1
]
xor
(
D
[
0
,
A
shr
24
]
+
D
[
1
,
A
shr
16
and
$FF
]
xor
D
[
2
,
A
shr
8
and
$FF
]
+
D
[
3
,
A
and
$FF
]
)
;
A
:
=
A
xor
P
[
0
]
xor
(
D
[
0
,
B
shr
24
]
+
D
[
1
,
B
shr
16
and
$FF
]
xor
D
[
2
,
B
shr
8
and
$FF
]
+
D
[
3
,
B
and
$FF
]
)
;
end
;
Dec
(
PLongWord
(
P
)
)
;
PLongArray
(
Dest
)
[
0
]
:
=
SwapLong
(
B
xor
P
[
0
]
)
;
PLongArray
(
Dest
)
[
1
]
:
=
SwapLong
(
A
)
;
end
;
{$ENDIF}
// .TCipher_Twofish
type
PTwofishBox
=
^
TTwofishBox
;
TTwofishBox
=
array
[
0
..
3
,
0
..
255
]
of
Longword
;
TLongRec
=
record
case
Integer
of
0
:
(
L
:
Longword
)
;
1
:
(
A
,
B
,
C
,
D
:
Byte
)
;
end
;
class
function
TCipher_Twofish
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
32
;
Result
.
BufferSize
:
=
16
;
Result
.
BlockSize
:
=
16
;
Result
.
UserSize
:
=
4256
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Twofish
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
BoxKey
:
array
[
0
..
3
]
of
TLongRec
;
SubKey
:
PLongArray
;
Box
:
PTwofishBox
;
procedure
SetupKey
;
function
Encode
(
K0
,
K1
:
Integer
)
:
Integer
;
var
R
,
I
,
J
,
G2
,
G3
:
Integer
;
B
:
byte
;
begin
R
:
=
0
;
for
I
:
=
0
to
1
do
begin
if
I <>
0
then
R
:
=
R
xor
K0
else
R
:
=
R
xor
K1
;
for
J
:
=
0
to
3
do
begin
B
:
=
R
shr
24
;
if
B
and
$80
<>
0
then
G2
:
=
(
B
shl
1
xor
$014D
)
and
$FF
else
G2
:
=
B
shl
1
and
$FF
;
if
B
and
1
<>
0
then
G3
:
=
(
B
shr
1
and
$7F
)
xor
$014D
shr
1
xor
G2
else
G3
:
=
(
B
shr
1
and
$7F
)
xor
G2
;
R
:
=
R
shl
8
xor
G3
shl
24
xor
G2
shl
16
xor
G3
shl
8
xor
B
;
end
;
end
;
Result
:
=
R
;
end
;
function
F32
(
X
:
Integer
;
K
:
array
of
Integer
)
:
Integer
;
var
A
,
B
,
C
,
D
:
LongWord
;
begin
A
:
=
X
and
$FF
;
B
:
=
X
shr
8
and
$FF
;
C
:
=
X
shr
16
and
$FF
;
D
:
=
X
shr
24
;
if
Size
=
32
then
begin
A
:
=
Twofish_8x8
[
1
,
A
]
xor
K
[
3
]
and
$FF
;
B
:
=
Twofish_8x8
[
0
,
B
]
xor
K
[
3
]
shr
8
and
$FF
;
C
:
=
Twofish_8x8
[
0
,
C
]
xor
K
[
3
]
shr
16
and
$FF
;
D
:
=
Twofish_8x8
[
1
,
D
]
xor
K
[
3
]
shr
24
;
end
;
if
Size >
=
24
then
begin
A
:
=
Twofish_8x8
[
1
,
A
]
xor
K
[
2
]
and
$FF
;
B
:
=
Twofish_8x8
[
1
,
B
]
xor
K
[
2
]
shr
8
and
$FF
;
C
:
=
Twofish_8x8
[
0
,
C
]
xor
K
[
2
]
shr
16
and
$FF
;
D
:
=
Twofish_8x8
[
0
,
D
]
xor
K
[
2
]
shr
24
;
end
;
A
:
=
Twofish_8x8
[
0
,
A
]
xor
K
[
1
]
and
$FF
;
B
:
=
Twofish_8x8
[
1
,
B
]
xor
K
[
1
]
shr
8
and
$FF
;
C
:
=
Twofish_8x8
[
0
,
C
]
xor
K
[
1
]
shr
16
and
$FF
;
D
:
=
Twofish_8x8
[
1
,
D
]
xor
K
[
1
]
shr
24
;
A
:
=
Twofish_8x8
[
0
,
A
]
xor
K
[
0
]
and
$FF
;
B
:
=
Twofish_8x8
[
0
,
B
]
xor
K
[
0
]
shr
8
and
$FF
;
C
:
=
Twofish_8x8
[
1
,
C
]
xor
K
[
0
]
shr
16
and
$FF
;
D
:
=
Twofish_8x8
[
1
,
D
]
xor
K
[
0
]
shr
24
;
Result
:
=
Twofish_Data
[
0
,
A
]
xor
Twofish_Data
[
1
,
B
]
xor
Twofish_Data
[
2
,
C
]
xor
Twofish_Data
[
3
,
D
]
;
end
;
var
I
,
J
,
A
,
B
:
Integer
;
E
,
O
:
array
[
0
..
3
]
of
Integer
;
K
:
array
[
0
..
7
]
of
Integer
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
if
Size <
=
16
then
Size
:
=
16
else
if
Size <
=
24
then
Size
:
=
24
else
Size
:
=
32
;
J
:
=
Size
shr
3
-
1
;
for
I
:
=
0
to
J
do
begin
E
[
I
]
:
=
K
[
I
shl
1
]
;
O
[
I
]
:
=
K
[
I
shl
1
+
1
]
;
BoxKey
[
J
]
.
L
:
=
Encode
(
E
[
I
]
,
O
[
I
]
)
;
Dec
(
J
)
;
end
;
J
:
=
0
;
for
I
:
=
0
to
19
do
begin
A
:
=
F32
(
J
,
E
)
;
B
:
=
F32
(
J
+
$01010101
,
O
)
;
B
:
=
B
shl
8
or
B
shr
24
;
SubKey
[
I
shl
1
]
:
=
A
+
B
;
B
:
=
A
+
B
shl
1
;
// here buggy instead shr 1 it's correct shl 1
SubKey
[
I
shl
1
+
1
]
:
=
B
shl
9
or
B
shr
23
;
Inc
(
J
,
$02020202
)
;
end
;
end
;
procedure
DoXOR
(
D
,
S
:
PLongArray
;
Value
:
LongWord
)
;
var
I
:
LongWord
;
begin
Value
:
=
(
Value
and
$FF
)
*
$01010101
;
for
I
:
=
0
to
63
do
D
[
I
]
:
=
S
[
I
]
xor
Value
;
end
;
procedure
SetupBox128
;
var
L
:
array
[
0
..
255
]
of
Byte
;
A
,
I
:
Integer
;
begin
DoXOR
(
@
L
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
1
]
.
L
)
;
A
:
=
BoxKey
[
0
]
.
A
;
for
I
:
=
0
to
255
do
Box
[
0
,
I
]
:
=
Twofish_Data
[
0
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
1
]
.
L
shr
8
)
;
A
:
=
BoxKey
[
0
]
.
B
;
for
I
:
=
0
to
255
do
Box
[
1
,
I
]
:
=
Twofish_Data
[
1
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
1
]
.
L
shr
16
)
;
A
:
=
BoxKey
[
0
]
.
C
;
for
I
:
=
0
to
255
do
Box
[
2
,
I
]
:
=
Twofish_Data
[
2
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
1
]
.
L
shr
24
)
;
A
:
=
BoxKey
[
0
]
.
D
;
for
I
:
=
0
to
255
do
Box
[
3
,
I
]
:
=
Twofish_Data
[
3
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
A
]
;
end
;
procedure
SetupBox192
;
var
L
:
array
[
0
..
255
]
of
Byte
;
A
,
B
,
I
:
Integer
;
begin
DoXOR
(
@
L
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
2
]
.
L
)
;
A
:
=
BoxKey
[
0
]
.
A
;
B
:
=
BoxKey
[
1
]
.
A
;
for
I
:
=
0
to
255
do
Box
[
0
,
I
]
:
=
Twofish_Data
[
0
,
Twofish_8x8
[
0
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
2
]
.
L
shr
8
)
;
A
:
=
BoxKey
[
0
]
.
B
;
B
:
=
BoxKey
[
1
]
.
B
;
for
I
:
=
0
to
255
do
Box
[
1
,
I
]
:
=
Twofish_Data
[
1
,
Twofish_8x8
[
0
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
2
]
.
L
shr
16
)
;
A
:
=
BoxKey
[
0
]
.
C
;
B
:
=
BoxKey
[
1
]
.
C
;
for
I
:
=
0
to
255
do
Box
[
2
,
I
]
:
=
Twofish_Data
[
2
,
Twofish_8x8
[
1
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
L
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
2
]
.
L
shr
24
)
;
A
:
=
BoxKey
[
0
]
.
D
;
B
:
=
BoxKey
[
1
]
.
D
;
for
I
:
=
0
to
255
do
Box
[
3
,
I
]
:
=
Twofish_Data
[
3
,
Twofish_8x8
[
1
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
B
]
xor
A
]
;
end
;
procedure
SetupBox256
;
var
L
:
array
[
0
..
255
]
of
Byte
;
K
:
array
[
0
..
255
]
of
Byte
;
A
,
B
,
I
:
Integer
;
begin
DoXOR
(
@
K
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
3
]
.
L
)
;
for
I
:
=
0
to
255
do
L
[
I
]
:
=
Twofish_8x8
[
1
,
K
[
I
]
]
;
DoXOR
(
@
L
,
@
L
,
BoxKey
[
2
]
.
L
)
;
A
:
=
BoxKey
[
0
]
.
A
;
B
:
=
BoxKey
[
1
]
.
A
;
for
I
:
=
0
to
255
do
Box
[
0
,
I
]
:
=
Twofish_Data
[
0
,
Twofish_8x8
[
0
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
K
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
3
]
.
L
shr
8
)
;
for
I
:
=
0
to
255
do
L
[
I
]
:
=
Twofish_8x8
[
1
,
K
[
I
]
]
;
DoXOR
(
@
L
,
@
L
,
BoxKey
[
2
]
.
L
shr
8
)
;
A
:
=
BoxKey
[
0
]
.
B
;
B
:
=
BoxKey
[
1
]
.
B
;
for
I
:
=
0
to
255
do
Box
[
1
,
I
]
:
=
Twofish_Data
[
1
,
Twofish_8x8
[
0
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
K
,
@
Twofish_8x8
[
0
]
,
BoxKey
[
3
]
.
L
shr
16
)
;
for
I
:
=
0
to
255
do
L
[
I
]
:
=
Twofish_8x8
[
0
,
K
[
I
]
]
;
DoXOR
(
@
L
,
@
L
,
BoxKey
[
2
]
.
L
shr
16
)
;
A
:
=
BoxKey
[
0
]
.
C
;
B
:
=
BoxKey
[
1
]
.
C
;
for
I
:
=
0
to
255
do
Box
[
2
,
I
]
:
=
Twofish_Data
[
2
,
Twofish_8x8
[
1
,
Twofish_8x8
[
0
,
L
[
I
]
]
xor
B
]
xor
A
]
;
DoXOR
(
@
K
,
@
Twofish_8x8
[
1
]
,
BoxKey
[
3
]
.
L
shr
24
)
;
for
I
:
=
0
to
255
do
L
[
I
]
:
=
Twofish_8x8
[
0
,
K
[
I
]
]
;
DoXOR
(
@
L
,
@
L
,
BoxKey
[
2
]
.
L
shr
24
)
;
A
:
=
BoxKey
[
0
]
.
D
;
B
:
=
BoxKey
[
1
]
.
D
;
for
I
:
=
0
to
255
do
Box
[
3
,
I
]
:
=
Twofish_Data
[
3
,
Twofish_8x8
[
1
,
Twofish_8x8
[
1
,
L
[
I
]
]
xor
B
]
xor
A
]
;
end
;
begin
SubKey
:
=
FUser
;
Box
:
=
@
SubKey
[
40
]
;
SetupKey
;
if
Size
=
16
then
SetupBox128
else
if
Size
=
24
then
SetupBox192
else
SetupBox256
;
end
;
procedure
TCipher_Twofish
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
S
:
PLongArray
;
Box
:
PTwofishBox
;
I
,
X
,
Y
:
LongWord
;
A
,
B
,
C
,
D
:
TLongRec
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
S
:
=
FUser
;
A
.
L
:
=
PLongArray
(
Source
)
[
0
]
xor
S
[
0
]
;
B
.
L
:
=
PLongArray
(
Source
)
[
1
]
xor
S
[
1
]
;
C
.
L
:
=
PLongArray
(
Source
)
[
2
]
xor
S
[
2
]
;
D
.
L
:
=
PLongArray
(
Source
)
[
3
]
xor
S
[
3
]
;
Box
:
=
@
S
[
40
]
;
S
:
=
@
S
[
8
]
;
for
I
:
=
0
to
7
do
begin
X
:
=
Box
[
0
,
A
.
A
]
xor
Box
[
1
,
A
.
B
]
xor
Box
[
2
,
A
.
C
]
xor
Box
[
3
,
A
.
D
]
;
Y
:
=
Box
[
1
,
B
.
A
]
xor
Box
[
2
,
B
.
B
]
xor
Box
[
3
,
B
.
C
]
xor
Box
[
0
,
B
.
D
]
;
D
.
L
:
=
D
.
L
shl
1
or
D
.
L
shr
31
;
C
.
L
:
=
C
.
L
xor
(
X
+
Y
+
S
[
0
]
)
;
D
.
L
:
=
D
.
L
xor
(
X
+
Y
shl
1
+
S
[
1
]
)
;
C
.
L
:
=
C
.
L
shr
1
or
C
.
L
shl
31
;
X
:
=
Box
[
0
,
C
.
A
]
xor
Box
[
1
,
C
.
B
]
xor
Box
[
2
,
C
.
C
]
xor
Box
[
3
,
C
.
D
]
;
Y
:
=
Box
[
1
,
D
.
A
]
xor
Box
[
2
,
D
.
B
]
xor
Box
[
3
,
D
.
C
]
xor
Box
[
0
,
D
.
D
]
;
B
.
L
:
=
B
.
L
shl
1
or
B
.
L
shr
31
;
A
.
L
:
=
A
.
L
xor
(
X
+
Y
+
S
[
2
]
)
;
B
.
L
:
=
B
.
L
xor
(
X
+
Y
shl
1
+
S
[
3
]
)
;
A
.
L
:
=
A
.
L
shr
1
or
A
.
L
shl
31
;
S
:
=
@
S
[
4
]
;
end
;
S
:
=
FUser
;
PLongArray
(
Dest
)
[
0
]
:
=
C
.
L
xor
S
[
4
]
;
PLongArray
(
Dest
)
[
1
]
:
=
D
.
L
xor
S
[
5
]
;
PLongArray
(
Dest
)
[
2
]
:
=
A
.
L
xor
S
[
6
]
;
PLongArray
(
Dest
)
[
3
]
:
=
B
.
L
xor
S
[
7
]
;
end
;
procedure
TCipher_Twofish
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
S
:
PLongArray
;
Box
:
PTwofishBox
;
I
,
X
,
Y
:
LongWord
;
A
,
B
,
C
,
D
:
TLongRec
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
S
:
=
FUser
;
Box
:
=
@
S
[
40
]
;
C
.
L
:
=
PLongArray
(
Source
)
[
0
]
xor
S
[
4
]
;
D
.
L
:
=
PLongArray
(
Source
)
[
1
]
xor
S
[
5
]
;
A
.
L
:
=
PLongArray
(
Source
)
[
2
]
xor
S
[
6
]
;
B
.
L
:
=
PLongArray
(
Source
)
[
3
]
xor
S
[
7
]
;
S
:
=
@
S
[
36
]
;
for
I
:
=
0
to
7
do
begin
X
:
=
Box
[
0
,
C
.
A
]
xor
Box
[
1
,
C
.
B
]
xor
Box
[
2
,
C
.
C
]
xor
Box
[
3
,
C
.
D
]
;
Y
:
=
Box
[
0
,
D
.
D
]
xor
Box
[
1
,
D
.
A
]
xor
Box
[
2
,
D
.
B
]
xor
Box
[
3
,
D
.
C
]
;
A
.
L
:
=
A
.
L
shl
1
or
A
.
L
shr
31
;
B
.
L
:
=
B
.
L
xor
(
X
+
Y
shl
1
+
S
[
3
]
)
;
A
.
L
:
=
A
.
L
xor
(
X
+
Y
+
S
[
2
]
)
;
B
.
L
:
=
B
.
L
shr
1
or
B
.
L
shl
31
;
X
:
=
Box
[
0
,
A
.
A
]
xor
Box
[
1
,
A
.
B
]
xor
Box
[
2
,
A
.
C
]
xor
Box
[
3
,
A
.
D
]
;
Y
:
=
Box
[
0
,
B
.
D
]
xor
Box
[
1
,
B
.
A
]
xor
Box
[
2
,
B
.
B
]
xor
Box
[
3
,
B
.
C
]
;
C
.
L
:
=
C
.
L
shl
1
or
C
.
L
shr
31
;
D
.
L
:
=
D
.
L
xor
(
X
+
Y
shl
1
+
S
[
1
]
)
;
C
.
L
:
=
C
.
L
xor
(
X
+
Y
+
S
[
0
]
)
;
D
.
L
:
=
D
.
L
shr
1
or
D
.
L
shl
31
;
Dec
(
PLongWord
(
S
)
,
4
)
;
end
;
S
:
=
FUser
;
PLongArray
(
Dest
)
[
0
]
:
=
A
.
L
xor
S
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
B
.
L
xor
S
[
1
]
;
PLongArray
(
Dest
)
[
2
]
:
=
C
.
L
xor
S
[
2
]
;
PLongArray
(
Dest
)
[
3
]
:
=
D
.
L
xor
S
[
3
]
;
end
;
// .TCipher_IDEA
class
function
TCipher_IDEA
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BufferSize
:
=
8
;
Result
.
BlockSize
:
=
8
;
Result
.
UserSize
:
=
208
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_IDEA
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
function
IDEAInv
(
X
:
Word
)
:
Word
;
var
A
,
B
,
C
,
D
:
Word
;
begin
if
X <
=
1
then
begin
Result
:
=
X
;
Exit
;
end
;
A
:
=
1
;
B
:
=
$10001
div
X
;
C
:
=
$10001
mod
X
;
while
C <>
1
do
begin
D
:
=
X
div
C
;
X
:
=
X
mod
C
;
Inc
(
A
,
B
*
D
)
;
if
X
=
1
then
begin
Result
:
=
A
;
Exit
;
end
;
D
:
=
C
div
X
;
C
:
=
C
mod
X
;
Inc
(
B
,
A
*
D
)
;
end
;
Result
:
=
1
-
B
;
end
;
var
I
:
Integer
;
E
:
PWordArray
;
A
,
B
,
C
:
Word
;
K
,
D
:
PWordArray
;
begin
E
:
=
FUser
;
Move
(
Key
,
E
^
,
Size
)
;
for
I
:
=
0
to
7
do
E
[
I
]
:
=
Swap
(
E
[
I
]
)
;
for
I
:
=
0
to
39
do
E
[
I
+
8
]
:
=
E
[
I
and
not
7
+
(
I
+
1
)
and
7
]
shl
9
or
E
[
I
and
not
7
+
(
I
+
2
)
and
7
]
shr
7
;
for
I
:
=
41
to
44
do
E
[
I
+
7
]
:
=
E
[
I
]
shl
9
or
E
[
I
+
1
]
shr
7
;
K
:
=
E
;
D
:
=
@
E
[
100
]
;
A
:
=
IDEAInv
(
K
[
0
]
)
;
B
:
=
0
-
K
[
1
]
;
C
:
=
0
-
K
[
2
]
;
D
[
3
]
:
=
IDEAInv
(
K
[
3
]
)
;
D
[
2
]
:
=
C
;
D
[
1
]
:
=
B
;
D
[
0
]
:
=
A
;
Inc
(
PWord
(
K
)
,
4
)
;
for
I
:
=
1
to
8
do
begin
Dec
(
PWord
(
D
)
,
6
)
;
A
:
=
K
[
0
]
;
D
[
5
]
:
=
K
[
1
]
;
D
[
4
]
:
=
A
;
A
:
=
IDEAInv
(
K
[
2
]
)
;
B
:
=
0
-
K
[
3
]
;
C
:
=
0
-
K
[
4
]
;
D
[
3
]
:
=
IDEAInv
(
K
[
5
]
)
;
D
[
2
]
:
=
B
;
D
[
1
]
:
=
C
;
D
[
0
]
:
=
A
;
Inc
(
PWord
(
K
)
,
6
)
;
end
;
A
:
=
D
[
2
]
;
D
[
2
]
:
=
D
[
1
]
;
D
[
1
]
:
=
A
;
end
;
function
IDEAMul
(
X
,
Y
:
LongWord
)
:
LongWord
;
asm
AND
EAX
,
0FFFFh
JZ
@@
1
AND
EDX
,
0FFFFh
JZ
@@
1
MUL EDX
MOV EDX
,
EAX
MOV ECX
,
EAX
SHR
EDX
,
16
SUB EAX
,
EDX
SUB CX
,
AX
ADC EAX
,
0
RET
@@
1
:
LEA EAX
,
[
EAX
+
EDX
-
1
]
NEG EAX
end
;
procedure
IDEACipher
(
Source
,
Dest
:
PLongArray
;
Key
:
PWordArray
)
;
var
I
:
LongWord
;
X
,
Y
,
A
,
B
,
C
,
D
:
LongWord
;
begin
I
:
=
SwapLong
(
Source
[
0
]
)
;
A
:
=
I
shr
16
;
B
:
=
I
and
$FFFF
;
I
:
=
SwapLong
(
Source
[
1
]
)
;
C
:
=
I
shr
16
;
D
:
=
I
and
$FFFF
;
for
I
:
=
0
to
7
do
begin
A
:
=
IDEAMul
(
A
,
Key
[
0
]
)
;
Inc
(
B
,
Key
[
1
]
)
;
Inc
(
C
,
Key
[
2
]
)
;
D
:
=
IDEAMul
(
D
,
Key
[
3
]
)
;
Y
:
=
C
xor
A
;
Y
:
=
IDEAMul
(
Y
,
Key
[
4
]
)
;
X
:
=
B
xor
D
+
Y
;
X
:
=
IDEAMul
(
X
,
Key
[
5
]
)
;
Inc
(
Y
,
X
)
;
A
:
=
A
xor
X
;
D
:
=
D
xor
Y
;
Y
:
=
B
xor
Y
;
B
:
=
C
xor
X
;
C
:
=
Y
;
Key
:
=
@
Key
[
6
]
;
end
;
Dest
[
0
]
:
=
SwapLong
(
IDEAMul
(
A
,
Key
[
0
]
)
shl
16
or
(
C
+
Key
[
1
]
)
and
$FFFF
)
;
Dest
[
1
]
:
=
SwapLong
(
(
B
+
Key
[
2
]
)
shl
16
or
IDEAMul
(
D
,
Key
[
3
]
)
and
$FFFF
)
;
end
;
procedure
TCipher_IDEA
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
IDEACipher
(
Source
,
Dest
,
FUser
)
;
end
;
procedure
TCipher_IDEA
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
IDEACipher
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
26
]
)
;
end
;
// .TCipher_Cast256
class
function
TCipher_Cast256
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
32
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
384
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Cast256
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
X
:
array
[
0
..
7
]
of
LongWord
;
M
,
R
,
I
,
J
,
T
:
LongWord
;
K
:
PLongArray
;
begin
FillChar
(
X
,
SizeOf
(
X
)
,
0
)
;
Move
(
Key
,
X
,
Size
)
;
SwapLongBuffer
(
X
,
X
,
8
)
;
K
:
=
FUser
;
M
:
=
$5A827999
;
R
:
=
19
;
for
I
:
=
0
to
11
do
begin
for
J
:
=
0
to
1
do
begin
T
:
=
M
+
X
[
7
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
6
]
:
=
X
[
6
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
xor
X
[
6
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
5
]
:
=
X
[
5
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
-
X
[
5
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
4
]
:
=
X
[
4
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
+
X
[
4
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
3
]
:
=
X
[
3
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
xor
X
[
3
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
2
]
:
=
X
[
2
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
-
X
[
2
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
1
]
:
=
X
[
1
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
+
X
[
1
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
0
]
:
=
X
[
0
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
T
:
=
M
xor
X
[
0
]
;
T
:
=
T
shl
R
or
T
shr
(
32
-
R
)
;
X
[
7
]
:
=
X
[
7
]
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Inc
(
M
,
$6ED9EBA1
)
;
Inc
(
R
,
17
)
;
end
;
if
I <
6
then
begin
K
[
48
]
:
=
X
[
0
]
and
$1F
;
K
[
49
]
:
=
X
[
2
]
and
$1F
;
K
[
50
]
:
=
X
[
4
]
and
$1F
;
K
[
51
]
:
=
X
[
6
]
and
$1F
;
K
[
0
]
:
=
X
[
7
]
;
K
[
1
]
:
=
X
[
5
]
;
K
[
2
]
:
=
X
[
3
]
;
K
[
3
]
:
=
X
[
1
]
;
end
else
begin
K
[
48
]
:
=
X
[
6
]
and
$1F
;
K
[
49
]
:
=
X
[
4
]
and
$1F
;
K
[
50
]
:
=
X
[
2
]
and
$1F
;
K
[
51
]
:
=
X
[
0
]
and
$1F
;
K
[
0
]
:
=
X
[
1
]
;
K
[
1
]
:
=
X
[
3
]
;
K
[
2
]
:
=
X
[
5
]
;
K
[
3
]
:
=
X
[
7
]
;
end
;
K
:
=
@
K
[
4
]
;
end
;
ProtectBuffer
(
X
,
SizeOf
(
X
)
)
;
end
;
procedure
TCipher_Cast256
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
T
,
A
,
B
,
C
,
D
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
FUser
;
SwapLongBuffer
(
Source
^
,
Dest
^
,
4
)
;
A
:
=
PLongArray
(
Dest
)
[
0
]
;
B
:
=
PLongArray
(
Dest
)
[
1
]
;
C
:
=
PLongArray
(
Dest
)
[
2
]
;
D
:
=
PLongArray
(
Dest
)
[
3
]
;
for
I
:
=
0
to
5
do
begin
T
:
=
K
[
0
]
+
D
;
T
:
=
T
shl
K
[
48
]
or
T
shr
(
32
-
K
[
48
]
)
;
C
:
=
C
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
xor
C
;
T
:
=
T
shl
K
[
49
]
or
T
shr
(
32
-
K
[
49
]
)
;
B
:
=
B
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
-
B
;
T
:
=
T
shl
K
[
50
]
or
T
shr
(
32
-
K
[
50
]
)
;
A
:
=
A
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
3
]
+
A
;
T
:
=
T
shl
K
[
51
]
or
T
shr
(
32
-
K
[
51
]
)
;
D
:
=
D
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
K
:
=
@
K
[
4
]
;
end
;
for
I
:
=
0
to
5
do
begin
T
:
=
K
[
0
]
+
A
;
T
:
=
T
shl
K
[
48
]
or
T
shr
(
32
-
K
[
48
]
)
;
D
:
=
D
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
-
B
;
T
:
=
T
shl
K
[
49
]
or
T
shr
(
32
-
K
[
49
]
)
;
A
:
=
A
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
xor
C
;
T
:
=
T
shl
K
[
50
]
or
T
shr
(
32
-
K
[
50
]
)
;
B
:
=
B
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
3
]
+
D
;
T
:
=
T
shl
K
[
51
]
or
T
shr
(
32
-
K
[
51
]
)
;
C
:
=
C
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
K
:
=
@
K
[
4
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
;
PLongArray
(
Dest
)
[
1
]
:
=
B
;
PLongArray
(
Dest
)
[
2
]
:
=
C
;
PLongArray
(
Dest
)
[
3
]
:
=
D
;
SwapLongBuffer
(
Dest
^
,
Dest
^
,
4
)
;
end
;
procedure
TCipher_Cast256
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
T
,
A
,
B
,
C
,
D
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
44
]
;
SwapLongBuffer
(
Source
^
,
Dest
^
,
4
)
;
A
:
=
PLongArray
(
Dest
)
[
0
]
;
B
:
=
PLongArray
(
Dest
)
[
1
]
;
C
:
=
PLongArray
(
Dest
)
[
2
]
;
D
:
=
PLongArray
(
Dest
)
[
3
]
;
for
I
:
=
0
to
5
do
begin
T
:
=
K
[
3
]
+
D
;
T
:
=
T
shl
K
[
51
]
or
T
shr
(
32
-
K
[
51
]
)
;
C
:
=
C
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
xor
C
;
T
:
=
T
shl
K
[
50
]
or
T
shr
(
32
-
K
[
50
]
)
;
B
:
=
B
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
-
B
;
T
:
=
T
shl
K
[
49
]
or
T
shr
(
32
-
K
[
49
]
)
;
A
:
=
A
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
0
]
+
A
;
T
:
=
T
shl
K
[
48
]
or
T
shr
(
32
-
K
[
48
]
)
;
D
:
=
D
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Dec
(
PLongWord
(
K
)
,
4
)
;
end
;
for
I
:
=
0
to
5
do
begin
T
:
=
K
[
3
]
+
A
;
T
:
=
T
shl
K
[
51
]
or
T
shr
(
32
-
K
[
51
]
)
;
D
:
=
D
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
-
B
;
T
:
=
T
shl
K
[
50
]
or
T
shr
(
32
-
K
[
50
]
)
;
A
:
=
A
xor
(
Cast256_Data
[
0
,
T
shr
24
]
+
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
xor
C
;
T
:
=
T
shl
K
[
49
]
or
T
shr
(
32
-
K
[
49
]
)
;
B
:
=
B
xor
(
Cast256_Data
[
0
,
T
shr
24
]
-
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast256_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
0
]
+
D
;
T
:
=
T
shl
K
[
48
]
or
T
shr
(
32
-
K
[
48
]
)
;
C
:
=
C
xor
(
Cast256_Data
[
0
,
T
shr
24
]
xor
Cast256_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast256_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast256_Data
[
3
,
T
and
$FF
]
)
;
Dec
(
PLongWord
(
K
)
,
4
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
;
PLongArray
(
Dest
)
[
1
]
:
=
B
;
PLongArray
(
Dest
)
[
2
]
:
=
C
;
PLongArray
(
Dest
)
[
3
]
:
=
D
;
SwapLongBuffer
(
Dest
^
,
Dest
^
,
4
)
;
end
;
// .TCipher_Mars
class
function
TCipher_Mars
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
56
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
160
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Mars
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
B
:
PLongArray
;
function
FixKey
(
K
,
R
:
LongWord
)
:
LongWord
;
var
M1
,
M2
:
LongWord
;
I
:
LongWord
;
begin
I
:
=
K
and
3
;
K
:
=
K
or
3
;
M1
:
=
not
K
xor
(
K
shl
1
)
;
M2
:
=
M1
and
(
M1
shl
1
)
;
M2
:
=
M2
and
(
M2
shl
2
)
;
M2
:
=
M2
and
(
M2
shl
4
)
;
M2
:
=
M2
and
(
M1
shl
8
)
;
M2
:
=
M2
and
$FFFFFE00
;
if
M2
=
0
then
begin
Result
:
=
K
;
Exit
;
end
;
M1
:
=
M2
or
(
M2
shr
1
)
;
M1
:
=
M1
or
(
M1
shr
2
)
;
M1
:
=
M1
or
(
M2
shr
4
)
;
M1
:
=
M1
or
(
M1
shr
5
)
;
M1
:
=
M1
and
(
(
not
K
xor
(
K
shl
1
)
)
and
(
not
K
xor
(
K
shr
1
)
)
and
$7FFFFFFC
)
;
Result
:
=
K
xor
(
(
B
[
265
+
I
]
shl
R
or
B
[
265
+
I
]
shr
(
32
-
R
)
)
and
M1
)
;
end
;
var
T
:
array
[
0
..
14
]
of
LongWord
;
I
,
J
,
L
:
LongWord
;
U
:
LongWord
;
K
:
PLongArray
;
begin
K
:
=
FUser
;
B
:
=
@
Mars_Data
;
FillChar
(
T
,
SizeOf
(
T
)
,
0
)
;
Move
(
Key
,
T
,
Size
)
;
Size
:
=
Size
div
4
;
T
[
Size
]
:
=
Size
;
for
J
:
=
0
to
3
do
begin
for
I
:
=
0
to
14
do
begin
U
:
=
T
[
(
I
+
8
)
mod
15
]
xor
T
[
(
I
+
13
)
mod
15
]
;
T
[
I
]
:
=
T
[
I
]
xor
(
U
shl
3
or
U
shr
29
)
xor
(
I
*
4
+
J
)
;
end
;
for
L
:
=
0
to
3
do
begin
for
I
:
=
0
to
14
do
begin
Inc
(
T
[
I
]
,
B
[
T
[
(
I
+
14
)
mod
15
]
and
$1FF
]
)
;
T
[
I
]
:
=
T
[
I
]
shl
9
or
T
[
I
]
shr
23
;
end
;
end
;
for
I
:
=
0
to
9
do
K
[
(
J
*
10
)
+
I
]
:
=
T
[
(
I
*
4
)
mod
15
]
;
end
;
I
:
=
5
;
repeat
K
[
I
]
:
=
FixKey
(
K
[
I
]
,
K
[
I
-
1
]
)
;
Inc
(
I
,
2
)
;
until
I >
=
37
;
end
;
procedure
TCipher_Mars
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
K
:
PLongArray
;
I
,
L
,
R
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
FUser
;
A
:
=
PLongArray
(
Source
)
[
0
]
+
K
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
+
K
[
1
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
+
K
[
2
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
+
K
[
3
]
;
K
:
=
@
K
[
4
]
;
for
I
:
=
0
to
1
do
begin
B
:
=
B
xor
Mars_Data
[
A
and
$FF
]
+
Mars_Data
[
A
shr
8
and
$FF
+
256
]
;
Inc
(
C
,
Mars_Data
[
A
shr
16
and
$FF
]
)
;
D
:
=
D
xor
Mars_Data
[
A
shr
24
+
256
]
;
A
:
=
(
A
shr
24
or
A
shl
8
)
+
D
;
C
:
=
C
xor
Mars_Data
[
B
and
$FF
]
+
Mars_Data
[
B
shr
8
and
$FF
+
256
]
;
Inc
(
D
,
Mars_Data
[
B
shr
16
and
$FF
]
)
;
A
:
=
A
xor
Mars_Data
[
B
shr
24
+
256
]
;
B
:
=
(
B
shr
24
or
B
shl
8
)
+
C
;
D
:
=
D
xor
Mars_Data
[
C
and
$FF
]
+
Mars_Data
[
C
shr
8
and
$FF
+
256
]
;
Inc
(
A
,
Mars_Data
[
C
shr
16
and
$FF
]
)
;
B
:
=
B
xor
Mars_Data
[
C
shr
24
+
256
]
;
C
:
=
C
shr
24
or
C
shl
8
;
A
:
=
A
xor
Mars_Data
[
D
and
$FF
]
+
Mars_Data
[
D
shr
8
and
$FF
+
256
]
;
Inc
(
B
,
Mars_Data
[
D
shr
16
and
$FF
]
)
;
C
:
=
C
xor
Mars_Data
[
D
shr
24
+
256
]
;
D
:
=
D
shr
24
or
D
shl
8
;
end
;
for
I
:
=
0
to
3
do
begin
L
:
=
A
+
K
[
0
]
;
A
:
=
A
shl
13
or
A
shr
19
;
R
:
=
A
*
K
[
1
]
;
R
:
=
R
shl
5
or
R
shr
27
;
Inc
(
C
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Inc
(
B
,
L
)
;
D
:
=
D
xor
R
;
end
else
begin
Inc
(
D
,
L
)
;
B
:
=
B
xor
R
;
end
;
L
:
=
B
+
K
[
2
]
;
B
:
=
B
shl
13
or
B
shr
19
;
R
:
=
B
*
K
[
3
]
;
R
:
=
R
shl
5
or
R
shr
27
;
Inc
(
D
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Inc
(
C
,
L
)
;
A
:
=
A
xor
R
;
end
else
begin
Inc
(
A
,
L
)
;
C
:
=
C
xor
R
;
end
;
L
:
=
C
+
K
[
4
]
;
C
:
=
C
shl
13
or
C
shr
19
;
R
:
=
C
*
K
[
5
]
;
R
:
=
R
shl
5
or
R
shr
27
;
Inc
(
A
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Inc
(
D
,
L
)
;
B
:
=
B
xor
R
;
end
else
begin
Inc
(
B
,
L
)
;
D
:
=
D
xor
R
;
end
;
L
:
=
D
+
K
[
6
]
;
D
:
=
D
shl
13
or
D
shr
19
;
R
:
=
D
*
K
[
7
]
;
R
:
=
R
shl
5
or
R
shr
27
;
Inc
(
B
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Inc
(
A
,
L
)
;
C
:
=
C
xor
R
;
end
else
begin
Inc
(
C
,
L
)
;
A
:
=
A
xor
R
;
end
;
K
:
=
@
K
[
8
]
;
end
;
for
I
:
=
0
to
1
do
begin
B
:
=
B
xor
Mars_Data
[
A
and
$FF
+
256
]
;
Dec
(
C
,
Mars_Data
[
A
shr
24
]
)
;
D
:
=
D
-
Mars_Data
[
A
shr
16
and
$FF
+
256
]
xor
Mars_Data
[
A
shr
8
and
$FF
]
;
A
:
=
A
shl
24
or
A
shr
8
;
C
:
=
C
xor
Mars_Data
[
B
and
$FF
+
256
]
;
Dec
(
D
,
Mars_Data
[
B
shr
24
]
)
;
A
:
=
A
-
Mars_Data
[
B
shr
16
and
$FF
+
256
]
xor
Mars_Data
[
B
shr
8
and
$FF
]
;
B
:
=
B
shl
24
or
B
shr
8
;
Dec
(
C
,
B
)
;
D
:
=
D
xor
Mars_Data
[
C
and
$FF
+
256
]
;
Dec
(
A
,
Mars_Data
[
C
shr
24
]
)
;
B
:
=
B
-
Mars_Data
[
C
shr
16
and
$FF
+
256
]
xor
Mars_Data
[
C
shr
8
and
$FF
]
;
C
:
=
C
shl
24
or
C
shr
8
;
Dec
(
D
,
A
)
;
A
:
=
A
xor
Mars_Data
[
D
and
$FF
+
256
]
;
Dec
(
B
,
Mars_Data
[
D
shr
24
]
)
;
C
:
=
C
-
Mars_Data
[
D
shr
16
and
$FF
+
256
]
xor
Mars_Data
[
D
shr
8
and
$FF
]
;
D
:
=
D
shl
24
or
D
shr
8
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
-
K
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
B
-
K
[
1
]
;
PLongArray
(
Dest
)
[
2
]
:
=
C
-
K
[
2
]
;
PLongArray
(
Dest
)
[
3
]
:
=
D
-
K
[
3
]
;
end
;
procedure
TCipher_Mars
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
K
:
PLongArray
;
I
,
L
,
R
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
28
]
;
A
:
=
PLongArray
(
Source
)
[
0
]
+
K
[
8
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
+
K
[
9
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
+
K
[
10
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
+
K
[
11
]
;
for
I
:
=
0
to
1
do
begin
D
:
=
D
shr
24
or
D
shl
8
;
C
:
=
C
xor
Mars_Data
[
D
shr
8
and
$FF
]
+
Mars_Data
[
D
shr
16
and
$FF
+
256
]
;
Inc
(
B
,
Mars_Data
[
D
shr
24
]
)
;
A
:
=
A
xor
Mars_Data
[
D
and
$FF
+
256
]
;
Inc
(
D
,
A
)
;
C
:
=
C
shr
24
or
C
shl
8
;
B
:
=
B
xor
Mars_Data
[
C
shr
8
and
$FF
]
+
Mars_Data
[
C
shr
16
and
$FF
+
256
]
;
Inc
(
A
,
Mars_Data
[
C
shr
24
]
)
;
D
:
=
D
xor
Mars_Data
[
C
and
$FF
+
256
]
;
Inc
(
C
,
B
)
;
B
:
=
B
shr
24
or
B
shl
8
;
A
:
=
A
xor
Mars_Data
[
B
shr
8
and
$FF
]
+
Mars_Data
[
B
shr
16
and
$FF
+
256
]
;
Inc
(
D
,
Mars_Data
[
B
shr
24
]
)
;
C
:
=
C
xor
Mars_Data
[
B
and
$FF
+
256
]
;
A
:
=
A
shr
24
or
A
shl
8
;
D
:
=
D
xor
Mars_Data
[
A
shr
8
and
$FF
]
+
Mars_Data
[
A
shr
16
and
$FF
+
256
]
;
Inc
(
C
,
Mars_Data
[
A
shr
24
]
)
;
B
:
=
B
xor
Mars_Data
[
A
and
$FF
+
256
]
;
end
;
for
I
:
=
0
to
3
do
begin
R
:
=
D
*
K
[
7
]
;
R
:
=
R
shl
5
or
R
shr
27
;
D
:
=
D
shr
13
or
D
shl
19
;
L
:
=
D
+
K
[
6
]
;
Dec
(
B
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Dec
(
C
,
L
)
;
A
:
=
A
xor
R
;
end
else
begin
Dec
(
A
,
L
)
;
C
:
=
C
xor
R
;
end
;
R
:
=
C
*
K
[
5
]
;
R
:
=
R
shl
5
or
R
shr
27
;
C
:
=
C
shr
13
or
C
shl
19
;
L
:
=
C
+
K
[
4
]
;
Dec
(
A
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Dec
(
B
,
L
)
;
D
:
=
D
xor
R
;
end
else
begin
Dec
(
D
,
L
)
;
B
:
=
B
xor
R
;
end
;
R
:
=
B
*
K
[
3
]
;
R
:
=
R
shl
5
or
R
shr
27
;
B
:
=
B
shr
13
or
B
shl
19
;
L
:
=
B
+
K
[
2
]
;
Dec
(
D
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Dec
(
A
,
L
)
;
C
:
=
C
xor
R
;
end
else
begin
Dec
(
C
,
L
)
;
A
:
=
A
xor
R
;
end
;
R
:
=
A
*
K
[
1
]
;
R
:
=
R
shl
5
or
R
shr
27
;
A
:
=
A
shr
13
or
A
shl
19
;
L
:
=
A
+
K
[
0
]
;
Dec
(
C
,
L
shl
R
or
L
shr
(
32
-
R
)
)
;
L
:
=
Mars_Data
[
L
and
$1FF
]
xor
R
;
R
:
=
R
shl
5
or
R
shr
27
;
L
:
=
L
xor
R
;
L
:
=
L
shl
R
or
L
shr
(
32
-
R
)
;
if
I <
=
1
then
begin
Dec
(
D
,
L
)
;
B
:
=
B
xor
R
;
end
else
begin
Dec
(
B
,
L
)
;
D
:
=
D
xor
R
;
end
;
Dec
(
PLongWord
(
K
)
,
8
)
;
end
;
for
I
:
=
0
to
1
do
begin
D
:
=
D
shl
24
or
D
shr
8
;
C
:
=
C
xor
Mars_Data
[
D
shr
24
+
256
]
;
Dec
(
B
,
Mars_Data
[
D
shr
16
and
$FF
]
)
;
A
:
=
A
-
Mars_Data
[
D
shr
8
and
$FF
+
256
]
xor
Mars_Data
[
D
and
$FF
]
;
C
:
=
C
shl
24
or
C
shr
8
;
B
:
=
B
xor
Mars_Data
[
C
shr
24
+
256
]
;
Dec
(
A
,
Mars_Data
[
C
shr
16
and
$FF
]
)
;
D
:
=
D
-
Mars_Data
[
C
shr
8
and
$FF
+
256
]
xor
Mars_Data
[
C
and
$FF
]
;
Dec
(
B
,
C
)
;
B
:
=
B
shl
24
or
B
shr
8
;
A
:
=
A
xor
Mars_Data
[
B
shr
24
+
256
]
;
Dec
(
D
,
Mars_Data
[
B
shr
16
and
$FF
]
)
;
C
:
=
C
-
Mars_Data
[
B
shr
8
and
$FF
+
256
]
xor
Mars_Data
[
B
and
$FF
]
;
Dec
(
A
,
D
)
;
A
:
=
A
shl
24
or
A
shr
8
;
D
:
=
D
xor
Mars_Data
[
A
shr
24
+
256
]
;
Dec
(
C
,
Mars_Data
[
A
shr
16
and
$FF
]
)
;
B
:
=
B
-
Mars_Data
[
A
shr
8
and
$FF
+
256
]
xor
Mars_Data
[
A
and
$FF
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
-
K
[
4
]
;
PLongArray
(
Dest
)
[
1
]
:
=
B
-
K
[
5
]
;
PLongArray
(
Dest
)
[
2
]
:
=
C
-
K
[
6
]
;
PLongArray
(
Dest
)
[
3
]
:
=
D
-
K
[
7
]
;
end
;
// .TCipher_RC4
class
function
TCipher_RC4
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
256
;
Result
.
BlockSize
:
=
1
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
256
+
2
;
Result
.
UserSave
:
=
True
;
end
;
procedure
TCipher_RC4
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
255
]
of
Byte
;
D
:
PByteArray
;
I
,
J
,
T
:
Byte
;
begin
D
:
=
FUser
;
for
I
:
=
0
to
255
do
begin
D
[
I
]
:
=
I
;
if
Size >
0
then
K
[
I
]
:
=
TByteArray
(
Key
)
[
I
mod
Size
]
;
end
;
J
:
=
0
;
for
I
:
=
0
to
255
do
begin
J
:
=
J
+
D
[
I
]
+
K
[
I
]
;
T
:
=
D
[
I
]
;
D
[
I
]
:
=
D
[
J
]
;
D
[
J
]
:
=
T
;
end
;
D
[
256
]
:
=
0
;
D
[
257
]
:
=
0
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_RC4
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
D
:
PByteArray
;
S
:
Integer
;
T
,
I
,
J
:
Byte
;
begin
D
:
=
FUser
;
I
:
=
D
[
256
]
;
J
:
=
D
[
257
]
;
for
S
:
=
0
to
Size
-
1
do
begin
Inc
(
I
)
;
T
:
=
D
[
I
]
;
Inc
(
J
,
T
)
;
D
[
I
]
:
=
D
[
J
]
;
D
[
J
]
:
=
T
;
PByteArray
(
Dest
)
[
S
]
:
=
PByteArray
(
Source
)
[
S
]
xor
D
[
Byte
(
D
[
I
]
+
T
)
]
;
end
;
D
[
256
]
:
=
I
;
D
[
257
]
:
=
J
;
end
;
procedure
TCipher_RC4
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
DoEncode
(
Source
,
Dest
,
Size
)
;
end
;
// .TCipher_RC6
class
function
TCipher_RC6
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
256
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
272
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_RC6
.
SetRounds
(
Value
:
Integer
)
;
begin
if
Value <
16
then
Value
:
=
16
else
if
Value >
24
then
Value
:
=
24
;
if
Value <> FRounds
then
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
FRounds
:
=
Value
;
end
;
end
;
procedure
TCipher_RC6
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
63
]
of
LongWord
;
D
:
PLongArray
;
I
,
J
,
L
,
A
,
B
,
Z
,
T
:
LongWord
;
begin
if
FRounds
=
0
then
FRounds
:
=
20
else
if
FRounds <
16
then
FRounds
:
=
16
else
if
FRounds >
24
then
FRounds
:
=
24
;
D
:
=
FUser
;
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
L
:
=
Size
shr
2
;
if
Size
and
3
<>
0
then
Inc
(
L
)
;
if
L <
=
0
then
L
:
=
1
;
J
:
=
$B7E15163
;
for
I
:
=
0
to
(
FRounds
+
2
)
*
2
do
begin
D
[
I
]
:
=
J
;
Inc
(
J
,
$9E3779B9
)
;
end
;
if
L >
LongWord
(
FRounds
+
2
)
*
2
then
Z
:
=
L
*
3
else
Z
:
=
(
FRounds
+
2
)
*
6
;
I
:
=
0
;
J
:
=
0
;
A
:
=
0
;
B
:
=
0
;
for
Z
:
=
Z
downto
1
do
begin
A
:
=
A
+
B
+
D
[
I
]
;
A
:
=
A
shl
3
or
A
shr
29
;
D
[
I
]
:
=
A
;
T
:
=
A
+
B
;
B
:
=
T
+
K
[
J
]
;
B
:
=
B
shl
T
or
B
shr
(
32
-
T
)
;
K
[
J
]
:
=
B
;
I
:
=
(
I
+
1
)
mod
(
LongWord
(
FRounds
+
2
)
*
2
)
;
J
:
=
(
J
+
1
)
mod
L
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_RC6
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF UseASM}
asm
PUSH EBX
PUSH ESI
PUSH EDI
PUSH EBP
PUSH ECX
MOV EBP
,
[
EAX
]
.
TCipher_RC6
.
FRounds
// Rounds
MOV ESI
,
[
EAX
]
.
TCipher_RC6
.
FUser
// Key
MOV EAX
,
[
EDX
+
0
]
// A
MOV EBX
,
[
EDX
+
4
]
// B
MOV EDI
,
[
EDX
+
8
]
// C
MOV EDX
,
[
EDX
+
12
]
// D
ADD EBX
,
[
ESI
+
0
]
// Inc(B, K[0])
ADD EDX
,
[
ESI
+
4
]
// Inc(D, K[1])
ADD ESI
,
8
// Inc(PInteger(K), 2)
@@
1
:
LEA ECX
,
[
EBX
*
2
+
1
]
// ECX := B * 2 +1
IMUL ECX
,
EBX
// ECX := ECX * B
ROL ECX
,
5
// T := ROL(B * (B * 2 +1), 5)
PUSH ECX
// save T
XOR
EAX
,
ECX
// A := A xor T
LEA ECX
,
[
EDX
*
2
+
1
]
// ECX := D * 2 +1
IMUL ECX
,
EDX
// ECX := ECX * D
ROL ECX
,
5
// U := ROL(D * (D * 2 +1), 5)
XOR
EDI
,
ECX
// C := C xor U
ROL EAX
,
CL
// A := ROL(A xor T, U)
POP ECX
// restore T
ADD EAX
,
[
ESI
+
0
]
// Inc(A, K[0])
ROL EDI
,
CL
// C := ROL(C xor U, T)
MOV ECX
,
EAX
// T := A
ADD EDI
,
[
ESI
+
4
]
// Inc(C, K[1])
MOV EAX
,
EBX
// A := B
MOV EBX
,
EDI
// B := C
MOV EDI
,
EDX
// C := D
DEC EBP
MOV EDX
,
ECX
// D := T;
LEA ESI
,
[
ESI
+
8
]
// Inc(PInteger(K), 2)
JNZ
@@
1
ADD EAX
,
[
ESI
+
0
]
// Inc(A, K[0])
ADD EDI
,
[
ESI
+
4
]
// Inc(C, K[1])
POP ECX
MOV
[
ECX
+
0
]
,
EAX
// A
MOV
[
ECX
+
4
]
,
EBX
// B
MOV
[
ECX
+
8
]
,
EDI
// C
MOV
[
ECX
+
12
]
,
EDX
// D
POP EBP
POP EDI
POP ESI
POP EBX
end
;
{$ELSE}
var
K
:
PLongArray
;
I
,
T
,
U
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
FUser
;
A
:
=
PLongArray
(
Source
)
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
+
K
[
0
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
+
K
[
1
]
;
for
I
:
=
1
to
FRounds
do
begin
K
:
=
@
K
[
2
]
;
T
:
=
B
*
(
B
+
B
+
1
)
;
T
:
=
T
shl
5
or
T
shr
27
;
U
:
=
D
*
(
D
+
D
+
1
)
;
U
:
=
U
shl
5
or
U
shr
27
;
A
:
=
A
xor
T
;
A
:
=
A
shl
U
or
A
shr
(
32
-
U
)
+
K
[
0
]
;
C
:
=
C
xor
U
;
C
:
=
C
shl
T
or
C
shr
(
32
-
T
)
+
K
[
1
]
;
T
:
=
A
;
A
:
=
B
;
B
:
=
C
;
C
:
=
D
;
D
:
=
T
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
+
K
[
2
]
;
PLongArray
(
Dest
)
[
1
]
:
=
B
;
PLongArray
(
Dest
)
[
2
]
:
=
C
+
K
[
3
]
;
PLongArray
(
Dest
)
[
3
]
:
=
D
;
end
;
{$ENDIF}
procedure
TCipher_RC6
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF UseASM}
asm
PUSH EBX
PUSH ESI
PUSH EDI
PUSH EBP
PUSH ECX
MOV EBP
,
[
EAX
]
.
TCipher_RC6
.
FRounds
// Rounds
MOV ESI
,
[
EAX
]
.
TCipher_RC6
.
FUser
// Key
LEA ESI
,
[
ESI
+
EBP
*
8
]
// Key[FRounds * 2]
MOV EAX
,
[
EDX
+
0
]
// A
MOV EBX
,
[
EDX
+
4
]
// B
MOV EDI
,
[
EDX
+
8
]
// C
MOV EDX
,
[
EDX
+
12
]
// D
SUB EDI
,
[
ESI
+
12
]
// Dec(C, K[3])
SUB EAX
,
[
ESI
+
8
]
// Dec(A, K[2])
@@
1
:
MOV ECX
,
EAX
// T := A
SUB EDX
,
[
ESI
+
0
]
// Dec(A, K[0])
MOV EAX
,
EDX
// A := D
MOV EDX
,
EDI
// D := C
SUB EBX
,
[
ESI
+
4
]
// Dec(C, K[1])
MOV EDI
,
EBX
// C := B
MOV EBX
,
ECX
// B := T;
LEA ECX
,
[
EDX
*
2
+
1
]
// ECX := D * 2 +1
IMUL ECX
,
EDX
// ECX := ECX * D
ROL ECX
,
5
// U := ROL(D * (D * 2 +1), 5)
PUSH ECX
// save U
ROR EAX
,
CL
// A := ROR(A - K[0], U)
LEA ECX
,
[
EBX
*
2
+
1
]
// ECX := B * 2 +1
IMUL ECX
,
EBX
// ECX := ECX * B
ROL ECX
,
5
// T := ROL(B * (B * 2 +1), 5)
XOR
EAX
,
ECX
// A := A xor T
ROR EDI
,
CL
// C := ROR(C - K[1], T)
POP ECX
// restore U
XOR
EDI
,
ECX
// C := C xor U
DEC EBP
LEA ESI
,
[
ESI
-
8
]
// Dec(PInteger(K), 2)
JNZ
@@
1
SUB EBX
,
[
ESI
+
0
]
// Dec(B, K[0])
SUB EDX
,
[
ESI
+
4
]
// Inc(D, K[1])
POP ECX
MOV
[
ECX
+
0
]
,
EAX
// A
MOV
[
ECX
+
4
]
,
EBX
// B
MOV
[
ECX
+
8
]
,
EDI
// C
MOV
[
ECX
+
12
]
,
EDX
// D
POP EBP
POP EDI
POP ESI
POP EBX
end
;
{$ELSE}
var
I
,
U
,
T
,
A
,
B
,
C
,
D
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
FRounds
*
2
]
;
A
:
=
PLongArray
(
Source
)
[
0
]
-
K
[
2
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
-
K
[
3
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
;
for
I
:
=
1
to
FRounds
do
begin
T
:
=
A
;
A
:
=
D
;
D
:
=
C
;
C
:
=
B
;
B
:
=
T
;
U
:
=
D
*
(
D
+
D
+
1
)
;
U
:
=
U
shl
5
or
U
shr
27
;
T
:
=
B
*
(
B
+
B
+
1
)
;
T
:
=
T
shl
5
or
T
shr
27
;
C
:
=
C
-
K
[
1
]
;
C
:
=
C
shr
T
or
C
shl
(
32
-
T
)
xor
U
;
A
:
=
A
-
K
[
0
]
;
A
:
=
A
shr
U
or
A
shl
(
32
-
U
)
xor
T
;
Dec
(
PLongWord
(
K
)
,
2
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
;
PLongArray
(
Dest
)
[
1
]
:
=
B
-
K
[
0
]
;
PLongArray
(
Dest
)
[
2
]
:
=
C
;
PLongArray
(
Dest
)
[
3
]
:
=
D
-
K
[
1
]
;
end
;
{$ENDIF}
// .TCipher_Rijndael
const
{don't change this}
Rijndael_Blocks
=
4
;
Rijndael_Rounds
=
14
;
class
function
TCipher_Rijndael
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
32
;
Result
.
BlockSize
:
=
Rijndael_Blocks
*
4
;
Result
.
BufferSize
:
=
Rijndael_Blocks
*
4
;
Result
.
UserSize
:
=
(
Rijndael_Rounds
+
1
)
*
Rijndael_Blocks
*
SizeOf
(
LongWord
)
*
2
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Rijndael
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
{ old Rijndael keyshedulling
procedure BuildEncodeKey;
const
RND_Data: array[0..29] of Byte = (
$01,$02,$04,$08,$10,$20,$40,$80,$1B,$36,$6C,$D8,$AB,$4D,$9A,
$2F,$5E,$BC,$63,$C6,$97,$35,$6A,$D4,$B3,$7D,$FA,$EF,$C5,$91);
var
T,R: Integer;
procedure NextRounds;
var
J: Integer;
begin
J := 0;
while (J < FRounds -6) and (R <= FRounds) do
begin
while (J < FRounds -6) and (T < Rijndael_Blocks) do
begin
PLongArray(FUser)[R * Rijndael_Blocks + T] := K[J];
Inc(J);
Inc(T);
end;
if T = Rijndael_Blocks then
begin
T := 0;
Inc(R);
end;
end;
end;
var
RND: PByte;
B: PByte;
I: Integer;
begin
R := 0;
T := 0;
RND := @RND_Data;
NextRounds;
while R <= FRounds do
begin
B := @K;
B^ := B^ xor Rijndael_S[0, K[FRounds -7] shr 8 and $FF] xor RND^; Inc(B);
B^ := B^ xor Rijndael_S[0, K[FRounds -7] shr 16 and $FF]; Inc(B);
B^ := B^ xor Rijndael_S[0, K[FRounds -7] shr 24]; Inc(B);
B^ := B^ xor Rijndael_S[0, K[FRounds -7] and $FF];
Inc(RND);
if FRounds = 14 then
begin
for I := 1 to 7 do K[I] := K[I] xor K[I -1];
B := @K[4];
B^ := B^ xor Rijndael_S[0, K[3] and $FF]; Inc(B);
B^ := B^ xor Rijndael_S[0, K[3] shr 8 and $FF]; Inc(B);
B^ := B^ xor Rijndael_S[0, K[3] shr 16 and $FF]; Inc(B);
B^ := B^ xor Rijndael_S[0, K[3] shr 24];
for I := 5 to 7 do K[I] := K[I] xor K[I -1];
end else
for I := 1 to FRounds -7 do K[I] := K[I] xor K[I -1];
NextRounds;
end;
end;
procedure BuildDecodeKey;
var
I: Integer;
D: PLongWord;
begin
D := Pointer(PChar(FUser) + FUserSize shr 1);
Move(FUser^, D^, FUserSize shr 1);
Inc(D, 4);
for I := 0 to FRounds * 4 - 5 do
begin
D^ := Rijndael_Key[D^ and $FF] xor
(Rijndael_Key[D^ shr 8 and $FF] shl 8 or Rijndael_Key[D^ shr 8 and $FF] shr 24) xor
(Rijndael_Key[D^ shr 16 and $FF] shl 16 or Rijndael_Key[D^ shr 16 and $FF] shr 16) xor
(Rijndael_Key[D^ shr 24] shl 24 or Rijndael_Key[D^ shr 24] shr 8);
Inc(D);
end;
end; }
// new AES conform Keyshedulling
procedure
BuildEncodeKey
;
const
RCon
:
array
[
0
..
9
]
of
LongWord
=
(
$01
,
$02
,
$04
,
$08
,
$10
,
$20
,
$40
,
$80
,
$1b
,
$36
)
;
var
I
:
Integer
;
T
:
LongWord
;
P
:
PLongArray
;
begin
P
:
=
FUser
;
if
Size <
=
16
then
begin
for
I
:
=
0
to
9
do
begin
T
:
=
P
[
3
]
;
P
[
4
]
:
=
Rijndael_S
[
0
,
T
shr
8
and
$FF
]
xor
Rijndael_S
[
0
,
T
shr
16
and
$FF
]
shl
8
xor
Rijndael_S
[
0
,
T
shr
24
]
shl
16
xor
Rijndael_S
[
0
,
T
and
$FF
]
shl
24
xor
P
[
0
]
xor
RCon
[
I
]
;
P
[
5
]
:
=
P
[
1
]
xor
P
[
4
]
;
P
[
6
]
:
=
P
[
2
]
xor
P
[
5
]
;
P
[
7
]
:
=
P
[
3
]
xor
P
[
6
]
;
P
:
=
@
P
[
4
]
;
end
;
end
else
if
Size <
=
24
then
begin
for
I
:
=
0
to
7
do
begin
T
:
=
P
[
5
]
;
P
[
6
]
:
=
Rijndael_S
[
0
,
T
shr
8
and
$FF
]
xor
Rijndael_S
[
0
,
T
shr
16
and
$FF
]
shl
8
xor
Rijndael_S
[
0
,
T
shr
24
]
shl
16
xor
Rijndael_S
[
0
,
T
and
$FF
]
shl
24
xor
P
[
0
]
xor
RCon
[
I
]
;
P
[
7
]
:
=
P
[
1
]
xor
P
[
6
]
;
P
[
8
]
:
=
P
[
2
]
xor
P
[
7
]
;
P
[
9
]
:
=
P
[
3
]
xor
P
[
8
]
;
if
I
=
7
then
Break
;
P
[
10
]
:
=
P
[
4
]
xor
P
[
9
]
;
P
[
11
]
:
=
P
[
5
]
xor
P
[
10
]
;
P
:
=
@
P
[
6
]
;
end
;
end
else
begin
for
I
:
=
0
to
6
do
begin
T
:
=
P
[
7
]
;
P
[
8
]
:
=
Rijndael_S
[
0
,
T
shr
8
and
$FF
]
xor
Rijndael_S
[
0
,
T
shr
16
and
$FF
]
shl
8
xor
Rijndael_S
[
0
,
T
shr
24
]
shl
16
xor
Rijndael_S
[
0
,
T
and
$FF
]
shl
24
xor
P
[
0
]
xor
RCon
[
I
]
;
P
[
9
]
:
=
P
[
1
]
xor
P
[
8
]
;
P
[
10
]
:
=
P
[
2
]
xor
P
[
9
]
;
P
[
11
]
:
=
P
[
3
]
xor
P
[
10
]
;
if
I
=
6
then
Break
;
T
:
=
P
[
11
]
;
P
[
12
]
:
=
Rijndael_S
[
0
,
T
and
$FF
]
xor
Rijndael_S
[
0
,
T
shr
8
and
$FF
]
shl
8
xor
Rijndael_S
[
0
,
T
shr
16
and
$FF
]
shl
16
xor
Rijndael_S
[
0
,
T
shr
24
]
shl
24
xor
P
[
4
]
;
P
[
13
]
:
=
P
[
5
]
xor
P
[
12
]
;
P
[
14
]
:
=
P
[
6
]
xor
P
[
13
]
;
P
[
15
]
:
=
P
[
7
]
xor
P
[
14
]
;
P
:
=
@
P
[
8
]
;
end
;
end
;
end
;
procedure
BuildDecodeKey
;
var
P
:
PLongWord
;
I
:
Integer
;
begin
P
:
=
Pointer
(
PChar
(
FUser
)
+
FUserSize
shr
1
)
;
Move
(
FUser
^
,
P
^
,
FUserSize
shr
1
)
;
Inc
(
P
,
4
)
;
for
I
:
=
0
to
FRounds
*
4
-
5
do
begin
P
^
:
=
Rijndael_T
[
4
,
Rijndael_S
[
0
,
P
^
and
$FF
]
]
xor
Rijndael_T
[
5
,
Rijndael_S
[
0
,
P
^
shr
8
and
$FF
]
]
xor
Rijndael_T
[
6
,
Rijndael_S
[
0
,
P
^
shr
16
and
$FF
]
]
xor
Rijndael_T
[
7
,
Rijndael_S
[
0
,
P
^
shr
24
]
]
;
Inc
(
P
)
;
end
;
end
;
begin
if
Size <
=
16
then
FRounds
:
=
10
else
if
Size <
=
24
then
FRounds
:
=
12
else
FRounds
:
=
14
;
FillChar
(
FUser
^
,
32
,
0
)
;
Move
(
Key
,
FUser
^
,
Size
)
;
BuildEncodeKey
;
BuildDecodeKey
;
end
;
procedure
TCipher_Rijndael
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
P
:
PLongArray
;
I
:
Integer
;
A2
,
B2
,
C2
,
D2
:
LongWord
;
A1
,
B1
,
C1
,
D1
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
P
:
=
FUser
;
A1
:
=
PLongArray
(
Source
)
[
0
]
;
B1
:
=
PLongArray
(
Source
)
[
1
]
;
C1
:
=
PLongArray
(
Source
)
[
2
]
;
D1
:
=
PLongArray
(
Source
)
[
3
]
;
for
I
:
=
2
to
FRounds
do
begin
A2
:
=
A1
xor
P
[
0
]
;
B2
:
=
B1
xor
P
[
1
]
;
C2
:
=
C1
xor
P
[
2
]
;
D2
:
=
D1
xor
P
[
3
]
;
A1
:
=
Rijndael_T
[
0
,
A2
and
$FF
]
xor
Rijndael_T
[
1
,
B2
shr
8
and
$FF
]
xor
Rijndael_T
[
2
,
C2
shr
16
and
$FF
]
xor
Rijndael_T
[
3
,
D2
shr
24
]
;
B1
:
=
Rijndael_T
[
0
,
B2
and
$FF
]
xor
Rijndael_T
[
1
,
C2
shr
8
and
$FF
]
xor
Rijndael_T
[
2
,
D2
shr
16
and
$FF
]
xor
Rijndael_T
[
3
,
A2
shr
24
]
;
C1
:
=
Rijndael_T
[
0
,
C2
and
$FF
]
xor
Rijndael_T
[
1
,
D2
shr
8
and
$FF
]
xor
Rijndael_T
[
2
,
A2
shr
16
and
$FF
]
xor
Rijndael_T
[
3
,
B2
shr
24
]
;
D1
:
=
Rijndael_T
[
0
,
D2
and
$FF
]
xor
Rijndael_T
[
1
,
A2
shr
8
and
$FF
]
xor
Rijndael_T
[
2
,
B2
shr
16
and
$FF
]
xor
Rijndael_T
[
3
,
C2
shr
24
]
;
P
:
=
@
P
[
4
]
;
end
;
A2
:
=
A1
xor
P
[
0
]
;
B2
:
=
B1
xor
P
[
1
]
;
C2
:
=
C1
xor
P
[
2
]
;
D2
:
=
D1
xor
P
[
3
]
;
PLongArray
(
Dest
)
[
0
]
:
=
(
Rijndael_S
[
0
,
A2
and
$FF
]
or
Rijndael_S
[
0
,
B2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
0
,
C2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
0
,
D2
shr
24
]
shl
24
)
xor
P
[
4
]
;
PLongArray
(
Dest
)
[
1
]
:
=
(
Rijndael_S
[
0
,
B2
and
$FF
]
or
Rijndael_S
[
0
,
C2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
0
,
D2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
0
,
A2
shr
24
]
shl
24
)
xor
P
[
5
]
;
PLongArray
(
Dest
)
[
2
]
:
=
(
Rijndael_S
[
0
,
C2
and
$FF
]
or
Rijndael_S
[
0
,
D2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
0
,
A2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
0
,
B2
shr
24
]
shl
24
)
xor
P
[
6
]
;
PLongArray
(
Dest
)
[
3
]
:
=
(
Rijndael_S
[
0
,
D2
and
$FF
]
or
Rijndael_S
[
0
,
A2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
0
,
B2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
0
,
C2
shr
24
]
shl
24
)
xor
P
[
7
]
;
end
;
procedure
TCipher_Rijndael
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
P
:
PLongArray
;
I
:
Integer
;
A2
,
B2
,
C2
,
D2
:
LongWord
;
A1
,
B1
,
C1
,
D1
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
P
:
=
Pointer
(
PChar
(
FUser
)
+
FUserSize
shr
1
+
FRounds
*
16
)
;
A1
:
=
PLongArray
(
Source
)
[
0
]
;
B1
:
=
PLongArray
(
Source
)
[
1
]
;
C1
:
=
PLongArray
(
Source
)
[
2
]
;
D1
:
=
PLongArray
(
Source
)
[
3
]
;
for
I
:
=
2
to
FRounds
do
begin
A2
:
=
A1
xor
P
[
0
]
;
B2
:
=
B1
xor
P
[
1
]
;
C2
:
=
C1
xor
P
[
2
]
;
D2
:
=
D1
xor
P
[
3
]
;
A1
:
=
Rijndael_T
[
4
,
A2
and
$FF
]
xor
Rijndael_T
[
5
,
D2
shr
8
and
$FF
]
xor
Rijndael_T
[
6
,
C2
shr
16
and
$FF
]
xor
Rijndael_T
[
7
,
B2
shr
24
]
;
B1
:
=
Rijndael_T
[
4
,
B2
and
$FF
]
xor
Rijndael_T
[
5
,
A2
shr
8
and
$FF
]
xor
Rijndael_T
[
6
,
D2
shr
16
and
$FF
]
xor
Rijndael_T
[
7
,
C2
shr
24
]
;
C1
:
=
Rijndael_T
[
4
,
C2
and
$FF
]
xor
Rijndael_T
[
5
,
B2
shr
8
and
$FF
]
xor
Rijndael_T
[
6
,
A2
shr
16
and
$FF
]
xor
Rijndael_T
[
7
,
D2
shr
24
]
;
D1
:
=
Rijndael_T
[
4
,
D2
and
$FF
]
xor
Rijndael_T
[
5
,
C2
shr
8
and
$FF
]
xor
Rijndael_T
[
6
,
B2
shr
16
and
$FF
]
xor
Rijndael_T
[
7
,
A2
shr
24
]
;
Dec
(
PLongWord
(
P
)
,
4
)
;
end
;
A2
:
=
A1
xor
P
[
0
]
;
B2
:
=
B1
xor
P
[
1
]
;
C2
:
=
C1
xor
P
[
2
]
;
D2
:
=
D1
xor
P
[
3
]
;
Dec
(
PLongWord
(
P
)
,
4
)
;
PLongArray
(
Dest
)
[
0
]
:
=
(
Rijndael_S
[
1
,
A2
and
$FF
]
or
Rijndael_S
[
1
,
D2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
1
,
C2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
1
,
B2
shr
24
]
shl
24
)
xor
P
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
(
Rijndael_S
[
1
,
B2
and
$FF
]
or
Rijndael_S
[
1
,
A2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
1
,
D2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
1
,
C2
shr
24
]
shl
24
)
xor
P
[
1
]
;
PLongArray
(
Dest
)
[
2
]
:
=
(
Rijndael_S
[
1
,
C2
and
$FF
]
or
Rijndael_S
[
1
,
B2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
1
,
A2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
1
,
D2
shr
24
]
shl
24
)
xor
P
[
2
]
;
PLongArray
(
Dest
)
[
3
]
:
=
(
Rijndael_S
[
1
,
D2
and
$FF
]
or
Rijndael_S
[
1
,
C2
shr
8
and
$FF
]
shl
8
or
Rijndael_S
[
1
,
B2
shr
16
and
$FF
]
shl
16
or
Rijndael_S
[
1
,
A2
shr
24
]
shl
24
)
xor
P
[
3
]
;
end
;
// .TCipher_Square
class
function
TCipher_Square
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
9
*
4
*
2
*
SizeOf
(
LongWord
)
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Square
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
type
PSquare_Key
=
^
TSquare_Key
;
TSquare_Key
=
array
[
0
..
8
,
0
..
3
]
of
LongWord
;
var
E
,
D
:
PSquare_Key
;
S
,
T
,
R
:
LongWord
;
I
,
J
:
Integer
;
begin
E
:
=
FUser
;
D
:
=
FUser
;
Inc
(
D
)
;
Move
(
Key
,
E
^
,
Size
)
;
for
I
:
=
1
to
8
do
begin
T
:
=
E
[
I
-
1
,
3
]
;
T
:
=
T
shr
8
or
T
shl
24
;
E
[
I
,
0
]
:
=
E
[
I
-
1
,
0
]
xor
T
xor
1
shl
(
I
-
1
)
;
E
[
I
,
1
]
:
=
E
[
I
-
1
,
1
]
xor
E
[
I
,
0
]
;
E
[
I
,
2
]
:
=
E
[
I
-
1
,
2
]
xor
E
[
I
,
1
]
;
E
[
I
,
3
]
:
=
E
[
I
-
1
,
3
]
xor
E
[
I
,
2
]
;
D
[
8
-
I
,
0
]
:
=
E
[
I
,
0
]
;
D
[
8
-
I
,
1
]
:
=
E
[
I
,
1
]
;
D
[
8
-
I
,
2
]
:
=
E
[
I
,
2
]
;
D
[
8
-
I
,
3
]
:
=
E
[
I
,
3
]
;
for
J
:
=
0
to
3
do
begin
R
:
=
E
[
I
-
1
,
J
]
;
S
:
=
Square_PHI
[
R
and
$FF
]
;
T
:
=
Square_PHI
[
R
shr
8
and
$FF
]
;
T
:
=
T
shl
8
or
T
shr
24
;
S
:
=
S
xor
T
;
T
:
=
Square_PHI
[
R
shr
16
and
$FF
]
;
T
:
=
T
shl
16
or
T
shr
16
;
S
:
=
S
xor
T
;
T
:
=
Square_PHI
[
R
shr
24
]
;
T
:
=
T
shl
24
or
T
shr
8
;
S
:
=
S
xor
T
;
E
[
I
-
1
,
J
]
:
=
S
;
end
;
end
;
D
[
8
]
:
=
E
[
0
]
;
end
;
procedure
TCipher_Square
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Key
:
PLongArray
;
A
,
B
,
C
,
D
:
LongWord
;
AA
,
BB
,
CC
:
LongWord
;
I
:
Integer
;
begin
Key
:
=
FUser
;
A
:
=
PLongArray
(
Source
)
[
0
]
xor
Key
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
xor
Key
[
1
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
xor
Key
[
2
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
xor
Key
[
3
]
;
Key
:
=
@
Key
[
4
]
;
for
I
:
=
0
to
6
do
begin
AA
:
=
Square_TE
[
0
,
A
and
$FF
]
xor
Square_TE
[
1
,
B
and
$FF
]
xor
Square_TE
[
2
,
C
and
$FF
]
xor
Square_TE
[
3
,
D
and
$FF
]
xor
Key
[
0
]
;
BB
:
=
Square_TE
[
0
,
A
shr
8
and
$FF
]
xor
Square_TE
[
1
,
B
shr
8
and
$FF
]
xor
Square_TE
[
2
,
C
shr
8
and
$FF
]
xor
Square_TE
[
3
,
D
shr
8
and
$FF
]
xor
Key
[
1
]
;
CC
:
=
Square_TE
[
0
,
A
shr
16
and
$FF
]
xor
Square_TE
[
1
,
B
shr
16
and
$FF
]
xor
Square_TE
[
2
,
C
shr
16
and
$FF
]
xor
Square_TE
[
3
,
D
shr
16
and
$FF
]
xor
Key
[
2
]
;
D
:
=
Square_TE
[
0
,
A
shr
24
]
xor
Square_TE
[
1
,
B
shr
24
]
xor
Square_TE
[
2
,
C
shr
24
]
xor
Square_TE
[
3
,
D
shr
24
]
xor
Key
[
3
]
;
A
:
=
AA
;
B
:
=
BB
;
C
:
=
CC
;
Key
:
=
@
Key
[
4
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
LongWord
(
Square_SE
[
A
and
$FF
]
)
xor
LongWord
(
Square_SE
[
B
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SE
[
C
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SE
[
D
and
$FF
]
)
shl
24
xor
Key
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
LongWord
(
Square_SE
[
A
shr
8
and
$FF
]
)
xor
LongWord
(
Square_SE
[
B
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SE
[
C
shr
8
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SE
[
D
shr
8
and
$FF
]
)
shl
24
xor
Key
[
1
]
;
PLongArray
(
Dest
)
[
2
]
:
=
LongWord
(
Square_SE
[
A
shr
16
and
$FF
]
)
xor
LongWord
(
Square_SE
[
B
shr
16
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SE
[
C
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SE
[
D
shr
16
and
$FF
]
)
shl
24
xor
Key
[
2
]
;
PLongArray
(
Dest
)
[
3
]
:
=
LongWord
(
Square_SE
[
A
shr
24
]
)
xor
LongWord
(
Square_SE
[
B
shr
24
]
)
shl
8
xor
LongWord
(
Square_SE
[
C
shr
24
]
)
shl
16
xor
LongWord
(
Square_SE
[
D
shr
24
]
)
shl
24
xor
Key
[
3
]
;
end
;
procedure
TCipher_Square
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Key
:
PLongArray
;
A
,
B
,
C
,
D
:
LongWord
;
AA
,
BB
,
CC
:
LongWord
;
I
:
Integer
;
begin
Key
:
=
@
PLongArray
(
FUser
)
[
9
*
4
]
;
A
:
=
PLongArray
(
Source
)
[
0
]
xor
Key
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
xor
Key
[
1
]
;
C
:
=
PLongArray
(
Source
)
[
2
]
xor
Key
[
2
]
;
D
:
=
PLongArray
(
Source
)
[
3
]
xor
Key
[
3
]
;
Key
:
=
@
Key
[
4
]
;
for
I
:
=
0
to
6
do
begin
AA
:
=
Square_TD
[
0
,
A
and
$FF
]
xor
Square_TD
[
1
,
B
and
$FF
]
xor
Square_TD
[
2
,
C
and
$FF
]
xor
Square_TD
[
3
,
D
and
$FF
]
xor
Key
[
0
]
;
BB
:
=
Square_TD
[
0
,
A
shr
8
and
$FF
]
xor
Square_TD
[
1
,
B
shr
8
and
$FF
]
xor
Square_TD
[
2
,
C
shr
8
and
$FF
]
xor
Square_TD
[
3
,
D
shr
8
and
$FF
]
xor
Key
[
1
]
;
CC
:
=
Square_TD
[
0
,
A
shr
16
and
$FF
]
xor
Square_TD
[
1
,
B
shr
16
and
$FF
]
xor
Square_TD
[
2
,
C
shr
16
and
$FF
]
xor
Square_TD
[
3
,
D
shr
16
and
$FF
]
xor
Key
[
2
]
;
D
:
=
Square_TD
[
0
,
A
shr
24
]
xor
Square_TD
[
1
,
B
shr
24
]
xor
Square_TD
[
2
,
C
shr
24
]
xor
Square_TD
[
3
,
D
shr
24
]
xor
Key
[
3
]
;
A
:
=
AA
;
B
:
=
BB
;
C
:
=
CC
;
Key
:
=
@
Key
[
4
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
LongWord
(
Square_SD
[
A
and
$FF
]
)
xor
LongWord
(
Square_SD
[
B
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SD
[
C
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SD
[
D
and
$FF
]
)
shl
24
xor
Key
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
LongWord
(
Square_SD
[
A
shr
8
and
$FF
]
)
xor
LongWord
(
Square_SD
[
B
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SD
[
C
shr
8
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SD
[
D
shr
8
and
$FF
]
)
shl
24
xor
Key
[
1
]
;
PLongArray
(
Dest
)
[
2
]
:
=
LongWord
(
Square_SD
[
A
shr
16
and
$FF
]
)
xor
LongWord
(
Square_SD
[
B
shr
16
and
$FF
]
)
shl
8
xor
LongWord
(
Square_SD
[
C
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Square_SD
[
D
shr
16
and
$FF
]
)
shl
24
xor
Key
[
2
]
;
PLongArray
(
Dest
)
[
3
]
:
=
LongWord
(
Square_SD
[
A
shr
24
]
)
xor
LongWord
(
Square_SD
[
B
shr
24
]
)
shl
8
xor
LongWord
(
Square_SD
[
C
shr
24
]
)
shl
16
xor
LongWord
(
Square_SD
[
D
shr
24
]
)
shl
24
xor
Key
[
3
]
;
end
;
// .TCipher_SCOP
class
function
TCipher_SCOP
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
48
;
Result
.
BlockSize
:
=
4
;
Result
.
BufferSize
:
=
32
;
Result
.
UserSize
:
=
384
*
4
+
3
*
SizeOf
(
LongWord
)
;
Result
.
UserSave
:
=
True
;
end
;
procedure
TCipher_SCOP
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
Init_State
:
packed
record
Coef
:
array
[
0
..
7
,
0
..
3
]
of
Byte
;
X
:
array
[
0
..
3
]
of
LongWord
;
end
;
procedure
ExpandKey
;
var
P
:
PByteArray
;
I
,
C
:
Integer
;
begin
C
:
=
1
;
P
:
=
@
Init_State
;
Move
(
Key
,
P
^
,
Size
)
;
for
I
:
=
Size
to
47
do
P
[
I
]
:
=
P
[
I
-
Size
]
+
P
[
I
-
Size
+
1
]
;
for
I
:
=
0
to
31
do
if
P
[
I
]
=
0
then
begin
P
[
I
]
:
=
C
;
Inc
(
C
)
;
end
;
end
;
procedure
GP8
(
Data
:
PLongArray
)
;
var
I
,
I2
:
Integer
;
NewX
:
array
[
0
..
3
]
of
LongWord
;
X1
,
X2
,
X3
,
X4
:
LongWord
;
Y1
,
Y2
:
LongWord
;
begin
I
:
=
0
;
I2
:
=
0
;
while
I <
8
do
begin
X1
:
=
Init_State
.
X
[
I2
]
shr
16
;
X2
:
=
X1
*
X1
;
X3
:
=
X2
*
X1
;
X4
:
=
X3
*
X1
;
Y1
:
=
Init_State
.
Coef
[
I
]
[
0
]
*
X4
+
Init_State
.
Coef
[
I
]
[
1
]
*
X3
+
Init_State
.
Coef
[
I
]
[
2
]
*
X2
+
Init_State
.
Coef
[
I
]
[
3
]
*
X1
+
1
;
X1
:
=
Init_State
.
X
[
I2
]
and
$FFFF
;
X2
:
=
X1
*
X1
;
X3
:
=
X2
*
X1
;
X4
:
=
X3
*
X1
;
Y2
:
=
Init_State
.
Coef
[
I
+
1
]
[
0
]
*
X4
+
Init_State
.
Coef
[
I
+
2
]
[
1
]
*
X3
+
Init_State
.
Coef
[
I
+
3
]
[
2
]
*
X2
+
Init_State
.
Coef
[
I
+
4
]
[
3
]
*
X1
+
1
;
Data
[
I2
]
:
=
Y1
shl
16
or
Y2
and
$FFFF
;
NewX
[
I2
]
:
=
Y1
and
$FFFF0000
or
Y2
shr
16
;
Inc
(
I2
)
;
Inc
(
I
,
2
)
;
end
;
Init_State
.
X
[
0
]
:
=
NewX
[
0
]
shr
16
or
NewX
[
3
]
shl
16
;
Init_State
.
X
[
1
]
:
=
NewX
[
0
]
shl
16
or
NewX
[
1
]
shr
16
;
Init_State
.
X
[
2
]
:
=
NewX
[
1
]
shl
16
or
NewX
[
2
]
shr
16
;
Init_State
.
X
[
3
]
:
=
NewX
[
2
]
shl
16
or
NewX
[
3
]
shr
16
;
end
;
var
I
,
J
:
Integer
;
T
:
array
[
0
..
3
]
of
Integer
;
P
:
PLongArray
;
begin
FillChar
(
Init_State
,
SizeOf
(
Init_State
)
,
0
)
;
FillChar
(
T
,
SizeOf
(
T
)
,
0
)
;
P
:
=
Pointer
(
PChar
(
FUser
)
+
12
)
;
ExpandKey
;
for
I
:
=
0
to
7
do
GP8
(
@
T
)
;
for
I
:
=
0
to
11
do
begin
for
J
:
=
0
to
7
do
GP8
(
@
P
[
I
*
32
+
J
*
4
]
)
;
GP8
(
@
T
)
;
end
;
GP8
(
@
T
)
;
I
:
=
T
[
3
]
and
$7F
;
P
[
I
+
3
]
:
=
P
[
I
+
3
]
or
1
;
P
:
=
FUser
;
P
[
0
]
:
=
T
[
3
]
shr
24
and
$FF
;
P
[
1
]
:
=
T
[
3
]
shr
16
and
$FF
;
P
[
2
]
:
=
T
[
3
]
shr
8
and
$FF
;
ProtectBuffer
(
Init_State
,
SizeOf
(
Init_State
)
)
;
end
;
procedure
TCipher_SCOP
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
J
:
Byte
;
T2
,
T3
,
T1
:
LongWord
;
P
:
PLongArray
;
W
:
Integer
;
begin
P
:
=
FUser
;
I
:
=
P
[
0
]
;
J
:
=
P
[
1
]
;
T3
:
=
P
[
2
]
;
for
W
:
=
0
to
Size
div
4
-
1
do
begin
T1
:
=
P
[
J
+
3
+
128
]
;
Inc
(
J
,
T3
)
;
T2
:
=
P
[
J
+
3
+
128
]
;
PLongArray
(
Dest
)
[
W
]
:
=
PLongArray
(
Source
)
[
W
]
+
T1
+
T2
;
T3
:
=
T2
+
P
[
I
+
3
]
;
Inc
(
I
)
;
P
[
J
+
3
+
128
]
:
=
T3
;
Inc
(
J
,
T2
)
;
end
;
P
[
0
]
:
=
I
;
P
[
1
]
:
=
J
;
P
[
2
]
:
=
T3
;
end
;
procedure
TCipher_SCOP
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
J
:
Byte
;
T1
,
T2
,
T3
:
LongWord
;
P
:
PLongArray
;
W
:
Integer
;
begin
P
:
=
FUser
;
I
:
=
P
[
0
]
;
J
:
=
P
[
1
]
;
T3
:
=
P
[
2
]
;
for
W
:
=
0
to
Size
div
4
-
1
do
begin
T1
:
=
P
[
J
+
3
+
128
]
;
Inc
(
J
,
T3
)
;
T2
:
=
P
[
J
+
3
+
128
]
;
PLongArray
(
Dest
)
[
W
]
:
=
PLongArray
(
Source
)
[
W
]
-
T1
-
T2
;
T3
:
=
T2
+
P
[
I
+
3
]
;
Inc
(
I
)
;
P
[
J
+
3
+
128
]
:
=
T3
;
Inc
(
J
,
T2
)
;
end
;
P
[
0
]
:
=
I
;
P
[
1
]
:
=
J
;
P
[
2
]
:
=
T3
;
end
;
// .TCipher_Sapphire
type
PSapphireKey
=
^
TSapphireKey
;
TSapphireKey
=
packed
record
Cards
:
array
[
0
..
255
]
of
LongWord
;
Rotor
:
LongWord
;
Ratchet
:
LongWord
;
Avalanche
:
LongWord
;
Plain
:
LongWord
;
Cipher
:
LongWord
;
end
;
class
function
TCipher_Sapphire
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
1024
;
Result
.
BlockSize
:
=
1
;
Result
.
BufferSize
:
=
32
;
Result
.
UserSize
:
=
SizeOf
(
TSapphireKey
)
;
Result
.
UserSave
:
=
True
;
end
;
procedure
TCipher_Sapphire
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
Sum
:
Byte
;
P
:
Integer
;
function
KeyRand
(
Max
:
LongWord
)
:
Byte
;
var
I
,
M
:
LongWord
;
begin
Result
:
=
0
;
if
Max
=
0
then
Exit
;
I
:
=
0
;
M
:
=
1
;
while
M < Max
do
Inc
(
M
,
M
or
1
)
;
repeat
Inc
(
Sum
,
TByteArray
(
Key
)
[
P
]
)
;
Inc
(
P
)
;
if
P >
=
Size
then
begin
P
:
=
0
;
Inc
(
Sum
,
Size
)
;
end
;
Result
:
=
M
and
Sum
;
Inc
(
I
)
;
if
I >
11
then
Result
:
=
Result
mod
Max
;
until
Result <
=
Max
;
end
;
var
I
,
S
,
T
:
Integer
;
begin
with
PSapphireKey
(
FUser
)
^
do
if
Size <
=
0
then
begin
Rotor
:
=
1
;
Ratchet
:
=
3
;
Avalanche
:
=
5
;
Plain
:
=
7
;
Cipher
:
=
11
;
for
I
:
=
0
to
255
do
Cards
[
I
]
:
=
255
-
I
;
end
else
begin
for
I
:
=
0
to
255
do
Cards
[
I
]
:
=
I
;
P
:
=
0
;
Sum
:
=
0
;
for
I
:
=
255
downto
1
do
begin
S
:
=
KeyRand
(
I
)
;
T
:
=
Cards
[
I
]
;
Cards
[
I
]
:
=
Cards
[
S
]
;
Cards
[
S
]
:
=
T
;
end
;
Rotor
:
=
Cards
[
1
]
;
Ratchet
:
=
Cards
[
3
]
;
Avalanche
:
=
Cards
[
5
]
;
Plain
:
=
Cards
[
7
]
;
Cipher
:
=
Cards
[
Sum
]
;
end
;
end
;
procedure
TCipher_Sapphire
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
I
:
Integer
;
begin
with
PSapphireKey
(
FUser
)
^
do
for
I
:
=
0
to
Size
-
1
do
begin
Ratchet
:
=
(
Ratchet
+
Cards
[
Rotor
]
)
and
$FF
;
Rotor
:
=
(
Rotor
+
1
)
and
$FF
;
T
:
=
Cards
[
Cipher
]
;
Cards
[
Cipher
]
:
=
Cards
[
Ratchet
]
;
Cards
[
Ratchet
]
:
=
Cards
[
Plain
]
;
Cards
[
Plain
]
:
=
Cards
[
Rotor
]
;
Cards
[
Rotor
]
:
=
T
;
Avalanche
:
=
(
Avalanche
+
Cards
[
T
]
)
and
$FF
;
T
:
=
(
Cards
[
Plain
]
+
Cards
[
Cipher
]
+
Cards
[
Avalanche
]
)
and
$FF
;
Plain
:
=
PByteArray
(
Source
)
[
I
]
;
Cipher
:
=
Plain
xor
Cards
[
Cards
[
T
]
]
xor
Cards
[
(
Cards
[
Ratchet
]
+
Cards
[
Rotor
]
)
and
$FF
]
;
PByteArray
(
Dest
)
[
I
]
:
=
Cipher
;
end
;
end
;
procedure
TCipher_Sapphire
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
I
:
Integer
;
begin
with
PSapphireKey
(
FUser
)
^
do
for
I
:
=
0
to
Size
-
1
do
begin
Ratchet
:
=
(
Ratchet
+
Cards
[
Rotor
]
)
and
$FF
;
Rotor
:
=
(
Rotor
+
1
)
and
$FF
;
T
:
=
Cards
[
Cipher
]
;
Cards
[
Cipher
]
:
=
Cards
[
Ratchet
]
;
Cards
[
Ratchet
]
:
=
Cards
[
Plain
]
;
Cards
[
Plain
]
:
=
Cards
[
Rotor
]
;
Cards
[
Rotor
]
:
=
T
;
Avalanche
:
=
(
Avalanche
+
Cards
[
T
]
)
and
$FF
;
T
:
=
(
Cards
[
Plain
]
+
Cards
[
Cipher
]
+
Cards
[
Avalanche
]
)
and
$FF
;
Cipher
:
=
PByteArray
(
Source
)
[
I
]
;
Plain
:
=
Cipher
xor
Cards
[
Cards
[
T
]
]
xor
Cards
[
(
Cards
[
Ratchet
]
+
Cards
[
Rotor
]
)
and
$FF
]
;
PByteArray
(
Dest
)
[
I
]
:
=
Plain
;
end
;
end
;
// .DES
procedure
DES_Func
(
Source
,
Dest
,
Key
:
PLongArray
)
;
var
L
,
R
,
X
,
Y
,
I
:
LongWord
;
begin
L
:
=
SwapLong
(
Source
[
0
]
)
;
R
:
=
SwapLong
(
Source
[
1
]
)
;
X
:
=
(
L
shr
4
xor
R
)
and
$0F0F0F0F
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
shl
4
;
X
:
=
(
L
shr
16
xor
R
)
and
$0000FFFF
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
shl
16
;
X
:
=
(
R
shr
2
xor
L
)
and
$33333333
;
L
:
=
L
xor
X
;
R
:
=
R
xor
X
shl
2
;
X
:
=
(
R
shr
8
xor
L
)
and
$00FF00FF
;
L
:
=
L
xor
X
;
R
:
=
R
xor
X
shl
8
;
R
:
=
R
shl
1
or
R
shr
31
;
X
:
=
(
L
xor
R
)
and
$AAAAAAAA
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
;
L
:
=
L
shl
1
or
L
shr
31
;
for
I
:
=
0
to
7
do
begin
X
:
=
(
R
shl
28
or
R
shr
4
)
xor
Key
[
0
]
;
Y
:
=
R
xor
Key
[
1
]
;
L
:
=
L
xor
(
DES_Data
[
0
,
X
and
$3F
]
or
DES_Data
[
1
,
X
shr
8
and
$3F
]
or
DES_Data
[
2
,
X
shr
16
and
$3F
]
or
DES_Data
[
3
,
X
shr
24
and
$3F
]
or
DES_Data
[
4
,
Y
and
$3F
]
or
DES_Data
[
5
,
Y
shr
8
and
$3F
]
or
DES_Data
[
6
,
Y
shr
16
and
$3F
]
or
DES_Data
[
7
,
Y
shr
24
and
$3F
]
)
;
X
:
=
(
L
shl
28
or
L
shr
4
)
xor
Key
[
2
]
;
Y
:
=
L
xor
Key
[
3
]
;
R
:
=
R
xor
(
DES_Data
[
0
,
X
and
$3F
]
or
DES_Data
[
1
,
X
shr
8
and
$3F
]
or
DES_Data
[
2
,
X
shr
16
and
$3F
]
or
DES_Data
[
3
,
X
shr
24
and
$3F
]
or
DES_Data
[
4
,
Y
and
$3F
]
or
DES_Data
[
5
,
Y
shr
8
and
$3F
]
or
DES_Data
[
6
,
Y
shr
16
and
$3F
]
or
DES_Data
[
7
,
Y
shr
24
and
$3F
]
)
;
Key
:
=
@
Key
[
4
]
;
end
;
R
:
=
R
shl
31
or
R
shr
1
;
X
:
=
(
L
xor
R
)
and
$AAAAAAAA
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
;
L
:
=
L
shl
31
or
L
shr
1
;
X
:
=
(
L
shr
8
xor
R
)
and
$00FF00FF
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
shl
8
;
X
:
=
(
L
shr
2
xor
R
)
and
$33333333
;
R
:
=
R
xor
X
;
L
:
=
L
xor
X
shl
2
;
X
:
=
(
R
shr
16
xor
L
)
and
$0000FFFF
;
L
:
=
L
xor
X
;
R
:
=
R
xor
X
shl
16
;
X
:
=
(
R
shr
4
xor
L
)
and
$0F0F0F0F
;
L
:
=
L
xor
X
;
R
:
=
R
xor
X
shl
4
;
Dest
[
0
]
:
=
SwapLong
(
R
)
;
Dest
[
1
]
:
=
SwapLong
(
L
)
;
end
;
// .TCipher_1DES
class
function
TCipher_1DES
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
8
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
32
*
4
*
2
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_1DES
.
DoInitKey
(
const
Data
:
array
of
Byte
;
Key
:
PLongArray
;
Reverse
:
Boolean
)
;
const
ROT
:
array
[
0
..
15
]
of
Byte
=
(
1
,
2
,
4
,
6
,
8
,
10
,
12
,
14
,
15
,
17
,
19
,
21
,
23
,
25
,
27
,
28
)
;
var
I
,
J
,
L
,
M
,
N
:
LongWord
;
PC_M
,
PC_R
:
array
[
0
..
55
]
of
Byte
;
K
:
array
[
0
..
31
]
of
LongWord
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
for
I
:
=
0
to
55
do
if
Data
[
DES_PC1
[
I
]
shr
3
]
and
(
$80
shr
(
DES_PC1
[
I
]
and
$07
)
)
<>
0
then
PC_M
[
I
]
:
=
1
else
PC_M
[
I
]
:
=
0
;
for
I
:
=
0
to
15
do
begin
if
Reverse
then
M
:
=
(
15
-
I
)
shl
1
else
M
:
=
I
shl
1
;
N
:
=
M
+
1
;
for
J
:
=
0
to
27
do
begin
L
:
=
J
+
ROT
[
I
]
;
if
L <
28
then
PC_R
[
J
]
:
=
PC_M
[
L
]
else
PC_R
[
J
]
:
=
PC_M
[
L
-
28
]
;
end
;
for
J
:
=
28
to
55
do
begin
L
:
=
J
+
ROT
[
I
]
;
if
L <
56
then
PC_R
[
J
]
:
=
PC_M
[
L
]
else
PC_R
[
J
]
:
=
PC_M
[
L
-
28
]
;
end
;
L
:
=
$1000000
;
for
J
:
=
0
to
23
do
begin
L
:
=
L
shr
1
;
if
PC_R
[
DES_PC2
[
J
]
]
<>
0
then
K
[
M
]
:
=
K
[
M
]
or
L
;
if
PC_R
[
DES_PC2
[
J
+
24
]
]
<>
0
then
K
[
N
]
:
=
K
[
N
]
or
L
;
end
;
end
;
for
I
:
=
0
to
15
do
begin
M
:
=
I
shl
1
;
N
:
=
M
+
1
;
Key
[
0
]
:
=
K
[
M
]
and
$00FC0000
shl
6
or
K
[
M
]
and
$00000FC0
shl
10
or
K
[
N
]
and
$00FC0000
shr
10
or
K
[
N
]
and
$00000FC0
shr
6
;
Key
[
1
]
:
=
K
[
M
]
and
$0003F000
shl
12
or
K
[
M
]
and
$0000003F
shl
16
or
K
[
N
]
and
$0003F000
shr
4
or
K
[
N
]
and
$0000003F
;
Key
:
=
@
Key
[
2
]
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
ProtectBuffer
(
PC_M
,
SizeOf
(
PC_M
)
)
;
ProtectBuffer
(
PC_R
,
SizeOf
(
PC_R
)
)
;
end
;
procedure
TCipher_1DES
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
7
]
of
Byte
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
DoInitKey
(
K
,
FUser
,
False
)
;
DoInitKey
(
K
,
@
PLongArray
(
FUser
)
[
32
]
,
True
)
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_1DES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
FUser
)
;
end
;
procedure
TCipher_1DES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
32
]
)
;
end
;
// .TCipher_2DES
class
function
TCipher_2DES
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
32
*
4
*
2
*
2
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_2DES
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
15
]
of
Byte
;
P
:
PLongArray
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
P
:
=
FUser
;
DoInitKey
(
K
[
0
]
,
@
P
[
0
]
,
False
)
;
DoInitKey
(
K
[
8
]
,
@
P
[
32
]
,
True
)
;
DoInitKey
(
K
[
0
]
,
@
P
[
64
]
,
True
)
;
DoInitKey
(
K
[
8
]
,
@
P
[
96
]
,
False
)
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_2DES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
FUser
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
Source
,
Dest
,
FUser
)
;
end
;
procedure
TCipher_2DES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
64
]
)
;
end
;
// .TCipher_3DES
class
function
TCipher_3DES
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
24
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
32
*
4
*
2
*
3
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_3DES
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
23
]
of
Byte
;
P
:
PLongArray
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
P
:
=
FUser
;
DoInitKey
(
K
[
0
]
,
@
P
[
0
]
,
False
)
;
DoInitKey
(
K
[
8
]
,
@
P
[
32
]
,
True
)
;
DoInitKey
(
K
[
16
]
,
@
P
[
64
]
,
False
)
;
DoInitKey
(
K
[
16
]
,
@
P
[
96
]
,
True
)
;
DoInitKey
(
K
[
8
]
,
@
P
[
128
]
,
False
)
;
DoInitKey
(
K
[
0
]
,
@
P
[
160
]
,
True
)
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_3DES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
0
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
64
]
)
;
end
;
procedure
TCipher_3DES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
128
]
)
;
DES_Func
(
Source
,
Dest
,
@
PLongArray
(
FUser
)
[
160
]
)
;
end
;
// .TCipher_2DDES
class
function
TCipher_2DDES
.
Context
:
TCipherContext
;
begin
Result
:
=
inherited
Context
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
end
;
procedure
TCipher_2DDES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
FUser
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
FUser
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
FUser
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
FUser
)
;
end
;
procedure
TCipher_2DDES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
end
;
// .TCipher_3DDES
class
function
TCipher_3DDES
.
Context
:
TCipherContext
;
begin
Result
:
=
inherited
Context
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
end
;
procedure
TCipher_3DDES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
FUser
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
FUser
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
end
;
procedure
TCipher_3DDES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
128
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
128
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
160
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
160
]
)
;
end
;
// .TCipher_3TDES
class
function
TCipher_3TDES
.
Context
:
TCipherContext
;
begin
Result
:
=
inherited
Context
;
Result
.
BlockSize
:
=
24
;
Result
.
BufferSize
:
=
24
;
end
;
procedure
TCipher_3TDES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
FUser
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
FUser
)
;
DES_Func
(
@
S
[
4
]
,
@
D
[
4
]
,
FUser
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
T
:
=
D
[
3
]
;
D
[
3
]
:
=
D
[
4
]
;
D
[
4
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
DES_Func
(
@
D
[
4
]
,
@
D
[
4
]
,
@
PLongArray
(
FUser
)
[
32
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
T
:
=
D
[
3
]
;
D
[
3
]
:
=
D
[
4
]
;
D
[
4
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
DES_Func
(
@
D
[
4
]
,
@
D
[
4
]
,
@
PLongArray
(
FUser
)
[
64
]
)
;
end
;
procedure
TCipher_3TDES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
:
LongWord
;
S
:
PLongArray absolute Source
;
D
:
PLongArray absolute Dest
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
DES_Func
(
@
S
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
@
S
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
DES_Func
(
@
S
[
4
]
,
@
D
[
4
]
,
@
PLongArray
(
FUser
)
[
96
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
T
:
=
D
[
3
]
;
D
[
3
]
:
=
D
[
4
]
;
D
[
4
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
128
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
128
]
)
;
DES_Func
(
@
D
[
4
]
,
@
D
[
4
]
,
@
PLongArray
(
FUser
)
[
128
]
)
;
T
:
=
D
[
1
]
;
D
[
1
]
:
=
D
[
2
]
;
D
[
2
]
:
=
T
;
T
:
=
D
[
3
]
;
D
[
3
]
:
=
D
[
4
]
;
D
[
4
]
:
=
T
;
DES_Func
(
@
D
[
0
]
,
@
D
[
0
]
,
@
PLongArray
(
FUser
)
[
160
]
)
;
DES_Func
(
@
D
[
2
]
,
@
D
[
2
]
,
@
PLongArray
(
FUser
)
[
160
]
)
;
DES_Func
(
@
D
[
4
]
,
@
D
[
4
]
,
@
PLongArray
(
FUser
)
[
160
]
)
;
end
;
// .TCipher_3Way
type
P3Way_Key
=
^
T3Way_Key
;
T3Way_Key
=
packed
record
E_Key
:
array
[
0
..
2
]
of
LongWord
;
E_Data
:
array
[
0
..
11
]
of
LongWord
;
D_Key
:
array
[
0
..
2
]
of
LongWord
;
D_Data
:
array
[
0
..
11
]
of
LongWord
;
end
;
class
function
TCipher_3Way
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
12
;
Result
.
BlockSize
:
=
12
;
Result
.
BufferSize
:
=
12
;
Result
.
UserSize
:
=
SizeOf
(
T3Way_Key
)
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_3Way
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
procedure
RANDGenerate
(
Start
:
LongWord
;
var
P
:
Array
of
LongWord
)
;
var
I
:
Integer
;
begin
for
I
:
=
0
to
11
do
begin
P
[
I
]
:
=
Start
;
Start
:
=
Start
shl
1
;
if
Start
and
$10000
<>
0
then
Start
:
=
Start
xor
$11011
;
end
;
end
;
var
A0
,
A1
,
A2
:
LongWord
;
B0
,
B1
,
B2
:
LongWord
;
begin
with
P3Way_Key
(
FUser
)
^
do
begin
Move
(
Key
,
E_Key
,
Size
)
;
Move
(
Key
,
D_Key
,
Size
)
;
RANDGenerate
(
$0B0B
,
E_Data
)
;
RANDGenerate
(
$B1B1
,
D_Data
)
;
A0
:
=
D_Key
[
0
]
;
A1
:
=
D_Key
[
1
]
;
A2
:
=
D_Key
[
2
]
;
B0
:
=
A0
xor
A0
shr
16
xor
A1
shl
16
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
xor
A2
shr
8
xor
A0
shl
24
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
;
B1
:
=
A1
xor
A1
shr
16
xor
A2
shl
16
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
xor
A0
shr
8
xor
A1
shl
24
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
;
B2
:
=
A2
xor
A2
shr
16
xor
A0
shl
16
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
xor
A1
shr
8
xor
A2
shl
24
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
;
D_Key
[
2
]
:
=
SwapBits
(
B0
,
0
)
;
D_Key
[
1
]
:
=
SwapBits
(
B1
,
0
)
;
D_Key
[
0
]
:
=
SwapBits
(
B2
,
0
)
;
end
;
end
;
procedure
TCipher_3Way
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
A0
,
A1
,
A2
:
LongWord
;
B0
,
B1
,
B2
:
LongWord
;
K0
,
K1
,
K2
:
LongWord
;
E
:
PLongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
with
P3Way_Key
(
FUser
)
^
do
begin
K0
:
=
E_Key
[
0
]
;
K1
:
=
E_Key
[
1
]
;
K2
:
=
E_Key
[
2
]
;
E
:
=
@
E_Data
;
end
;
A0
:
=
PLongArray
(
Source
)
[
0
]
;
A1
:
=
PLongArray
(
Source
)
[
1
]
;
A2
:
=
PLongArray
(
Source
)
[
2
]
;
for
I
:
=
0
to
10
do
begin
A0
:
=
A0
xor
K0
xor
E
^
shl
16
;
A1
:
=
A1
xor
K1
;
A2
:
=
A2
xor
K2
xor
E
^
;
Inc
(
E
)
;
B0
:
=
A0
xor
A0
shr
16
xor
A1
shl
16
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
xor
A2
shr
8
xor
A0
shl
24
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
;
B1
:
=
A1
xor
A1
shr
16
xor
A2
shl
16
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
xor
A0
shr
8
xor
A1
shl
24
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
;
B2
:
=
A2
xor
A2
shr
16
xor
A0
shl
16
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
xor
A1
shr
8
xor
A2
shl
24
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
;
B0
:
=
B0
shr
10
or
B0
shl
22
;
B2
:
=
B2
shl
1
or
B2
shr
31
;
A0
:
=
B0
xor
(
B1
or
not
B2
)
;
A1
:
=
B1
xor
(
B2
or
not
B0
)
;
A2
:
=
B2
xor
(
B0
or
not
B1
)
;
A0
:
=
A0
shl
1
or
A0
shr
31
;
A2
:
=
A2
shr
10
or
A2
shl
22
;
end
;
A0
:
=
A0
xor
K0
xor
E
^
shl
16
;
A1
:
=
A1
xor
K1
;
A2
:
=
A2
xor
K2
xor
E
^
;
PLongArray
(
Dest
)
[
0
]
:
=
A0
xor
A0
shr
16
xor
A1
shl
16
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
xor
A2
shr
8
xor
A0
shl
24
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
;
PLongArray
(
Dest
)
[
1
]
:
=
A1
xor
A1
shr
16
xor
A2
shl
16
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
xor
A0
shr
8
xor
A1
shl
24
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
;
PLongArray
(
Dest
)
[
2
]
:
=
A2
xor
A2
shr
16
xor
A0
shl
16
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
xor
A1
shr
8
xor
A2
shl
24
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
;
end
;
procedure
TCipher_3Way
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
A0
,
A1
,
A2
:
LongWord
;
B0
,
B1
,
B2
:
LongWord
;
K0
,
K1
,
K2
:
LongWord
;
E
:
PLongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
with
P3Way_Key
(
FUser
)
^
do
begin
K0
:
=
D_Key
[
0
]
;
K1
:
=
D_Key
[
1
]
;
K2
:
=
D_Key
[
2
]
;
E
:
=
@
D_Data
;
end
;
A0
:
=
SwapBits
(
PLongArray
(
Source
)
[
2
]
,
0
)
;
A1
:
=
SwapBits
(
PLongArray
(
Source
)
[
1
]
,
0
)
;
A2
:
=
SwapBits
(
PLongArray
(
Source
)
[
0
]
,
0
)
;
for
I
:
=
0
to
10
do
begin
A0
:
=
A0
xor
K0
xor
E
^
shl
16
;
A1
:
=
A1
xor
K1
;
A2
:
=
A2
xor
K2
xor
E
^
;
Inc
(
E
)
;
B0
:
=
A0
xor
A0
shr
16
xor
A1
shl
16
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
xor
A2
shr
8
xor
A0
shl
24
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
;
B1
:
=
A1
xor
A1
shr
16
xor
A2
shl
16
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
xor
A0
shr
8
xor
A1
shl
24
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
;
B2
:
=
A2
xor
A2
shr
16
xor
A0
shl
16
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
xor
A1
shr
8
xor
A2
shl
24
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
;
B0
:
=
B0
shr
10
or
B0
shl
22
;
B2
:
=
B2
shl
1
or
B2
shr
31
;
A0
:
=
B0
xor
(
B1
or
not
B2
)
;
A1
:
=
B1
xor
(
B2
or
not
B0
)
;
A2
:
=
B2
xor
(
B0
or
not
B1
)
;
A0
:
=
A0
shl
1
or
A0
shr
31
;
A2
:
=
A2
shr
10
or
A2
shl
22
;
end
;
A0
:
=
A0
xor
K0
xor
E
^
shl
16
;
A1
:
=
A1
xor
K1
;
A2
:
=
A2
xor
K2
xor
E
^
;
B0
:
=
A0
xor
A0
shr
16
xor
A1
shl
16
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
xor
A2
shr
8
xor
A0
shl
24
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
;
B1
:
=
A1
xor
A1
shr
16
xor
A2
shl
16
xor
A2
shr
16
xor
A0
shl
16
xor
A2
shr
24
xor
A0
shl
8
xor
A0
shr
8
xor
A1
shl
24
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
;
B2
:
=
A2
xor
A2
shr
16
xor
A0
shl
16
xor
A0
shr
16
xor
A1
shl
16
xor
A0
shr
24
xor
A1
shl
8
xor
A1
shr
8
xor
A2
shl
24
xor
A1
shr
16
xor
A2
shl
16
xor
A1
shr
24
xor
A2
shl
8
;
PLongArray
(
Dest
)
[
2
]
:
=
SwapBits
(
B0
,
0
)
;
PLongArray
(
Dest
)
[
1
]
:
=
SwapBits
(
B1
,
0
)
;
PLongArray
(
Dest
)
[
0
]
:
=
SwapBits
(
B2
,
0
)
;
end
;
// .TCipher_Cast128
class
function
TCipher_Cast128
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
128
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Cast128
.
SetRounds
(
Value
:
Integer
)
;
begin
if
Value <> FRounds
then
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
if
(
FState <> csNew
)
and
(
Value <
=
0
)
then
Value
:
=
16
;
FRounds
:
=
Value
;
end
;
end
;
procedure
TCipher_Cast128
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
Z
,
X
,
T
:
array
[
0
..
3
]
of
LongWord
;
K
:
PLongArray
;
I
:
LongWord
;
begin
if
FRounds <
=
0
then
if
Size <
=
10
then
FRounds
:
=
12
else
FRounds
:
=
16
;
K
:
=
FUser
;
FillChar
(
X
,
SizeOf
(
X
)
,
0
)
;
Move
(
Key
,
X
,
Size
)
;
SwapLongBuffer
(
X
,
X
,
4
)
;
I
:
=
0
;
while
I <
32
do
begin
if
I
and
4
=
0
then
begin
Z
[
0
]
:
=
X
[
0
]
xor
Cast128_Key
[
0
,
X
[
3
]
shr
16
and
$FF
]
xor
Cast128_Key
[
1
,
X
[
3
]
and
$FF
]
xor
Cast128_Key
[
2
,
X
[
3
]
shr
24
]
xor
Cast128_Key
[
3
,
X
[
3
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
X
[
2
]
shr
24
]
;
T
[
0
]
:
=
Z
[
0
]
;
Z
[
1
]
:
=
X
[
2
]
xor
Cast128_Key
[
0
,
Z
[
0
]
shr
24
]
xor
Cast128_Key
[
1
,
Z
[
0
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
Z
[
0
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
Z
[
0
]
and
$FF
]
xor
Cast128_Key
[
3
,
X
[
2
]
shr
8
and
$FF
]
;
T
[
1
]
:
=
Z
[
1
]
;
Z
[
2
]
:
=
X
[
3
]
xor
Cast128_Key
[
0
,
Z
[
1
]
and
$FF
]
xor
Cast128_Key
[
1
,
Z
[
1
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
Z
[
1
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
Z
[
1
]
shr
24
]
xor
Cast128_Key
[
0
,
X
[
2
]
shr
16
and
$FF
]
;
T
[
2
]
:
=
Z
[
2
]
;
Z
[
3
]
:
=
X
[
1
]
xor
Cast128_Key
[
0
,
Z
[
2
]
shr
8
and
$FF
]
xor
Cast128_Key
[
1
,
Z
[
2
]
shr
16
and
$FF
]
xor
Cast128_Key
[
2
,
Z
[
2
]
and
$FF
]
xor
Cast128_Key
[
3
,
Z
[
2
]
shr
24
]
xor
Cast128_Key
[
1
,
X
[
2
]
and
$FF
]
;
T
[
3
]
:
=
Z
[
3
]
;
end
else
begin
X
[
0
]
:
=
Z
[
2
]
xor
Cast128_Key
[
0
,
Z
[
1
]
shr
16
and
$FF
]
xor
Cast128_Key
[
1
,
Z
[
1
]
and
$FF
]
xor
Cast128_Key
[
2
,
Z
[
1
]
shr
24
]
xor
Cast128_Key
[
3
,
Z
[
1
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
Z
[
0
]
shr
24
]
;
T
[
0
]
:
=
X
[
0
]
;
X
[
1
]
:
=
Z
[
0
]
xor
Cast128_Key
[
0
,
X
[
0
]
shr
24
]
xor
Cast128_Key
[
1
,
X
[
0
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
X
[
0
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
X
[
0
]
and
$FF
]
xor
Cast128_Key
[
3
,
Z
[
0
]
shr
8
and
$FF
]
;
T
[
1
]
:
=
X
[
1
]
;
X
[
2
]
:
=
Z
[
1
]
xor
Cast128_Key
[
0
,
X
[
1
]
and
$FF
]
xor
Cast128_Key
[
1
,
X
[
1
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
X
[
1
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
X
[
1
]
shr
24
]
xor
Cast128_Key
[
0
,
Z
[
0
]
shr
16
and
$FF
]
;
T
[
2
]
:
=
X
[
2
]
;
X
[
3
]
:
=
Z
[
3
]
xor
Cast128_Key
[
0
,
X
[
2
]
shr
8
and
$FF
]
xor
Cast128_Key
[
1
,
X
[
2
]
shr
16
and
$FF
]
xor
Cast128_Key
[
2
,
X
[
2
]
and
$FF
]
xor
Cast128_Key
[
3
,
X
[
2
]
shr
24
]
xor
Cast128_Key
[
1
,
Z
[
0
]
and
$FF
]
;
T
[
3
]
:
=
X
[
3
]
;
end
;
case
I
and
12
of
0
,
12
:
begin
K
[
I
+
0
]
:
=
Cast128_Key
[
0
,
T
[
2
]
shr
24
]
xor
Cast128_Key
[
1
,
T
[
2
]
shr
16
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
1
]
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
1
]
shr
8
and
$FF
]
;
K
[
I
+
1
]
:
=
Cast128_Key
[
0
,
T
[
2
]
shr
8
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
2
]
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
1
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
1
]
shr
24
]
;
K
[
I
+
2
]
:
=
Cast128_Key
[
0
,
T
[
3
]
shr
24
]
xor
Cast128_Key
[
1
,
T
[
3
]
shr
16
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
0
]
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
0
]
shr
8
and
$FF
]
;
K
[
I
+
3
]
:
=
Cast128_Key
[
0
,
T
[
3
]
shr
8
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
3
]
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
0
]
shr
16
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
0
]
shr
24
]
;
end
;
4
,
8
:
begin
K
[
I
+
0
]
:
=
Cast128_Key
[
0
,
T
[
0
]
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
0
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
3
]
shr
24
]
xor
Cast128_Key
[
3
,
T
[
3
]
shr
16
and
$FF
]
;
K
[
I
+
1
]
:
=
Cast128_Key
[
0
,
T
[
0
]
shr
16
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
0
]
shr
24
]
xor
Cast128_Key
[
2
,
T
[
3
]
shr
8
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
3
]
and
$FF
]
;
K
[
I
+
2
]
:
=
Cast128_Key
[
0
,
T
[
1
]
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
1
]
shr
8
and
$FF
]
xor
Cast128_Key
[
2
,
T
[
2
]
shr
24
]
xor
Cast128_Key
[
3
,
T
[
2
]
shr
16
and
$FF
]
;
K
[
I
+
3
]
:
=
Cast128_Key
[
0
,
T
[
1
]
shr
16
and
$FF
]
xor
Cast128_Key
[
1
,
T
[
1
]
shr
24
]
xor
Cast128_Key
[
2
,
T
[
2
]
shr
8
and
$FF
]
xor
Cast128_Key
[
3
,
T
[
2
]
and
$FF
]
;
end
;
end
;
case
I
and
12
of
0
:
begin
K
[
I
+
0
]
:
=
K
[
I
+
0
]
xor
Cast128_Key
[
0
,
Z
[
0
]
shr
8
and
$FF
]
;
K
[
I
+
1
]
:
=
K
[
I
+
1
]
xor
Cast128_Key
[
1
,
Z
[
1
]
shr
8
and
$FF
]
;
K
[
I
+
2
]
:
=
K
[
I
+
2
]
xor
Cast128_Key
[
2
,
Z
[
2
]
shr
16
and
$FF
]
;
K
[
I
+
3
]
:
=
K
[
I
+
3
]
xor
Cast128_Key
[
3
,
Z
[
3
]
shr
24
]
;
end
;
4
:
begin
K
[
I
+
0
]
:
=
K
[
I
+
0
]
xor
Cast128_Key
[
0
,
X
[
2
]
shr
24
]
;
K
[
I
+
1
]
:
=
K
[
I
+
1
]
xor
Cast128_Key
[
1
,
X
[
3
]
shr
16
and
$FF
]
;
K
[
I
+
2
]
:
=
K
[
I
+
2
]
xor
Cast128_Key
[
2
,
X
[
0
]
and
$FF
]
;
K
[
I
+
3
]
:
=
K
[
I
+
3
]
xor
Cast128_Key
[
3
,
X
[
1
]
and
$FF
]
;
end
;
8
:
begin
K
[
I
+
0
]
:
=
K
[
I
+
0
]
xor
Cast128_Key
[
0
,
Z
[
2
]
shr
16
and
$FF
]
;
K
[
I
+
1
]
:
=
K
[
I
+
1
]
xor
Cast128_Key
[
1
,
Z
[
3
]
shr
24
]
;
K
[
I
+
2
]
:
=
K
[
I
+
2
]
xor
Cast128_Key
[
2
,
Z
[
0
]
shr
8
and
$FF
]
;
K
[
I
+
3
]
:
=
K
[
I
+
3
]
xor
Cast128_Key
[
3
,
Z
[
1
]
shr
8
and
$FF
]
;
end
;
12
:
begin
K
[
I
+
0
]
:
=
K
[
I
+
0
]
xor
Cast128_Key
[
0
,
X
[
0
]
and
$FF
]
;
K
[
I
+
1
]
:
=
K
[
I
+
1
]
xor
Cast128_Key
[
1
,
X
[
1
]
and
$FF
]
;
K
[
I
+
2
]
:
=
K
[
I
+
2
]
xor
Cast128_Key
[
2
,
X
[
2
]
shr
24
]
;
K
[
I
+
3
]
:
=
K
[
I
+
3
]
xor
Cast128_Key
[
3
,
X
[
3
]
shr
16
and
$FF
]
;
end
;
end
;
if
I >
=
16
then
begin
K
[
I
+
0
]
:
=
K
[
I
+
0
]
and
$1F
;
K
[
I
+
1
]
:
=
K
[
I
+
1
]
and
$1F
;
K
[
I
+
2
]
:
=
K
[
I
+
2
]
and
$1F
;
K
[
I
+
3
]
:
=
K
[
I
+
3
]
and
$1F
;
end
;
Inc
(
I
,
4
)
;
end
;
ProtectBuffer
(
X
,
SizeOf
(
X
)
)
;
ProtectBuffer
(
Z
,
SizeOf
(
Z
)
)
;
ProtectBuffer
(
T
,
SizeOf
(
T
)
)
;
end
;
procedure
TCipher_Cast128
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
,
I
,
A
,
B
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
FUser
;
A
:
=
SwapLong
(
PLongArray
(
Source
)
[
0
]
)
;
B
:
=
SwapLong
(
PLongArray
(
Source
)
[
1
]
)
;
for
I
:
=
0
to
2
do
begin
T
:
=
K
[
0
]
+
B
;
T
:
=
T
shl
K
[
16
]
or
T
shr
(
32
-
K
[
16
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
xor
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
xor
A
;
T
:
=
T
shl
K
[
17
]
or
T
shr
(
32
-
K
[
17
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
-
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
-
B
;
T
:
=
T
shl
K
[
18
]
or
T
shr
(
32
-
K
[
18
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
+
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
3
]
+
A
;
T
:
=
T
shl
K
[
19
]
or
T
shr
(
32
-
K
[
19
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
xor
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast128_Data
[
3
,
T
and
$FF
]
)
;
if
I
=
2
then
Break
;
T
:
=
K
[
4
]
xor
B
;
T
:
=
T
shl
K
[
20
]
or
T
shr
(
32
-
K
[
20
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
-
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
5
]
-
A
;
T
:
=
T
shl
K
[
21
]
or
T
shr
(
32
-
K
[
21
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
+
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast128_Data
[
3
,
T
and
$FF
]
)
;
if
(
I
=
1
)
and
(
FRounds <
=
12
)
then
Break
;
K
:
=
@
K
[
6
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
SwapLong
(
B
)
;
PLongArray
(
Dest
)
[
1
]
:
=
SwapLong
(
A
)
;
end
;
procedure
TCipher_Cast128
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
T
,
I
,
A
,
B
:
LongWord
;
K
:
PLongArray
;
label
Start
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
12
]
;
B
:
=
SwapLong
(
PLongArray
(
Source
)
[
0
]
)
;
A
:
=
SwapLong
(
PLongArray
(
Source
)
[
1
]
)
;
I
:
=
2
;
if
FRounds <
=
12
then
Dec
(
PLongWord
(
K
)
,
6
)
else
goto
Start
;
while
I >
0
do
begin
Dec
(
I
)
;
T
:
=
K
[
5
]
-
A
;
T
:
=
T
shl
K
[
21
]
or
T
shr
(
32
-
K
[
21
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
+
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
4
]
xor
B
;
T
:
=
T
shl
K
[
20
]
or
T
shr
(
32
-
K
[
20
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
-
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast128_Data
[
3
,
T
and
$FF
]
)
;
Start
:
T
:
=
K
[
3
]
+
A
;
T
:
=
T
shl
K
[
19
]
or
T
shr
(
32
-
K
[
19
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
xor
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
2
]
-
B
;
T
:
=
T
shl
K
[
18
]
or
T
shr
(
32
-
K
[
18
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
+
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
xor
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
-
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
1
]
xor
A
;
T
:
=
T
shl
K
[
17
]
or
T
shr
(
32
-
K
[
17
]
)
;
B
:
=
B
xor
(
Cast128_Data
[
0
,
T
shr
24
]
-
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
+
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
xor
Cast128_Data
[
3
,
T
and
$FF
]
)
;
T
:
=
K
[
0
]
+
B
;
T
:
=
T
shl
K
[
16
]
or
T
shr
(
32
-
K
[
16
]
)
;
A
:
=
A
xor
(
Cast128_Data
[
0
,
T
shr
24
]
xor
Cast128_Data
[
1
,
T
shr
16
and
$FF
]
-
Cast128_Data
[
2
,
T
shr
8
and
$FF
]
+
Cast128_Data
[
3
,
T
and
$FF
]
)
;
Dec
(
PLongWord
(
K
)
,
6
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
SwapLong
(
A
)
;
PLongArray
(
Dest
)
[
1
]
:
=
SwapLong
(
B
)
;
end
;
// .TCipher_Gost
class
function
TCipher_Gost
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
32
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
32
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Gost
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
begin
Move
(
Key
,
FUser
^
,
Size
)
;
end
;
procedure
TCipher_Gost
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
A
,
B
,
T
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
FUser
;
A
:
=
PLongArray
(
Source
)
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
;
for
I
:
=
0
to
11
do
begin
if
I
and
3
=
0
then
K
:
=
FUser
;
T
:
=
A
+
K
[
0
]
;
B
:
=
B
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
T
:
=
B
+
K
[
1
]
;
A
:
=
A
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
K
:
=
@
K
[
2
]
;
end
;
K
:
=
@
PLongArray
(
FUser
)
[
6
]
;
for
I
:
=
0
to
3
do
begin
T
:
=
A
+
K
[
1
]
;
B
:
=
B
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
T
:
=
B
+
K
[
0
]
;
A
:
=
A
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
Dec
(
PLongWord
(
K
)
,
2
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
B
;
PLongArray
(
Dest
)
[
1
]
:
=
A
;
end
;
procedure
TCipher_Gost
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
A
,
B
,
T
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
A
:
=
PLongArray
(
Source
)
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
;
K
:
=
FUser
;
for
I
:
=
0
to
3
do
begin
T
:
=
A
+
K
[
0
]
;
B
:
=
B
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
T
:
=
B
+
K
[
1
]
;
A
:
=
A
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
K
:
=
@
K
[
2
]
;
end
;
for
I
:
=
0
to
11
do
begin
if
I
and
3
=
0
then
K
:
=
@
PLongArray
(
FUser
)
[
6
]
;
T
:
=
A
+
K
[
1
]
;
B
:
=
B
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
T
:
=
B
+
K
[
0
]
;
A
:
=
A
xor
Gost_Data
[
0
,
T
and
$FF
]
xor
Gost_Data
[
1
,
T
shr
8
and
$FF
]
xor
Gost_Data
[
2
,
T
shr
16
and
$FF
]
xor
Gost_Data
[
3
,
T
shr
24
]
;
Dec
(
PLongWord
(
K
)
,
2
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
B
;
PLongArray
(
Dest
)
[
1
]
:
=
A
;
end
;
// .TCipher_Misty
class
function
TCipher_Misty
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
128
;
Result
.
UserSave
:
=
False
;
end
;
function
Misty_I
(
Value
,
Key
:
LongWord
)
:
LongWord
;
begin
Result
:
=
Misty_Data9
[
Value
shr
7
and
$1FF
]
xor
(
Value
and
$7F
)
;
Value
:
=
(
Misty_Data7
[
Value
and
$7F
]
xor
Result
and
$7F
)
xor
(
Key
shr
9
and
$7F
)
;
Result
:
=
Misty_Data9
[
Result
xor
(
Key
and
$1FF
)
]
xor
Value
or
Value
shl
9
;
end
;
function
Misty_O
(
Value
,
K
:
LongWord
;
Key
:
PLongArray
)
:
LongWord
;
begin
Result
:
=
Misty_I
(
(
Value
shr
16
)
xor
Key
[
K
]
,
Key
[
(
K
+
5
)
and
7
+
8
]
)
xor
(
Value
and
$FFFF
)
;
Value
:
=
Misty_I
(
(
Value
and
$FFFF
)
xor
Key
[
(
K
+
2
)
and
7
]
,
Key
[
(
K
+
1
)
and
7
+
8
]
)
xor
Result
;
Result
:
=
Misty_I
(
Result
xor
Key
[
(
K
+
7
)
and
7
]
,
Key
[
(
K
+
3
)
and
7
+
8
]
)
xor
Value
;
Result
:
=
Result
or
(
Value
xor
Key
[
(
k
+
4
)
and
7
]
)
shl
16
;
end
;
function
Misty_E
(
Value
,
K
:
LongWord
;
Key
:
PLongArray
)
:
LongWord
;
begin
Result
:
=
Value
shr
16
;
Value
:
=
Value
and
$FFFF
;
if
K
and
1
<>
0
then
begin
K
:
=
K
shr
1
;
Value
:
=
Value
xor
(
Result
and
Key
[
(
K
+
2
)
and
7
+
8
]
)
;
Result
:
=
Result
xor
(
Value
or
Key
[
(
K
+
4
)
and
7
]
)
;
end
else
begin
K
:
=
K
shr
1
;
Value
:
=
Value
xor
(
Result
and
Key
[
K
]
)
;
Result
:
=
Result
xor
(
Value
or
Key
[
(
K
+
6
)
and
7
+
8
]
)
;
end
;
Result
:
=
(
Result
shl
16
)
or
Value
;
end
;
function
Misty_D
(
Value
,
K
:
LongWord
;
Key
:
PLongArray
)
:
LongWord
;
begin
Result
:
=
Value
shr
16
;
Value
:
=
Value
and
$FFFF
;
if
K
and
1
<>
0
then
begin
K
:
=
K
shr
1
;
Result
:
=
Result
xor
(
Value
or
Key
[
(
K
+
4
)
and
7
]
)
;
Value
:
=
Value
xor
(
Result
and
Key
[
(
K
+
2
)
and
7
+
8
]
)
;
end
else
begin
K
:
=
K
shr
1
;
Result
:
=
Result
xor
(
Value
or
Key
[
(
K
+
6
)
and
7
+
8
]
)
;
Value
:
=
Value
xor
(
Result
and
Key
[
K
]
)
;
end
;
Result
:
=
(
Result
shl
16
)
or
Value
;
end
;
procedure
TCipher_Misty
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
15
]
of
Byte
;
D
:
PLongArray
;
I
:
Integer
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
D
:
=
FUser
;
for
I
:
=
0
to
7
do
D
[
I
]
:
=
K
[
I
*
2
]
*
256
+
K
[
I
*
2
+
1
]
;
for
I
:
=
0
to
7
do
begin
D
[
I
+
8
]
:
=
Misty_I
(
D
[
I
]
,
D
[
(
I
+
1
)
and
7
]
)
;
D
[
I
+
16
]
:
=
D
[
I
+
8
]
and
$1FF
;
D
[
I
+
24
]
:
=
D
[
I
+
8
]
shr
9
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_Misty
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
A
,
B
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
A
:
=
PLongArray
(
Source
)
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
;
A
:
=
Misty_E
(
A
,
0
,
FUser
)
;
B
:
=
Misty_E
(
B
,
1
,
FUser
)
xor
Misty_O
(
A
,
0
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
1
,
FUser
)
;
A
:
=
Misty_E
(
A
,
2
,
FUser
)
;
B
:
=
Misty_E
(
B
,
3
,
FUser
)
xor
Misty_O
(
A
,
2
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
3
,
FUser
)
;
A
:
=
Misty_E
(
A
,
4
,
FUser
)
;
B
:
=
Misty_E
(
B
,
5
,
FUser
)
xor
Misty_O
(
A
,
4
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
5
,
FUser
)
;
A
:
=
Misty_E
(
A
,
6
,
FUser
)
;
B
:
=
Misty_E
(
B
,
7
,
FUser
)
xor
Misty_O
(
A
,
6
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
7
,
FUser
)
;
PLongArray
(
Dest
)
[
0
]
:
=
Misty_E
(
B
,
9
,
FUser
)
;
PLongArray
(
Dest
)
[
1
]
:
=
Misty_E
(
A
,
8
,
FUser
)
;
end
;
procedure
TCipher_Misty
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
A
,
B
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
B
:
=
Misty_D
(
PLongArray
(
Source
)
[
0
]
,
9
,
FUser
)
;
A
:
=
Misty_D
(
PLongArray
(
Source
)
[
1
]
,
8
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
7
,
FUser
)
;
B
:
=
Misty_D
(
B
xor
Misty_O
(
A
,
6
,
FUser
)
,
7
,
FUser
)
;
A
:
=
Misty_D
(
A
,
6
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
5
,
FUser
)
;
B
:
=
Misty_D
(
B
xor
Misty_O
(
A
,
4
,
FUser
)
,
5
,
FUser
)
;
A
:
=
Misty_D
(
A
,
4
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
3
,
FUser
)
;
B
:
=
Misty_D
(
B
xor
Misty_O
(
A
,
2
,
FUser
)
,
3
,
FUser
)
;
A
:
=
Misty_D
(
A
,
2
,
FUser
)
;
A
:
=
A
xor
Misty_O
(
B
,
1
,
FUser
)
;
PLongArray
(
Dest
)
[
0
]
:
=
Misty_D
(
A
,
0
,
FUser
)
;
PLongArray
(
Dest
)
[
1
]
:
=
Misty_D
(
B
xor
Misty_O
(
A
,
0
,
FUser
)
,
1
,
FUser
)
;
end
;
// .TCipher_NewDES
class
function
TCipher_NewDES
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
15
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
60
*
2
;
Result
.
UserSave
:
=
True
;
end
;
procedure
TCipher_NewDES
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
14
]
of
Byte
;
E
:
PByteArray
;
I
:
Integer
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
E
:
=
FUser
;
Move
(
K
,
E
[
0
]
,
15
)
;
Move
(
K
,
E
[
15
]
,
15
)
;
Move
(
K
,
E
[
30
]
,
15
)
;
Move
(
K
,
E
[
45
]
,
15
)
;
E
:
=
@
E
[
60
]
;
I
:
=
11
;
repeat
E
[
0
]
:
=
K
[
I
]
;
I
:
=
(
I
+
1
)
mod
15
;
E
[
1
]
:
=
K
[
I
]
;
I
:
=
(
I
+
1
)
mod
15
;
E
[
2
]
:
=
K
[
I
]
;
I
:
=
(
I
+
1
)
mod
15
;
E
[
3
]
:
=
K
[
I
]
;
I
:
=
(
I
+
9
)
mod
15
;
if
I
=
12
then
Break
;
E
[
4
]
:
=
K
[
I
]
;
Inc
(
I
)
;
E
[
5
]
:
=
K
[
I
]
;
Inc
(
I
)
;
E
[
6
]
:
=
K
[
I
]
;
I
:
=
(
I
+
9
)
mod
15
;
E
:
=
@
E
[
7
]
;
until
False
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
NewDES_Func
(
Source
,
Dest
,
Key
:
PByteArray
)
;
var
I
:
Integer
;
A
,
B
,
C
,
D
,
E
,
F
,
G
,
H
:
Byte
;
begin
A
:
=
Source
[
0
]
;
B
:
=
Source
[
1
]
;
C
:
=
Source
[
2
]
;
D
:
=
Source
[
3
]
;
E
:
=
Source
[
4
]
;
F
:
=
Source
[
5
]
;
G
:
=
Source
[
6
]
;
H
:
=
Source
[
7
]
;
for
I
:
=
0
to
7
do
begin
E
:
=
E
xor
NewDES_Data
[
A
xor
Key
[
0
]
]
;
F
:
=
F
xor
NewDES_Data
[
B
xor
Key
[
1
]
]
;
G
:
=
G
xor
NewDES_Data
[
C
xor
Key
[
2
]
]
;
H
:
=
H
xor
NewDES_Data
[
D
xor
Key
[
3
]
]
;
B
:
=
B
xor
NewDES_Data
[
E
xor
Key
[
4
]
]
;
C
:
=
C
xor
NewDES_Data
[
F
xor
E
]
;
D
:
=
D
xor
NewDES_Data
[
G
xor
Key
[
5
]
]
;
A
:
=
A
xor
NewDES_Data
[
H
xor
Key
[
6
]
]
;
Key
:
=
@
Key
[
7
]
;
end
;
E
:
=
E
xor
NewDES_Data
[
A
xor
Key
[
0
]
]
;
F
:
=
F
xor
NewDES_Data
[
B
xor
Key
[
1
]
]
;
G
:
=
G
xor
NewDES_Data
[
C
xor
Key
[
2
]
]
;
H
:
=
H
xor
NewDES_Data
[
D
xor
Key
[
3
]
]
;
Dest
[
0
]
:
=
A
;
Dest
[
1
]
:
=
B
;
Dest
[
2
]
:
=
C
;
Dest
[
3
]
:
=
D
;
Dest
[
4
]
:
=
E
;
Dest
[
5
]
:
=
F
;
Dest
[
6
]
:
=
G
;
Dest
[
7
]
:
=
H
;
end
;
procedure
TCipher_NewDES
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
NewDES_Func
(
Source
,
Dest
,
FUser
)
;
end
;
procedure
TCipher_NewDES
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
NewDES_Func
(
Source
,
Dest
,
@
PByteArray
(
FUser
)
[
60
]
)
;
end
;
// .TCipher_Q128
class
function
TCipher_Q128
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
16
;
Result
.
BufferSize
:
=
16
;
Result
.
UserSize
:
=
256
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Q128
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
3
]
of
LongWord
;
D
:
PLongArray
;
I
:
Integer
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
D
:
=
FUser
;
for
I
:
=
19
downto
1
do
begin
K
[
1
]
:
=
K
[
1
]
xor
Q128_Data
[
K
[
0
]
and
$03FF
]
;
K
[
0
]
:
=
K
[
0
]
shr
10
or
K
[
0
]
shl
22
;
K
[
2
]
:
=
K
[
2
]
xor
Q128_Data
[
K
[
1
]
and
$03FF
]
;
K
[
1
]
:
=
K
[
1
]
shr
10
or
K
[
1
]
shl
22
;
K
[
3
]
:
=
K
[
3
]
xor
Q128_Data
[
K
[
2
]
and
$03FF
]
;
K
[
2
]
:
=
K
[
2
]
shr
10
or
K
[
2
]
shl
22
;
K
[
0
]
:
=
K
[
0
]
xor
Q128_Data
[
K
[
3
]
and
$03FF
]
;
K
[
3
]
:
=
K
[
3
]
shr
10
or
K
[
3
]
shl
22
;
if
I <
=
16
then
begin
D
[
0
]
:
=
K
[
0
]
;
D
[
1
]
:
=
K
[
1
]
;
D
[
2
]
:
=
K
[
2
]
;
D
[
3
]
:
=
K
[
3
]
;
D
:
=
@
D
[
4
]
;
end
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_Q128
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF UseASM}
asm
PUSH ESI
PUSH EDI
PUSH EBX
PUSH EBP
PUSH ECX
MOV EDI
,
[
EAX
]
.
TCipher_Q128
.
FUser
MOV EAX
,
[
EDX
+
0
]
// B0
MOV EBX
,
[
EDX
+
4
]
// B1
MOV ECX
,
[
EDX
+
8
]
// B2
MOV EDX
,
[
EDX
+
12
]
// B3
MOV EBP
,
16
@@
1
:
MOV ESI
,
EAX
ROL ESI
,
10
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
0
]
XOR
EAX
,
EBX
MOV EBX
,
EAX
ROL EBX
,
10
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
4
]
XOR
EAX
,
ECX
MOV ECX
,
EAX
ROL ECX
,
10
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
8
]
XOR
EAX
,
EDX
MOV EDX
,
EAX
ROL EDX
,
10
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
12
]
XOR
EAX
,
ESI
DEC EBP
LEA EDI
,
[
EDI
+
16
]
JNZ
@@
1
POP ESI
MOV
[
ESI
+
0
]
,
EAX
// B0
MOV
[
ESI
+
4
]
,
EBX
// B1
MOV
[
ESI
+
8
]
,
ECX
// B2
MOV
[
ESI
+
12
]
,
EDX
// B3
POP EBP
POP EBX
POP EDI
POP ESI
end
;
{$ELSE}
var
D
:
PLongArray
;
B0
,
B1
,
B2
,
B3
,
I
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
D
:
=
FUser
;
B0
:
=
PLongArray
(
Source
)
[
0
]
;
B1
:
=
PLongArray
(
Source
)
[
1
]
;
B2
:
=
PLongArray
(
Source
)
[
2
]
;
B3
:
=
PLongArray
(
Source
)
[
3
]
;
for
I
:
=
0
to
15
do
begin
B1
:
=
B1
xor
(
Q128_Data
[
B0
and
$03FF
]
+
D
[
0
]
)
;
B0
:
=
B0
shl
10
or
B0
shr
22
;
B2
:
=
B2
xor
(
Q128_Data
[
B1
and
$03FF
]
+
D
[
1
]
)
;
B1
:
=
B1
shl
10
or
B1
shr
22
;
B3
:
=
B3
xor
(
Q128_Data
[
B2
and
$03FF
]
+
D
[
2
]
)
;
B2
:
=
B2
shl
10
or
B2
shr
22
;
B0
:
=
B0
xor
(
Q128_Data
[
B3
and
$03FF
]
+
D
[
3
]
)
;
B3
:
=
B3
shl
10
or
B3
shr
22
;
D
:
=
@
D
[
4
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
B0
;
PLongArray
(
Dest
)
[
1
]
:
=
B1
;
PLongArray
(
Dest
)
[
2
]
:
=
B2
;
PLongArray
(
Dest
)
[
3
]
:
=
B3
;
end
;
{$ENDIF}
procedure
TCipher_Q128
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
{$IFDEF UseASM}
asm
PUSH ESI
PUSH EDI
PUSH EBX
PUSH EBP
PUSH ECX
MOV EDI
,
[
EAX
]
.
TCipher_Q128
.
FUser
LEA EDI
,
[
EDI
+
64
*
4
]
MOV ESI
,
[
EDX
+
0
]
// B0
MOV EBX
,
[
EDX
+
4
]
// B1
MOV ECX
,
[
EDX
+
8
]
// B2
MOV EDX
,
[
EDX
+
12
]
// B3
MOV EBP
,
16
@@
1
:
SUB EDI
,
16
ROR EDX
,
10
MOV EAX
,
EDX
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
12
]
XOR
ESI
,
EAX
ROR ECX
,
10
MOV EAX
,
ECX
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
8
]
XOR
EDX
,
EAX
ROR EBX
,
10
MOV EAX
,
EBX
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
+
4
]
XOR
ECX
,
EAX
ROR ESI
,
10
MOV EAX
,
ESI
AND
EAX
,
03FFh
MOV EAX
,
[
EAX
*
4
+
OFFSET Q128_DATA
]
ADD EAX
,
[
EDI
]
XOR
EBX
,
EAX
DEC EBP
JNZ
@@
1
POP EAX
MOV
[
EAX
+
0
]
,
ESI
// B0
MOV
[
EAX
+
4
]
,
EBX
// B1
MOV
[
EAX
+
8
]
,
ECX
// B2
MOV
[
EAX
+
12
]
,
EDX
// B3
POP EBP
POP EBX
POP EDI
POP ESI
end
;
{$ELSE}
var
D
:
PLongArray
;
B0
,
B1
,
B2
,
B3
,
I
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
D
:
=
@
PLongArray
(
FUser
)
[
60
]
;
B0
:
=
PLongArray
(
Source
)
[
0
]
;
B1
:
=
PLongArray
(
Source
)
[
1
]
;
B2
:
=
PLongArray
(
Source
)
[
2
]
;
B3
:
=
PLongArray
(
Source
)
[
3
]
;
for
I
:
=
0
to
15
do
begin
B3
:
=
B3
shr
10
or
B3
shl
22
;
B0
:
=
B0
xor
(
Q128_Data
[
B3
and
$03FF
]
+
D
[
3
]
)
;
B2
:
=
B2
shr
10
or
B2
shl
22
;
B3
:
=
B3
xor
(
Q128_Data
[
B2
and
$03FF
]
+
D
[
2
]
)
;
B1
:
=
B1
shr
10
or
B1
shl
22
;
B2
:
=
B2
xor
(
Q128_Data
[
B1
and
$03FF
]
+
D
[
1
]
)
;
B0
:
=
B0
shr
10
or
B0
shl
22
;
B1
:
=
B1
xor
(
Q128_Data
[
B0
and
$03FF
]
+
D
[
0
]
)
;
Dec
(
PLongWord
(
D
)
,
4
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
B0
;
PLongArray
(
Dest
)
[
1
]
:
=
B1
;
PLongArray
(
Dest
)
[
2
]
:
=
B2
;
PLongArray
(
Dest
)
[
3
]
:
=
B3
;
end
;
{$ENDIF}
// .TCipher_RC2
class
function
TCipher_RC2
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
128
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
128
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_RC2
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
// New keysheduling according to RFC2268 and its testcases.
// the v3.0 keysetup was an older, bad version
// special thanks goes to Brendan Bosnan to pointing me out that.
var
I
,
L
,
Mask
,
KeyEffectiveBits
:
Integer
;
K
:
PByteArray
;
begin
if
Size <
=
0
then
Exit
;
KeyEffectiveBits
:
=
Size
*
8
;
L
:
=
KeyEffectiveBits
and
7
;
if
L
=
0
then
Mask
:
=
$FF
else
Mask
:
=
$FF
shr
(
8
-
L
)
;
L
:
=
(
KeyEffectiveBits
+
7
)
shr
3
;
K
:
=
FUser
;
Move
(
Key
,
K
[
0
]
,
Size
)
;
for
I
:
=
Size
to
127
do
K
[
I
]
:
=
RC2_Data
[
(
K
[
I
-
Size
]
+
K
[
I
-
1
]
)
and
$FF
]
;
K
[
128
-
L
]
:
=
RC2_Data
[
K
[
128
-
L
]
and
Mask
]
;
for
I
:
=
127
-
L
downto
0
do
K
[
I
]
:
=
RC2_Data
[
K
[
I
+
1
]
xor
K
[
I
+
L
]
]
;
end
;
procedure
TCipher_RC2
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
K
:
PWordArray
;
A
,
B
,
C
,
D
:
Word
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
FUser
;
A
:
=
PWordArray
(
Source
)
[
0
]
;
B
:
=
PWordArray
(
Source
)
[
1
]
;
C
:
=
PWordArray
(
Source
)
[
2
]
;
D
:
=
PWordArray
(
Source
)
[
3
]
;
for
I
:
=
0
to
15
do
begin
Inc
(
A
,
(
B
and
not
D
)
+
(
C
and
D
)
+
K
[
I
*
4
+
0
]
)
;
A
:
=
A
shl
1
or
A
shr
15
;
Inc
(
B
,
(
C
and
not
A
)
+
(
D
and
A
)
+
K
[
I
*
4
+
1
]
)
;
B
:
=
B
shl
2
or
B
shr
14
;
Inc
(
C
,
(
D
and
not
B
)
+
(
A
and
B
)
+
K
[
I
*
4
+
2
]
)
;
C
:
=
C
shl
3
or
C
shr
13
;
Inc
(
D
,
(
A
and
not
C
)
+
(
B
and
C
)
+
K
[
I
*
4
+
3
]
)
;
D
:
=
D
shl
5
or
D
shr
11
;
if
I
in
[
4
,
10
]
then
begin
Inc
(
A
,
K
[
D
and
$3F
]
)
;
Inc
(
B
,
K
[
A
and
$3F
]
)
;
Inc
(
C
,
K
[
B
and
$3F
]
)
;
Inc
(
D
,
K
[
C
and
$3F
]
)
;
end
;
end
;
PWordArray
(
Dest
)
[
0
]
:
=
A
;
PWordArray
(
Dest
)
[
1
]
:
=
B
;
PWordArray
(
Dest
)
[
2
]
:
=
C
;
PWordArray
(
Dest
)
[
3
]
:
=
D
;
end
;
procedure
TCipher_RC2
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
K
:
PWordArray
;
A
,
B
,
C
,
D
:
Word
;
begin
Assert
(
Size
=
Context
.
BlockSize
)
;
K
:
=
FUser
;
A
:
=
PWordArray
(
Source
)
[
0
]
;
B
:
=
PWordArray
(
Source
)
[
1
]
;
C
:
=
PWordArray
(
Source
)
[
2
]
;
D
:
=
PWordArray
(
Source
)
[
3
]
;
for
I
:
=
15
downto
0
do
begin
D
:
=
D
shr
5
or
D
shl
11
-
(
A
and
not
C
)
-
(
B
and
C
)
-
K
[
I
*
4
+
3
]
;
C
:
=
C
shr
3
or
C
shl
13
-
(
D
and
not
B
)
-
(
A
and
B
)
-
K
[
I
*
4
+
2
]
;
B
:
=
B
shr
2
or
B
shl
14
-
(
C
and
not
A
)
-
(
D
and
A
)
-
K
[
I
*
4
+
1
]
;
A
:
=
A
shr
1
or
A
shl
15
-
(
B
and
not
D
)
-
(
C
and
D
)
-
K
[
I
*
4
+
0
]
;
if
I
in
[
5
,
11
]
then
begin
Dec
(
D
,
K
[
C
and
$3F
]
)
;
Dec
(
C
,
K
[
B
and
$3F
]
)
;
Dec
(
B
,
K
[
A
and
$3F
]
)
;
Dec
(
A
,
K
[
D
and
$3F
]
)
;
end
;
end
;
PWordArray
(
Dest
)
[
0
]
:
=
A
;
PWordArray
(
Dest
)
[
1
]
:
=
B
;
PWordArray
(
Dest
)
[
2
]
:
=
C
;
PWordArray
(
Dest
)
[
3
]
:
=
D
;
end
;
// .TCipher_RC5
class
function
TCipher_RC5
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
256
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
136
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_RC5
.
SetRounds
(
Value
:
Integer
)
;
begin
if
Value <> FRounds
then
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
if
Value <
=
0
then
Value
:
=
12
;
FRounds
:
=
Value
;
end
;
end
;
procedure
TCipher_RC5
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
63
]
of
LongWord
;
L
,
Z
,
I
,
J
:
Integer
;
D
:
PLongArray
;
A
,
B
,
T
:
LongWord
;
begin
if
FRounds <
=
0
then
FRounds
:
=
12
;
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
D
:
=
FUser
;
L
:
=
(
Size
+
3
)
shr
2
;
if
L <
=
0
then
L
:
=
1
;
T
:
=
$B7E15163
;
for
I
:
=
0
to
(
FRounds
+
1
)
*
2
do
begin
D
[
I
]
:
=
T
;
Inc
(
T
,
$9E3779B9
)
;
end
;
if
L >
(
FRounds
+
1
)
*
2
then
Z
:
=
L
*
3
else
Z
:
=
(
FRounds
+
1
)
*
6
;
I
:
=
0
;
J
:
=
0
;
A
:
=
0
;
B
:
=
0
;
for
Z
:
=
Z
downto
1
do
begin
A
:
=
D
[
I
]
+
A
+
B
;
A
:
=
A
shl
3
or
A
shr
29
;
D
[
I
]
:
=
A
;
T
:
=
A
+
B
;
B
:
=
K
[
J
]
+
T
;
B
:
=
B
shl
T
or
B
shr
(
32
-
T
)
;
K
[
J
]
:
=
B
;
I
:
=
(
I
+
1
)
mod
(
(
FRounds
+
1
)
*
2
)
;
J
:
=
(
J
+
1
)
mod
L
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_RC5
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
K
:
PLongArray
;
I
:
Integer
;
A
,
B
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
FUser
;
A
:
=
PLongArray
(
Source
)
[
0
]
+
K
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
+
K
[
1
]
;
for
I
:
=
1
to
FRounds
do
begin
A
:
=
A
xor
B
;
A
:
=
A
shl
B
or
A
shr
(
32
-
B
)
+
K
[
I
*
2
+
0
]
;
B
:
=
B
xor
A
;
B
:
=
B
shl
A
or
B
shr
(
32
-
A
)
+
K
[
I
*
2
+
1
]
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
;
PLongArray
(
Dest
)
[
1
]
:
=
B
;
end
;
procedure
TCipher_RC5
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
K
:
PLongArray
;
I
:
Integer
;
A
,
B
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
0
]
;
A
:
=
PLongArray
(
Source
)
[
0
]
;
B
:
=
PLongArray
(
Source
)
[
1
]
;
for
I
:
=
FRounds
downto
1
do
begin
B
:
=
B
-
K
[
I
*
2
+
1
]
;
B
:
=
B
shr
A
or
B
shl
(
32
-
A
)
xor
A
;
A
:
=
A
-
K
[
I
*
2
+
0
]
;
A
:
=
A
shr
B
or
A
shl
(
32
-
B
)
xor
B
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
A
-
K
[
0
]
;
PLongArray
(
Dest
)
[
1
]
:
=
B
-
K
[
1
]
;
end
;
// .TCipher_SAFER
class
function
TCipher_SAFER
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
768
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_SAFER
.
SetRounds
(
Value
:
Integer
)
;
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
if
(
Value <
4
)
or
(
Value >
13
)
then
case
FVersion
of
{Default Rounds}
svK40
,
svSK40
:
Value
:
=
5
;
svK64
,
svSK64
:
Value
:
=
6
;
svK128
,
svSK128
:
Value
:
=
10
;
else
Value
:
=
8
;
end
;
FRounds
:
=
Value
;
end
;
procedure
TCipher_SAFER
.
SetVersion
(
Value
:
TSAFERVersion
)
;
begin
if
Value <> FVersion
then
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
FVersion
:
=
Value
;
SetRounds
(
0
)
;
end
;
end
;
procedure
TCipher_SAFER
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
procedure
InitTab
;
var
I
,
E
:
Integer
;
Exp
:
PByteArray
;
Log
:
PByteArray
;
begin
Exp
:
=
FUser
;
Log
:
=
@
Exp
[
256
]
;
E
:
=
1
;
for
I
:
=
0
to
255
do
begin
Exp
[
I
]
:
=
E
and
$FF
;
Log
[
E
and
$FF
]
:
=
I
;
E
:
=
(
E
*
45
)
mod
257
;
end
;
end
;
procedure
InitKey
;
var
D
:
PByte
;
Exp
:
PByteArray
;
Strong
:
Boolean
;
K
:
array
[
Boolean
,
0
..
8
]
of
Byte
;
I
,
J
:
Integer
;
begin
Strong
:
=
FVersion
in
[
svSK40
,
svSK64
,
svSK128
]
;
Exp
:
=
FUser
;
D
:
=
@
Exp
[
512
]
;
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
{Setup Key A}
I
:
=
Size
;
if
I >
8
then
I
:
=
8
;
Move
(
Key
,
K
[
False
]
,
I
)
;
{Setup the Key for K-40, SK-40}
if
FVersion
in
[
svK40
,
svSK40
]
then
begin
K
[
False
,
5
]
:
=
K
[
False
,
0
]
xor
K
[
False
,
2
]
xor
129
;
K
[
False
,
6
]
:
=
K
[
False
,
0
]
xor
K
[
False
,
3
]
xor
K
[
False
,
4
]
xor
66
;
K
[
False
,
7
]
:
=
K
[
False
,
1
]
xor
K
[
False
,
2
]
xor
K
[
False
,
4
]
xor
36
;
K
[
False
,
8
]
:
=
K
[
False
,
1
]
xor
K
[
False
,
3
]
xor
24
;
Move
(
K
[
False
]
,
K
[
True
]
,
SizeOf
(
K
[
False
]
)
)
;
end
else
begin
if
Size >
8
then
begin
I
:
=
Size
-
8
;
if
I >
8
then
I
:
=
8
;
Move
(
TByteArray
(
Key
)
[
8
]
,
K
[
True
]
,
I
)
;
end
else
Move
(
K
[
False
]
,
K
[
True
]
,
9
)
;
for
I
:
=
0
to
7
do
begin
K
[
False
,
8
]
:
=
K
[
False
,
8
]
xor
K
[
False
,
I
]
;
K
[
True
,
8
]
:
=
K
[
True
,
8
]
xor
K
[
True
,
I
]
;
end
;
end
;
{Setup the KeyData}
Move
(
K
[
True
]
,
D
^
,
8
)
;
Inc
(
D
,
8
)
;
for
I
:
=
0
to
8
do
K
[
False
,
I
]
:
=
K
[
False
,
I
]
shr
3
or
K
[
False
,
I
]
shl
5
;
for
I
:
=
1
to
FRounds
do
begin
for
J
:
=
0
to
8
do
begin
K
[
False
,
J
]
:
=
K
[
False
,
J
]
shl
6
or
K
[
False
,
J
]
shr
2
;
K
[
True
,
J
]
:
=
K
[
True
,
J
]
shl
6
or
K
[
True
,
J
]
shr
2
;
end
;
for
J
:
=
0
to
7
do
begin
if
Strong
then
D
^
:
=
K
[
False
,
(
J
+
I
*
2
-
1
)
mod
9
]
+
Exp
[
Exp
[
18
*
I
+
J
+
1
]
]
else
D
^
:
=
K
[
False
,
J
]
+
Exp
[
Exp
[
18
*
I
+
J
+
1
]
]
;
Inc
(
D
)
;
end
;
for
J
:
=
0
to
7
do
begin
if
Strong
then
D
^
:
=
K
[
True
,
(
J
+
I
*
2
)
mod
9
]
+
Exp
[
Exp
[
18
*
I
+
J
+
10
]
]
else
D
^
:
=
K
[
True
,
J
]
+
Exp
[
Exp
[
18
*
I
+
J
+
10
]
]
;
Inc
(
D
)
;
end
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
begin
if
(
FRounds <
4
)
or
(
FRounds >
13
)
then
case
FVersion
of
svK40
,
svSK40
:
FRounds
:
=
5
;
svK64
,
svSK64
:
FRounds
:
=
6
;
svK128
,
svSK128
:
FRounds
:
=
10
;
else
FRounds
:
=
8
;
end
;
InitTab
;
InitKey
;
end
;
procedure
TCipher_SAFER
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Exp
,
Log
,
Key
:
PByteArray
;
I
:
Integer
;
A
,
B
,
C
,
D
,
E
,
F
,
G
,
H
,
T
:
Byte
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Exp
:
=
FUser
;
Log
:
=
@
Exp
[
256
]
;
Key
:
=
@
Exp
[
512
]
;
A
:
=
PByteArray
(
Source
)
[
0
]
;
B
:
=
PByteArray
(
Source
)
[
1
]
;
C
:
=
PByteArray
(
Source
)
[
2
]
;
D
:
=
PByteArray
(
Source
)
[
3
]
;
E
:
=
PByteArray
(
Source
)
[
4
]
;
F
:
=
PByteArray
(
Source
)
[
5
]
;
G
:
=
PByteArray
(
Source
)
[
6
]
;
H
:
=
PByteArray
(
Source
)
[
7
]
;
for
I
:
=
0
to
FRounds
-
1
do
begin
A
:
=
A
xor
Key
[
0
]
;
B
:
=
B
+
Key
[
1
]
;
C
:
=
C
+
Key
[
2
]
;
D
:
=
D
xor
Key
[
3
]
;
E
:
=
E
xor
Key
[
4
]
;
F
:
=
F
+
Key
[
5
]
;
G
:
=
G
+
Key
[
6
]
;
H
:
=
H
xor
Key
[
7
]
;
A
:
=
Exp
[
A
]
+
Key
[
8
]
;
B
:
=
Log
[
B
]
xor
Key
[
9
]
;
C
:
=
Log
[
C
]
xor
Key
[
10
]
;
D
:
=
Exp
[
D
]
+
Key
[
11
]
;
E
:
=
Exp
[
E
]
+
Key
[
12
]
;
F
:
=
Log
[
F
]
xor
Key
[
13
]
;
G
:
=
Log
[
G
]
xor
Key
[
14
]
;
H
:
=
Exp
[
H
]
+
Key
[
15
]
;
Inc
(
B
,
A
)
;
Inc
(
A
,
B
)
;
Inc
(
D
,
C
)
;
Inc
(
C
,
D
)
;
Inc
(
F
,
E
)
;
Inc
(
E
,
F
)
;
Inc
(
H
,
G
)
;
Inc
(
G
,
H
)
;
Inc
(
C
,
A
)
;
Inc
(
A
,
C
)
;
Inc
(
G
,
E
)
;
Inc
(
E
,
G
)
;
Inc
(
D
,
B
)
;
Inc
(
B
,
D
)
;
Inc
(
H
,
F
)
;
Inc
(
F
,
H
)
;
Inc
(
E
,
A
)
;
Inc
(
A
,
E
)
;
Inc
(
F
,
B
)
;
Inc
(
B
,
F
)
;
Inc
(
G
,
C
)
;
Inc
(
C
,
G
)
;
Inc
(
H
,
D
)
;
Inc
(
D
,
H
)
;
T
:
=
B
;
B
:
=
E
;
E
:
=
C
;
C
:
=
T
;
T
:
=
D
;
D
:
=
F
;
F
:
=
G
;
G
:
=
T
;
Key
:
=
@
Key
[
16
]
;
end
;
PByteArray
(
Dest
)
[
0
]
:
=
A
xor
Key
[
0
]
;
PByteArray
(
Dest
)
[
1
]
:
=
B
+
Key
[
1
]
;
PByteArray
(
Dest
)
[
2
]
:
=
C
+
Key
[
2
]
;
PByteArray
(
Dest
)
[
3
]
:
=
D
xor
Key
[
3
]
;
PByteArray
(
Dest
)
[
4
]
:
=
E
xor
Key
[
4
]
;
PByteArray
(
Dest
)
[
5
]
:
=
F
+
Key
[
5
]
;
PByteArray
(
Dest
)
[
6
]
:
=
G
+
Key
[
6
]
;
PByteArray
(
Dest
)
[
7
]
:
=
H
xor
Key
[
7
]
;
end
;
procedure
TCipher_SAFER
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Exp
,
Log
,
Key
:
PByteArray
;
I
:
Integer
;
A
,
B
,
C
,
D
,
E
,
F
,
G
,
H
,
T
:
Byte
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Exp
:
=
FUser
;
Log
:
=
@
Exp
[
256
]
;
Key
:
=
@
Exp
[
504
+
8
*
(
FRounds
*
2
+
1
)
]
;
A
:
=
PByteArray
(
Source
)
[
0
]
xor
Key
[
0
]
;
B
:
=
PByteArray
(
Source
)
[
1
]
-
Key
[
1
]
;
C
:
=
PByteArray
(
Source
)
[
2
]
-
Key
[
2
]
;
D
:
=
PByteArray
(
Source
)
[
3
]
xor
Key
[
3
]
;
E
:
=
PByteArray
(
Source
)
[
4
]
xor
Key
[
4
]
;
F
:
=
PByteArray
(
Source
)
[
5
]
-
Key
[
5
]
;
G
:
=
PByteArray
(
Source
)
[
6
]
-
Key
[
6
]
;
H
:
=
PByteArray
(
Source
)
[
7
]
xor
Key
[
7
]
;
for
I
:
=
0
to
FRounds
-
1
do
begin
Dec
(
PByte
(
Key
)
,
16
)
;
T
:
=
E
;
E
:
=
B
;
B
:
=
C
;
C
:
=
T
;
T
:
=
F
;
F
:
=
D
;
D
:
=
G
;
G
:
=
T
;
Dec
(
A
,
E
)
;
Dec
(
E
,
A
)
;
Dec
(
B
,
F
)
;
Dec
(
F
,
B
)
;
Dec
(
C
,
G
)
;
Dec
(
G
,
C
)
;
Dec
(
D
,
H
)
;
Dec
(
H
,
D
)
;
Dec
(
A
,
C
)
;
Dec
(
C
,
A
)
;
Dec
(
E
,
G
)
;
Dec
(
G
,
E
)
;
Dec
(
B
,
D
)
;
Dec
(
D
,
B
)
;
Dec
(
F
,
H
)
;
Dec
(
H
,
F
)
;
Dec
(
A
,
B
)
;
Dec
(
B
,
A
)
;
Dec
(
C
,
D
)
;
Dec
(
D
,
C
)
;
Dec
(
E
,
F
)
;
Dec
(
F
,
E
)
;
Dec
(
G
,
H
)
;
Dec
(
H
,
G
)
;
H
:
=
H
-
Key
[
15
]
;
G
:
=
G
xor
Key
[
14
]
;
F
:
=
F
xor
Key
[
13
]
;
E
:
=
E
-
Key
[
12
]
;
D
:
=
D
-
Key
[
11
]
;
C
:
=
C
xor
Key
[
10
]
;
B
:
=
B
xor
Key
[
9
]
;
A
:
=
A
-
Key
[
8
]
;
H
:
=
Log
[
H
]
xor
Key
[
7
]
;
G
:
=
Exp
[
G
]
-
Key
[
6
]
;
F
:
=
Exp
[
F
]
-
Key
[
5
]
;
E
:
=
Log
[
E
]
xor
Key
[
4
]
;
D
:
=
Log
[
D
]
xor
Key
[
3
]
;
C
:
=
Exp
[
C
]
-
Key
[
2
]
;
B
:
=
Exp
[
B
]
-
Key
[
1
]
;
A
:
=
Log
[
A
]
xor
Key
[
0
]
;
end
;
PByteArray
(
Dest
)
[
0
]
:
=
A
;
PByteArray
(
Dest
)
[
1
]
:
=
B
;
PByteArray
(
Dest
)
[
2
]
:
=
C
;
PByteArray
(
Dest
)
[
3
]
:
=
D
;
PByteArray
(
Dest
)
[
4
]
:
=
E
;
PByteArray
(
Dest
)
[
5
]
:
=
F
;
PByteArray
(
Dest
)
[
6
]
:
=
G
;
PByteArray
(
Dest
)
[
7
]
:
=
H
;
end
;
// .TCipher_Shark
type
PLong64
=
^
TLong64
;
TLong64
=
packed
record
L
,
R
:
LongWord
;
end
;
PLong64Array
=
^
TLong64Array
;
TLong64Array
=
array
[
0
..
1023
]
of
TLong64
;
class
function
TCipher_Shark
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
112
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Shark
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
Log
,
ALog
:
array
[
0
..
255
]
of
Byte
;
procedure
InitLog
;
var
I
,
J
:
Word
;
begin
ALog
[
0
]
:
=
1
;
for
I
:
=
1
to
255
do
begin
J
:
=
ALog
[
I
-
1
]
shl
1
;
if
J
and
$100
<>
0
then
J
:
=
J
xor
$01F5
;
ALog
[
I
]
:
=
J
;
end
;
for
I
:
=
1
to
254
do
Log
[
ALog
[
I
]
]
:
=
I
;
end
;
function
Transform
(
A
:
TLong64
)
:
TLong64
;
function
Mul
(
A
,
B
:
Integer
)
:
Byte
;
begin
Result
:
=
ALog
[
(
Log
[
A
]
+
Log
[
B
]
)
mod
255
]
;
end
;
var
I
,
J
:
Byte
;
K
,
T
:
array
[
0
..
7
]
of
Byte
;
begin
Move
(
A
.
R
,
K
[
0
]
,
4
)
;
Move
(
A
.
L
,
K
[
4
]
,
4
)
;
SwapLongBuffer
(
K
,
K
,
2
)
;
for
I
:
=
0
to
7
do
begin
T
[
I
]
:
=
Mul
(
Shark_I
[
I
,
0
]
,
K
[
0
]
)
;
for
J
:
=
1
to
7
do
T
[
I
]
:
=
T
[
I
]
xor
Mul
(
Shark_I
[
I
,
J
]
,
K
[
J
]
)
;
end
;
Result
.
L
:
=
T
[
0
]
;
Result
.
R
:
=
0
;
for
I
:
=
1
to
7
do
begin
Result
.
R
:
=
Result
.
R
shl
8
or
Result
.
L
shr
24
;
Result
.
L
:
=
Result
.
L
shl
8
xor
T
[
I
]
;
end
;
end
;
function
Shark
(
D
:
TLong64
;
K
:
PLong64
)
:
TLong64
;
var
R
,
T
:
Integer
;
begin
for
R
:
=
0
to
4
do
begin
D
.
L
:
=
D
.
L
xor
K
.
L
;
D
.
R
:
=
D
.
R
xor
K
.
R
;
Inc
(
K
)
;
T
:
=
Shark_CE
[
0
,
D
.
R
shr
23
and
$1FE
]
xor
Shark_CE
[
1
,
D
.
R
shr
15
and
$1FE
]
xor
Shark_CE
[
2
,
D
.
R
shr
7
and
$1FE
]
xor
Shark_CE
[
3
,
D
.
R
shl
1
and
$1FE
]
xor
Shark_CE
[
4
,
D
.
L
shr
23
and
$1FE
]
xor
Shark_CE
[
5
,
D
.
L
shr
15
and
$1FE
]
xor
Shark_CE
[
6
,
D
.
L
shr
7
and
$1FE
]
xor
Shark_CE
[
7
,
D
.
L
shl
1
and
$1FE
]
;
D
.
R
:
=
Shark_CE
[
0
,
D
.
R
shr
23
and
$1FE
or
1
]
xor
Shark_CE
[
1
,
D
.
R
shr
15
and
$1FE
or
1
]
xor
Shark_CE
[
2
,
D
.
R
shr
7
and
$1FE
or
1
]
xor
Shark_CE
[
3
,
D
.
R
shl
1
and
$1FE
or
1
]
xor
Shark_CE
[
4
,
D
.
L
shr
23
and
$1FE
or
1
]
xor
Shark_CE
[
5
,
D
.
L
shr
15
and
$1FE
or
1
]
xor
Shark_CE
[
6
,
D
.
L
shr
7
and
$1FE
or
1
]
xor
Shark_CE
[
7
,
D
.
L
shl
1
and
$1FE
or
1
]
;
D
.
L
:
=
T
;
end
;
D
.
L
:
=
D
.
L
xor
K
.
L
;
D
.
R
:
=
D
.
R
xor
K
.
R
;
Inc
(
K
)
;
D
.
L
:
=
LongWord
(
Shark_SE
[
D
.
L
shr
24
and
$FF
]
)
shl
24
xor
LongWord
(
Shark_SE
[
D
.
L
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SE
[
D
.
L
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SE
[
D
.
L
and
$FF
]
)
;
D
.
R
:
=
LongWord
(
Shark_SE
[
D
.
R
shr
24
and
$FF
]
)
shl
24
xor
LongWord
(
Shark_SE
[
D
.
R
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SE
[
D
.
R
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SE
[
D
.
R
and
$FF
]
)
;
Result
.
L
:
=
D
.
L
xor
K
.
L
;
Result
.
R
:
=
D
.
R
xor
K
.
R
;
end
;
var
T
:
array
[
0
..
6
]
of
TLong64
;
A
:
array
[
0
..
6
]
of
TLong64
;
K
:
array
[
0
..
15
]
of
Byte
;
I
,
J
,
R
:
Byte
;
E
,
D
:
PLong64Array
;
L
:
TLong64
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
InitLog
;
E
:
=
FUser
;
D
:
=
@
E
[
7
]
;
Move
(
Shark_CE
[
0
]
,
T
,
SizeOf
(
T
)
)
;
T
[
6
]
:
=
Transform
(
T
[
6
]
)
;
I
:
=
0
;
for
R
:
=
0
to
6
do
begin
Inc
(
I
)
;
A
[
R
]
.
L
:
=
K
[
I
and
$F
]
;
A
[
R
]
.
R
:
=
0
;
for
J
:
=
1
to
7
do
begin
Inc
(
I
)
;
A
[
R
]
.
R
:
=
A
[
R
]
.
R
shl
8
or
A
[
R
]
.
L
shr
24
;
A
[
R
]
.
L
:
=
A
[
R
]
.
L
shl
8
or
K
[
I
and
$F
]
;
end
;
end
;
L
.
L
:
=
0
;
L
.
R
:
=
0
;
L
:
=
Shark
(
L
,
@
T
)
;
E
[
0
]
.
L
:
=
A
[
0
]
.
L
xor
L
.
L
;
E
[
0
]
.
R
:
=
A
[
0
]
.
R
xor
L
.
R
;
for
R
:
=
1
to
6
do
begin
L
:
=
Shark
(
E
[
R
-
1
]
,
@
T
)
;
E
[
R
]
.
L
:
=
A
[
R
]
.
L
xor
L
.
L
;
E
[
R
]
.
R
:
=
A
[
R
]
.
R
xor
L
.
R
;
end
;
E
[
6
]
:
=
Transform
(
E
[
6
]
)
;
D
[
0
]
:
=
E
[
6
]
;
D
[
6
]
:
=
E
[
0
]
;
for
R
:
=
1
to
5
do
D
[
R
]
:
=
Transform
(
E
[
6
-
R
]
)
;
ProtectBuffer
(
Log
,
SizeOf
(
Log
)
)
;
ProtectBuffer
(
ALog
,
SizeOf
(
ALog
)
)
;
ProtectBuffer
(
T
,
SizeOf
(
T
)
)
;
ProtectBuffer
(
A
,
SizeOf
(
A
)
)
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_Shark
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
T
,
L
,
R
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
FUser
;
L
:
=
PLong64
(
Source
)
.
L
;
R
:
=
PLong64
(
Source
)
.
R
;
for
I
:
=
0
to
4
do
begin
L
:
=
L
xor
K
[
I
*
2
+
0
]
;
R
:
=
R
xor
K
[
I
*
2
+
1
]
;
T
:
=
Shark_CE
[
0
,
R
shr
23
and
$1FE
]
xor
Shark_CE
[
1
,
R
shr
15
and
$1FE
]
xor
Shark_CE
[
2
,
R
shr
7
and
$1FE
]
xor
Shark_CE
[
3
,
R
shl
1
and
$1FE
]
xor
Shark_CE
[
4
,
L
shr
23
and
$1FE
]
xor
Shark_CE
[
5
,
L
shr
15
and
$1FE
]
xor
Shark_CE
[
6
,
L
shr
7
and
$1FE
]
xor
Shark_CE
[
7
,
L
shl
1
and
$1FE
]
;
R
:
=
Shark_CE
[
0
,
R
shr
23
and
$1FE
or
1
]
xor
Shark_CE
[
1
,
R
shr
15
and
$1FE
or
1
]
xor
Shark_CE
[
2
,
R
shr
7
and
$1FE
or
1
]
xor
Shark_CE
[
3
,
R
shl
1
and
$1FE
or
1
]
xor
Shark_CE
[
4
,
L
shr
23
and
$1FE
or
1
]
xor
Shark_CE
[
5
,
L
shr
15
and
$1FE
or
1
]
xor
Shark_CE
[
6
,
L
shr
7
and
$1FE
or
1
]
xor
Shark_CE
[
7
,
L
shl
1
and
$1FE
or
1
]
;
L
:
=
T
;
end
;
L
:
=
L
xor
K
[
10
]
;
R
:
=
R
xor
K
[
11
]
;
L
:
=
LongWord
(
Shark_SE
[
L
shr
24
]
)
shl
24
xor
LongWord
(
Shark_SE
[
L
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SE
[
L
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SE
[
L
and
$FF
]
)
;
R
:
=
LongWord
(
Shark_SE
[
R
shr
24
]
)
shl
24
xor
LongWord
(
Shark_SE
[
R
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SE
[
R
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SE
[
R
and
$FF
]
)
;
PLong64
(
Dest
)
.
L
:
=
L
xor
K
[
12
]
;
PLong64
(
Dest
)
.
R
:
=
R
xor
K
[
13
]
;
end
;
procedure
TCipher_Shark
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
T
,
R
,
L
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
K
:
=
@
PLongArray
(
FUser
)
[
14
]
;
L
:
=
PLong64
(
Source
)
.
L
;
R
:
=
PLong64
(
Source
)
.
R
;
for
I
:
=
0
to
4
do
begin
L
:
=
L
xor
K
[
I
*
2
+
0
]
;
R
:
=
R
xor
K
[
I
*
2
+
1
]
;
T
:
=
Shark_CD
[
0
,
R
shr
23
and
$1FE
]
xor
Shark_CD
[
1
,
R
shr
15
and
$1FE
]
xor
Shark_CD
[
2
,
R
shr
7
and
$1FE
]
xor
Shark_CD
[
3
,
R
shl
1
and
$1FE
]
xor
Shark_CD
[
4
,
L
shr
23
and
$1FE
]
xor
Shark_CD
[
5
,
L
shr
15
and
$1FE
]
xor
Shark_CD
[
6
,
L
shr
7
and
$1FE
]
xor
Shark_CD
[
7
,
L
shl
1
and
$1FE
]
;
R
:
=
Shark_CD
[
0
,
R
shr
23
and
$1FE
or
1
]
xor
Shark_CD
[
1
,
R
shr
15
and
$1FE
or
1
]
xor
Shark_CD
[
2
,
R
shr
7
and
$1FE
or
1
]
xor
Shark_CD
[
3
,
R
shl
1
and
$1FE
or
1
]
xor
Shark_CD
[
4
,
L
shr
23
and
$1FE
or
1
]
xor
Shark_CD
[
5
,
L
shr
15
and
$1FE
or
1
]
xor
Shark_CD
[
6
,
L
shr
7
and
$1FE
or
1
]
xor
Shark_CD
[
7
,
L
shl
1
and
$1FE
or
1
]
;
L
:
=
T
;
end
;
L
:
=
L
xor
K
[
10
]
;
R
:
=
R
xor
K
[
11
]
;
L
:
=
LongWord
(
Shark_SD
[
L
shr
24
]
)
shl
24
xor
LongWord
(
Shark_SD
[
L
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SD
[
L
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SD
[
L
and
$FF
]
)
;
R
:
=
LongWord
(
Shark_SD
[
R
shr
24
]
)
shl
24
xor
LongWord
(
Shark_SD
[
R
shr
16
and
$FF
]
)
shl
16
xor
LongWord
(
Shark_SD
[
R
shr
8
and
$FF
]
)
shl
8
xor
LongWord
(
Shark_SD
[
R
and
$FF
]
)
;
PLong64
(
Dest
)
.
L
:
=
L
xor
K
[
12
]
;
PLong64
(
Dest
)
.
R
:
=
R
xor
K
[
13
]
;
end
;
// .TCipher_Skipjack
type
PSkipjackTab
=
^
TSkipjackTab
;
TSkipjackTab
=
array
[
0
..
255
]
of
Byte
;
class
function
TCipher_Skipjack
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
10
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
$A00
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_Skipjack
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
var
K
:
array
[
0
..
9
]
of
Byte
;
D
:
PByte
;
I
,
J
:
Integer
;
begin
FillChar
(
K
,
SizeOf
(
K
)
,
0
)
;
Move
(
Key
,
K
,
Size
)
;
D
:
=
FUser
;
for
I
:
=
0
to
9
do
for
J
:
=
0
to
255
do
begin
D
^
:
=
Skipjack_Data
[
J
xor
K
[
I
]
]
;
Inc
(
D
)
;
end
;
ProtectBuffer
(
K
,
SizeOf
(
K
)
)
;
end
;
procedure
TCipher_Skipjack
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Tab
,
Min
:
PSkipjackTab
;
Max
:
PChar
;
K
,
T
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Min
:
=
FUser
;
Max
:
=
PChar
(
Min
)
+
9
*
256
;
Tab
:
=
Min
;
A
:
=
Swap
(
PWordArray
(
Source
)
[
0
]
)
;
B
:
=
Swap
(
PWordArray
(
Source
)
[
1
]
)
;
C
:
=
Swap
(
PWordArray
(
Source
)
[
2
]
)
;
D
:
=
Swap
(
PWordArray
(
Source
)
[
3
]
)
;
K
:
=
0
;
repeat
Inc
(
K
)
;
T
:
=
A
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
A
:
=
T
xor
D
xor
K
;
D
:
=
C
;
C
:
=
B
;
B
:
=
T
;
until
K
=
8
;
repeat
Inc
(
K
)
;
T
:
=
A
;
A
:
=
D
;
D
:
=
C
;
C
:
=
T
xor
B
xor
K
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
B
:
=
T
;
until
K
=
16
;
repeat
Inc
(
K
)
;
T
:
=
A
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
A
:
=
T
xor
D
xor
K
;
D
:
=
C
;
C
:
=
B
;
B
:
=
T
;
until
K
=
24
;
repeat
Inc
(
K
)
;
T
:
=
A
;
A
:
=
D
;
D
:
=
C
;
C
:
=
T
xor
B
xor
K
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Inc
(
Tab
)
;
if
Tab > Max
then
Tab
:
=
Min
;
B
:
=
T
;
until
K
=
32
;
PWordArray
(
Dest
)
[
0
]
:
=
Swap
(
A
)
;
PWordArray
(
Dest
)
[
1
]
:
=
Swap
(
B
)
;
PWordArray
(
Dest
)
[
2
]
:
=
Swap
(
C
)
;
PWordArray
(
Dest
)
[
3
]
:
=
Swap
(
D
)
;
end
;
procedure
TCipher_Skipjack
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
Tab
,
Max
:
PSkipjackTab
;
Min
:
PChar
;
K
,
T
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Min
:
=
FUser
;
Max
:
=
Pointer
(
Min
+
9
*
256
)
;
Tab
:
=
Pointer
(
Min
+
7
*
256
)
;
A
:
=
Swap
(
PWordArray
(
Source
)
[
0
]
)
;
{holds as Integer, Compiler make faster Code}
B
:
=
Swap
(
PWordArray
(
Source
)
[
1
]
)
;
C
:
=
Swap
(
PWordArray
(
Source
)
[
2
]
)
;
D
:
=
Swap
(
PWordArray
(
Source
)
[
3
]
)
;
K
:
=
32
;
repeat
T
:
=
B
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
B
:
=
T
xor
C
xor
K
;
C
:
=
D
;
D
:
=
A
;
A
:
=
T
;
Dec
(
K
)
;
until
K
=
24
;
repeat
T
:
=
B
;
B
:
=
C
;
C
:
=
D
;
D
:
=
T
xor
A
xor
K
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
A
:
=
T
;
Dec
(
K
)
;
until
K
=
16
;
repeat
T
:
=
B
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
B
:
=
C
xor
T
xor
K
;
C
:
=
D
;
D
:
=
A
;
A
:
=
T
;
Dec
(
K
)
;
until
K
=
8
;
repeat
T
:
=
B
;
B
:
=
C
;
C
:
=
D
;
D
:
=
T
xor
A
xor
K
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
shr
8
]
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
T
:
=
T
xor
Tab
[
T
and
$FF
]
shl
8
;
Dec
(
Tab
)
;
if
Tab < Min
then
Tab
:
=
Max
;
A
:
=
T
;
Dec
(
K
)
;
until
K
=
0
;
PWordArray
(
Dest
)
[
0
]
:
=
Swap
(
A
)
;
PWordArray
(
Dest
)
[
1
]
:
=
Swap
(
B
)
;
PWordArray
(
Dest
)
[
2
]
:
=
Swap
(
C
)
;
PWordArray
(
Dest
)
[
3
]
:
=
Swap
(
D
)
;
end
;
// .TCipher_TEA
const
TEA_Delta
=
$9E3779B9
;
class
function
TCipher_TEA
.
Context
:
TCipherContext
;
begin
Result
.
KeySize
:
=
16
;
Result
.
BlockSize
:
=
8
;
Result
.
BufferSize
:
=
8
;
Result
.
UserSize
:
=
32
;
Result
.
UserSave
:
=
False
;
end
;
procedure
TCipher_TEA
.
SetRounds
(
Value
:
Integer
)
;
begin
if
not
(
FState
in
[
csNew
,
csInitialized
,
csDone
]
)
then
Done
;
if
Value <
16
then
Value
:
=
16
else
if
Value >
32
then
Value
:
=
32
;
FRounds
:
=
Value
;
end
;
procedure
TCipher_TEA
.
DoInit
(
const
Key
;
Size
:
Integer
)
;
begin
Move
(
Key
,
FUser
^
,
Size
)
;
SetRounds
(
FRounds
)
;
end
;
procedure
TCipher_TEA
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
Sum
,
X
,
Y
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Sum
:
=
0
;
A
:
=
PLongArray
(
FUser
)
[
0
]
;
B
:
=
PLongArray
(
FUser
)
[
1
]
;
C
:
=
PLongArray
(
FUser
)
[
2
]
;
D
:
=
PLongArray
(
FUser
)
[
3
]
;
X
:
=
PLongArray
(
Source
)
[
0
]
;
Y
:
=
PLongArray
(
Source
)
[
1
]
;
for
I
:
=
0
to
FRounds
-
1
do
begin
Inc
(
Sum
,
TEA_Delta
)
;
Inc
(
X
,
(
(
(
Y
shl
4
+
A
)
xor
Y
)
+
Sum
)
xor
(
Y
shr
5
+
B
)
)
;
Inc
(
Y
,
(
(
(
X
shl
4
+
C
)
xor
X
)
+
Sum
)
xor
(
X
shr
5
+
D
)
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
X
;
PLongArray
(
Dest
)
[
1
]
:
=
Y
;
end
;
procedure
TCipher_TEA
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
Sum
,
X
,
Y
,
A
,
B
,
C
,
D
:
LongWord
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Sum
:
=
TEA_Delta
*
LongWord
(
FRounds
)
;
A
:
=
PLongArray
(
FUser
)
[
0
]
;
B
:
=
PLongArray
(
FUser
)
[
1
]
;
C
:
=
PLongArray
(
FUser
)
[
2
]
;
D
:
=
PLongArray
(
FUser
)
[
3
]
;
X
:
=
PLongArray
(
Source
)
[
0
]
;
Y
:
=
PLongArray
(
Source
)
[
1
]
;
for
I
:
=
0
to
FRounds
-
1
do
begin
Dec
(
Y
,
(
X
shl
4
+
C
)
xor
X
+
Sum
xor
(
X
shr
5
+
D
)
)
;
Dec
(
X
,
(
Y
shl
4
+
A
)
xor
Y
+
Sum
xor
(
Y
shr
5
+
B
)
)
;
Dec
(
Sum
,
TEA_Delta
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
X
;
PLongArray
(
Dest
)
[
1
]
:
=
Y
;
end
;
// .TCipher_TEAN
procedure
TCipher_TEAN
.
DoEncode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
,
Sum
,
X
,
Y
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Sum
:
=
0
;
X
:
=
PLongArray
(
Source
)
[
0
]
;
Y
:
=
PLongArray
(
Source
)
[
1
]
;
K
:
=
FUser
;
for
I
:
=
0
to
FRounds
-
1
do
begin
Inc
(
X
,
(
Y
shl
4
xor
Y
shr
5
)
+
(
Y
xor
Sum
)
+
K
[
Sum
and
3
]
)
;
Inc
(
Sum
,
TEA_Delta
)
;
Inc
(
Y
,
(
X
shl
4
xor
X
shr
5
)
+
(
X
xor
Sum
)
+
K
[
Sum
shr
11
and
3
]
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
X
;
PLongArray
(
Dest
)
[
1
]
:
=
Y
;
end
;
procedure
TCipher_TEAN
.
DoDecode
(
Source
,
Dest
:
Pointer
;
Size
:
Integer
)
;
var
I
:
Integer
;
Sum
,
X
,
Y
:
LongWord
;
K
:
PLongArray
;
begin
Assert
(
Size
=
Context
.
BufferSize
)
;
Sum
:
=
TEA_Delta
*
LongWord
(
FRounds
)
;
X
:
=
PLongArray
(
Source
)
[
0
]
;
Y
:
=
PLongArray
(
Source
)
[
1
]
;
K
:
=
FUser
;
for
I
:
=
0
to
FRounds
-
1
do
begin
Dec
(
Y
,
(
X
shl
4
xor
X
shr
5
)
+
(
X
xor
Sum
)
+
K
[
Sum
shr
11
and
3
]
)
;
Dec
(
Sum
,
TEA_Delta
)
;
Dec
(
X
,
(
Y
shl
4
xor
Y
shr
5
)
+
(
Y
xor
Sum
)
+
K
[
Sum
and
3
]
)
;
end
;
PLongArray
(
Dest
)
[
0
]
:
=
X
;
PLongArray
(
Dest
)
[
1
]
:
=
Y
;
end
;
end
.