kjkim
/
BSOne.SFC
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Tocsg.Lib

This commit is contained in:
mgkim 2025-12-30 14:39:40 +09:00
parent 6a2a92146a
commit 7c31171391
200 changed files with 129991 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1493
Tocsg.Lib/VCL/CS/Tocsg.ClientBase.pas Normal file
View File

File diff suppressed because it is too large Load Diff

600
Tocsg.Lib/VCL/CS/Tocsg.Packet.pas Normal file
View File

@ -0,0 +1,600 @@
{*******************************************************}
{ }
{ Tocsg.Packet }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit Tocsg.Packet;
interface
uses
Tocsg.Obj, Tocsg.Exception, System.SysUtils, Winapi.Windows,
superobject, System.Classes;
const
SIZE_INTEGER = SizeOf(Integer);
CTX_PACKET_SIGNATURE: AnsiString = '@OC$.G';
LEN_CTX_PACKET_SIGNATURE = 6;
type
// Server -> Client
PCtxPacketHeader = ^TCtxPacketHeader;
TCtxPacketHeader = packed record
sSig: array [0..5] of AnsiChar; // #SPK.$$
wRank: WORD;
dwId,
dwSize: DWORD;
end;
// 종류 추가 되면 패킷 해더의 wRank 수정해야함
TTgPacketKind = (pkNormal, pkFileQueue, pkIgnore, pkCritical);
TTgPacketHeader = record
Cmd,
Result: Integer;
Toss,
Handle,
WndMessage: LONGLONG;
ResultMsg: String;
PacketKind: TTgPacketKind;
end;
TSnTextEncoding = System.SysUtils.TEncoding;
TSnBytes = TBytes;
ETgPacket = class(ETgException);
ITgPacket = interface
['{5F9E8D1B-7371-41D2-AA7A-E8DDAE3788B9}']
function _GetPacketHeader: TTgPacketHeader;
function _GetJsonObject: ISuperObject;
function ToJsonString: String;
function ToBytes(var SnBytes: TSnBytes): Integer;
function ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
function SaveToFile(sPath: String): Boolean;
end;
ISendPacket = interface(ITgPacket)
['{0322E57A-C699-40BE-B0DF-64B9A69A5701}']
function GetCommand: Integer;
procedure SetPacketKind(aPacketKind: TTgPacketKind);
function GetPacketKind: TTgPacketKind;
procedure SetHandle(llHandle: LONGLONG);
procedure SetWndMessage(llWndMessage: LONGLONG);
procedure SetToss(llToss: LONGLONG);
procedure SetResult(nResult: Integer);
procedure SetResultMsg(const sResultMsg: String);
function GetResult: Integer;
function GetResultMsg: String;
function GetSocket: TObject;
procedure SetSocket(aSocket: TObject);
function GetO(const sPath: String): ISuperObject;
procedure PutO(const sPath: String; const Value: ISuperObject);
procedure PutB(const sPath: String; Value: Boolean);
procedure PutI(const sPath: String; Value: SuperInt);
procedure PutC(const sPath: String; Value: Currency);
procedure PutD(const sPath: String; Value: Double);
procedure PutS(const sPath: String; const Value: String);
property Command: Integer read GetCommand;
property Handle: LONGLONG write SetHandle;
property WndMessage: LONGLONG write SetWndMessage;
property Toss: LONGLONG write SetToss;
property Result: Integer read GetResult write SetResult;
property ResultMsg: String read GetResultMsg write SetResultMsg;
property PacketKind: TTgPacketKind read GetPacketKind write SetPacketKind;
property Socket: TObject read GetSocket write SetSocket;
property O[const sPath: String]: ISuperObject read GetO write PutO; default;
property B[const sPath: String]: Boolean write PutB;
property I[const sPath: String]: SuperInt write PutI;
property D[const sPath: String]: Double write PutD;
property C[const sPath: String]: Currency write PutC;
property S[const sPath: String]: String write PutS;
end;
IRcvPacket = interface(ITgPacket)
['{C1BFCE0F-1B34-4FCC-84AC-4F24CA6D72A5}']
function GetCommand: Integer;
function GetPacketKind: TTgPacketKind;
function GetHandle: LONGLONG;
function GetWndMessage: LONGLONG;
function GetToss: LONGLONG;
function GetResult: Integer;
function GetResultMsg: String;
function GetSocket: TObject;
function GetRcvPacketSize: DWORD;
function ToJsonString: String;
function GetO(const sPath: String): ISuperObject;
function GetB(const sPath: String): Boolean;
function GetI(const sPath: String): SuperInt;
function GetD(const sPath: String): Double;
function GetC(const sPath: String): Currency;
function GetS(const sPath: String): String;
function GetA(const sPath: String): TSuperArray;
property Command: Integer read GetCommand;
property PacketKind: TTgPacketKind read GetPacketKind;
property Handle: LONGLONG read GetHandle;
property WndMessage: LONGLONG read GetWndMessage;
property Toss: LONGLONG read GetToss;
property Result: Integer read GetResult;
property ResultMsg: String read GetResultMsg;
property Socket: TObject read GetSocket;
property RcvPacketSize: DWORD read GetRcvPacketSize;
property O[const sPath: String]: ISuperObject read GetO; default;
property B[const sPath: String]: Boolean read GetB;
property I[const sPath: String]: SuperInt read GetI;
property D[const sPath: String]: Double read GetD;
property C[const sPath: String]: Currency read GetC;
property S[const sPath: String]: String read GetS;
property A[const sPath: String]: TSuperArray read GetA;
end;
TTgPacket = class(TInterfacedObject, ITgPacket, ISendPacket, IRcvPacket)
protected
Socket_: TObject;
PacketHeader_: TTgPacketHeader;
SuperObject_: ISuperObject;
dwRcvLen_: DWORD;
function _GetPacketHeader: TTgPacketHeader;
function _GetJsonObject: ISuperObject;
procedure PutO(const sPath: String; const Value: ISuperObject);
procedure PutB(const sPath: String; Value: Boolean);
procedure PutI(const sPath: String; Value: SuperInt);
procedure PutC(const sPath: String; Value: Currency);
procedure PutD(const sPath: String; Value: Double);
procedure PutS(const sPath: String; const Value: String);
function GetO(const sPath: String): ISuperObject;
function GetB(const sPath: String): Boolean;
function GetI(const sPath: String): SuperInt;
function GetD(const sPath: String): Double;
function GetC(const sPath: String): Currency;
function GetS(const sPath: String): String;
function GetA(const sPath: String): TSuperArray;
function GetCommand: Integer;
procedure SetPacketKind(aPacketKind: TTgPacketKind);
function GetPacketKind: TTgPacketKind;
procedure SetHandle(llHandle: LONGLONG);
function GetHandle: LONGLONG;
procedure SetWndMessage(llWndMessage: LONGLONG);
function GetWndMessage: LONGLONG;
procedure SetToss(llToss: LONGLONG);
function GetToss: LONGLONG;
procedure SetResult(nResult: Integer);
function GetResult: Integer;
procedure SetResultMsg(const sResultMsg: String);
function GetResultMsg: String;
function GetSocket: TObject;
procedure SetSocket(aSocket: TObject);
function GetRcvPacketSize: DWORD; // for IRcvPacket
public
Constructor Create; overload;
Constructor Create(const aCmd: Integer; PacketKind: TTgPacketKind = pkNormal); overload;
Constructor Create(aPacket: ITgPacket; PacketKind: TTgPacketKind = pkNormal); overload;
Constructor Create(const aRcvData: Pointer; nRcvLen: Integer); overload;
Constructor Create(const aRcvData: TSnBytes; bIncludeLen: Boolean = false; aSocket: TObject= nil{for ClientContext}); overload;
Constructor Create(aSocket: TObject{for ClientContext}; const aRcvData: Pointer; nRcvLen: Integer); overload;
Constructor Create(const sJsonData: String); overload;
function ToJsonString: String;
function ToBytes(var SnBytes: TSnBytes): Integer;
function ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
function SaveToFile(sPath: String): Boolean;
property Command: Integer read GetCommand;
property PacketKind: TTgPacketKind read GetPacketKind;
property Toss: LONGLONG read GetToss write SetToss;
property Handle: LONGLONG read GetHandle write SetHandle;
property WndMessage: LONGLONG read GetWndMessage write SetWndMessage;
property Result: Integer read GetResult write SetResult;
property ResultMsg: String read GetResultMsg write SetResultMsg;
property Socket: TObject read GetSocket write SetSocket;
property O[const sPath: String]: ISuperObject read GetO write PutO; default;
property B[const sPath: String]: Boolean read GetB write PutB;
property I[const sPath: String]: SuperInt read GetI write PutI;
property D[const sPath: String]: Double read GetD write PutD;
property C[const sPath: String]: Currency read GetC write PutC;
property S[const sPath: String]: String read GetS write PutS;
end;
const
LEN_CTX_PACKET_HEADER = SizeOf(TCtxPacketHeader);
BUFFER_SIZE = 32 * 1024;
MAX_BUF_LEN = BUFFER_SIZE;
implementation
uses
Tocsg.Safe, Tocsg.JSON;
{ TTgPacket }
Constructor TTgPacket.Create;
begin
Inherited Create;
ZeroMemory(@PacketHeader_, SizeOf(PacketHeader_));
dwRcvLen_ := 0;
end;
Constructor TTgPacket.Create(const aCmd: Integer; PacketKind: TTgPacketKind = pkNormal);
begin
Create;
PacketHeader_.Cmd := aCmd;
PacketHeader_.PacketKind := PacketKind;
SuperObject_ := TSuperObject.Create;
end;
Constructor TTgPacket.Create(aPacket: ITgPacket; PacketKind: TTgPacketKind = pkNormal);
begin
Create;
PacketHeader_ := aPacket._GetPacketHeader;
SuperObject_ := aPacket._GetJsonObject;
PacketHeader_.PacketKind := PacketKind;
end;
Constructor TTgPacket.Create(const aRcvData: TSnBytes; bIncludeLen: Boolean = false; aSocket: TObject = nil{for ClientContext});
procedure ExtractData;
var
nDataLen: Integer;
sJsonData: UTF8String;
begin
nDataLen := 0;
if bIncludeLen then
begin
dwRcvLen_ := Length(aRcvData);
if dwRcvLen_ < 4 then
raise ETgPacket.Create('Rcv 버퍼가 손상되었습니다.');
CopyMemory(@nDataLen, @aRcvData[0], SIZE_INTEGER);
if nDataLen <> (dwRcvLen_ - SIZE_INTEGER) then
begin
raise ETgPacket.CreateFmt('Rcv 데이터 크기가 잘못되었습니다. (DataLen = %d, RcvBufLen = %d',
[nDataLen, dwRcvLen_ - SIZE_INTEGER]);
end;
SetLength(sJsonData, nDataLen);
CopyMemory(@sJsonData[1], @aRcvData[4], nDataLen);
end else begin
nDataLen := Length(aRcvData);
dwRcvLen_ := nDataLen;
SetLength(sJsonData, nDataLen);
CopyMemory(@sJsonData[1], @aRcvData[0], nDataLen);
end;
SuperObject_ := SO(sJsonData);
try
with SuperObject_['Header'], PacketHeader_ do
begin
Cmd := I['Cmd'];
Handle := I['Handle'];
WndMessage := I['WndMessage'];
PacketKind := TTgPacketKind(I['PacketKind']);
Result := I['Result'];
Toss := I['Toss'];
ResultMsg := S['ResultMsg'];
end;
except
raise ETgPacket.Create('Invalid packet ..');
end;
end;
begin
Create;
Socket_ := aSocket;
ExtractData;
end;
Constructor TTgPacket.Create(aSocket: TObject{for ClientContext}; const aRcvData: Pointer; nRcvLen: Integer);
begin
Create(aRcvData, nRcvLen);
Socket_ := aSocket;
end;
Constructor TTgPacket.Create(const aRcvData: Pointer; nRcvLen: Integer);
procedure ExtractData;
var
sJsonData: UTF8String;
begin
dwRcvLen_ := nRcvLen;
SetLength(sJsonData, nRcvLen);
CopyMemory(@sJsonData[1], aRcvData, nRcvLen);
SuperObject_ := SO(sJsonData);
try
with SuperObject_['Header'], PacketHeader_ do
begin
Cmd := I['Cmd'];
Handle := I['Handle'];
WndMessage := I['WndMessage'];
PacketKind := TTgPacketKind(I['PacketKind']);
Result := I['Result'];
Toss := I['Toss'];
ResultMsg := S['ResultMsg'];
end;
except
raise ETgPacket.Create('Invalid packet ..');
end;
end;
begin
Create;
ExtractData;
end;
Constructor TTgPacket.Create(const sJsonData: String);
begin
Inherited Create;
SuperObject_ := SO(sJsonData);
with SuperObject_['Header'], PacketHeader_ do
begin
Cmd := I['Cmd'];
Handle := I['Handle'];
WndMessage := I['WndMessage'];
PacketKind := TTgPacketKind(I['PacketKind']);
Result := I['Result'];
Toss := I['Toss'];
ResultMsg := S['ResultMsg'];
end;
end;
function TTgPacket._GetPacketHeader: TTgPacketHeader;
begin
Result := PacketHeader_;
end;
function TTgPacket._GetJsonObject: ISuperObject;
begin
Result := SuperObject_;
end;
function TTgPacket.ToJsonString: String;
var
O: ISuperObject;
begin
Result := '';
if SuperObject_ <> nil then
begin
O := SO;
with PacketHeader_, O do
begin
I['Cmd'] := Cmd;
if Handle <> 0 then
I['Handle'] := Handle;
if WndMessage <> 0 then
I['WndMessage'] := WndMessage;
if PacketKind <> pkNormal then
I['PacketKind'] := Integer(PacketKind);
if Result <> 0 then
I['Result'] := Result;
if Toss <> 0 then
I['Toss'] := Toss;
if ResultMsg <> '' then
S['ResultMsg'] := ResultMsg;
end;
SuperObject_.O['Header'] := O;
Result := SuperObject_.AsJSon;
end;
end;
function TTgPacket.ToBytes(var SnBytes: TSnBytes): Integer;
var
sJsonData: UTF8String;
nDataLen: Integer;
begin
Result := 0;
sJsonData := UTF8Encode(ToJsonString);
if sJsonData <> '' then
begin
nDataLen := Length(sJsonData);
Result := SIZE_INTEGER + Length(sJsonData);
SetLength(SnBytes, Result);
CopyMemory(@SnBytes[0], @nDataLen, SIZE_INTEGER);
CopyMemory(@SnBytes[4], @sJsonData[1], nDataLen);
// SetLength(sJsonData, 0);
end;
end;
function TTgPacket.ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
var
sJsonData: UTF8String;
begin
Result := 0;
sJsonData := UTF8Encode(ToJsonString);
if sJsonData <> '' then
begin
Result := Length(sJsonData);
SetLength(SnBytes, Result);
CopyMemory(@SnBytes[0], @sJsonData[1], Result);
end;
end;
function TTgPacket.SaveToFile(sPath: String): Boolean;
var
ss: TStringStream;
begin
Result := false;
try
Guard(ss, TStringStream.Create(ToJsonString, TEncoding.UTF8));
ss.SaveToFile(sPath);
Result := true;
except
//
end;
end;
procedure TTgPacket.PutO(const sPath: String; const Value: ISuperObject);
begin
SuperObject_.O[sPath] := Value;
end;
procedure TTgPacket.PutB(const sPath: String; Value: Boolean);
begin
SuperObject_.B[sPath] := Value;
end;
procedure TTgPacket.PutI(const sPath: String; Value: SuperInt);
begin
SuperObject_.I[sPath] := Value;
end;
procedure TTgPacket.PutC(const sPath: String; Value: Currency);
begin
SuperObject_.C[sPath] := Value;
end;
procedure TTgPacket.PutD(const sPath: String; Value: Double);
begin
SuperObject_.D[sPath] := Value;
end;
procedure TTgPacket.PutS(const sPath: String; const Value: String);
begin
SuperObject_.S[sPath] := Value;
end;
function TTgPacket.GetO(const sPath: String): ISuperObject;
begin
Result := SuperObject_.O[sPath];
end;
function TTgPacket.GetB(const sPath: String): Boolean;
begin
Result := SuperObject_.B[sPath];
end;
function TTgPacket.GetI(const sPath: String): SuperInt;
begin
Result := SuperObject_.I[sPath];
end;
function TTgPacket.GetD(const sPath: String): Double;
begin
Result := SuperObject_.D[sPath];
end;
function TTgPacket.GetC(const sPath: String): Currency;
begin
Result := SuperObject_.C[sPath];
end;
function TTgPacket.GetS(const sPath: String): String;
begin
Result := SuperObject_.S[sPath];
end;
function TTgPacket.GetA(const sPath: String): TSuperArray;
begin
Result := SuperObject_.A[sPath];
end;
function TTgPacket.GetCommand: Integer;
begin
Result := PacketHeader_.Cmd;
end;
procedure TTgPacket.SetPacketKind(aPacketKind: TTgPacketKind);
begin
if PacketHeader_.PacketKind <> aPacketKind then
PacketHeader_.PacketKind := aPacketKind;
end;
function TTgPacket.GetPacketKind: TTgPacketKind;
begin
Result := PacketHeader_.PacketKind;
end;
procedure TTgPacket.SetHandle(llHandle: LONGLONG);
begin
if PacketHeader_.Handle <> llHandle then
PacketHeader_.Handle := llHandle;
end;
function TTgPacket.GetHandle: LONGLONG;
begin
Result := PacketHeader_.Handle;
end;
procedure TTgPacket.SetWndMessage(llWndMessage: LONGLONG);
begin
if PacketHeader_.WndMessage <> llWndMessage then
PacketHeader_.WndMessage := llWndMessage;
end;
function TTgPacket.GetWndMessage: LONGLONG;
begin
Result := PacketHeader_.WndMessage;
end;
procedure TTgPacket.SetToss(llToss: LONGLONG);
begin
if PacketHeader_.Toss <> llToss then
PacketHeader_.Toss := llToss;
end;
function TTgPacket.GetToss: LONGLONG;
begin
Result := PacketHeader_.Toss;
end;
procedure TTgPacket.SetResult(nResult: Integer);
begin
if PacketHeader_.Result <> nResult then
PacketHeader_.Result := nResult;
end;
function TTgPacket.GetResult: Integer;
begin
Result := PacketHeader_.Result;
end;
procedure TTgPacket.SetResultMsg(const sResultMsg: String);
begin
if PacketHeader_.ResultMsg <> sResultMsg then
PacketHeader_.ResultMsg := sResultMsg;
end;
function TTgPacket.GetResultMsg: String;
begin
Result := PacketHeader_.ResultMsg;
end;
function TTgPacket.GetSocket: TObject;
begin
Result := Socket_;
{$IFDEF DEBUG}
if Result = nil then
raise ETgPacket.Create('소켓이 지정 되지있지 않습니다.');
{$ENDIF}
end;
procedure TTgPacket.SetSocket(aSocket: TObject);
begin
if Socket_ <> aSocket then
Socket_ := aSocket;
end;
function TTgPacket.GetRcvPacketSize: DWORD;
begin
Result := dwRcvLen_;
end;
end.

33
Tocsg.Lib/VCL/CS/Tocsg.PacketDefine.pas Normal file
View File

@ -0,0 +1,33 @@
{*******************************************************}
{ }
{ Tocsg.PacketDefine }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit Tocsg.PacketDefine;
interface
uses
Winapi.Windows;
const
TYPE_O_AGENT = 101;
VER_O_AGENT = '1';
ENC_PASSPASS = 'Irydk2P%a0*';
TOC_TEST = 9999;
TOC_PING = 10000;
TOC_CLIENT_INFO = 10001;
TOC_CONFIRM_PACKET_ENCRYPT = 10002;
TOC_UPDATE_PACKET_ENCRYPT = 10003;
TOC_REQUEST_CONFIRM_PACKET_ENCRYPT = 10004;
TOC_PC_INFO = 11001;
TOC_INST_INFO = 11002;
implementation
end.

2872
Tocsg.Lib/VCL/CS/Tocsg.ServerBase.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1194
Tocsg.Lib/VCL/CS/Tocsg.StoredPacket.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2
Tocsg.Lib/VCL/EncLib/AES/!bdll.bat Normal file
View File

@ -0,0 +1,2 @@
::call b3 -b -dDLL AES_DLL.DPR
call b10 -b -dDLL AES_DLL.DPR

325
Tocsg.Lib/VCL/EncLib/AES/#ca.bat Normal file
View File

@ -0,0 +1,325 @@
@echo off
rem generic compile batch file for most console compilers
rem pause after each compiler if %1 not empty
rem call self on low env space condition
rem (c) 2003-2008 W.Ehrhardt
rem test file
rem =========
::set SRC=T_GSpeed
::set SRC=T_AESCRP
::set SRC=T_CYCCNT
::set SRC=T_FBMODI
set SRC=T_AES_WS
::set SRC=T_EAX2
::set SRC=t_cprf
::set SRC=T_XTS
rem log file (may be con or nul)
rem ============================
::set LOG=nul
set LOG=%SRC%.LOG
rem parameters for test file
rem ========================
set PARA=test
rem build options
rem ========================
::set OPT=-ddebug
rem test whether enough space in environment
rem =========================================
set PCB=A_rather_long_environment_string_for_testing
if (%PCB%)==(A_rather_long_environment_string_for_testing) goto OK
rem call self with 4096 byte env
rem ============================
set PCB=
%COMSPEC% /E:4096 /C %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
goto ende
:OK
echo Test %SRC% for most console compilers >%LOG%
ver >>%LOG%
set PCB=bpc -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=bpc -CP -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc1 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc2 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc22 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc222 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc224 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc240 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc242 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc244 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc260 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc262 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc264d -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc264 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc300 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc302 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc311 -B
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call vpc -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call p5 -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call p55 -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call p6 -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M2\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M3\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M4\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M5\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M6\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M7\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M9\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
call wdosx %SRC%.exe
echo. >>%LOG%
echo Results for WDOSX >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M10\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M12\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M17\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M18\DCC32.EXE -b
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
echo.
echo **** Log file: %LOG%
:ende
set PCB=
set SRC=
set LOG=
set PARA=
set OPT=

250
Tocsg.Lib/VCL/EncLib/AES/#ca_dll.bat Normal file
View File

@ -0,0 +1,250 @@
@echo off
rem Tests with AES_DLL. Compile batch file for most console compilers
rem pause after each compiler if %1 not empty
rem call self on low env space condition
rem (c) 2003-2008 W.Ehrhardt
if exist aes_dll.dll goto dll_found
echo AES_DLL.DLL not found
goto ende
:dll_found
set SRC=T_AES_WS
::set SRC=T_CMAC
::set SRC=T_CBCCTS
::set SRC=T_XTS
::set SRC=T_AESCCM
rem log file (may be con or nul)
rem ============================
::set LOG=nul
set LOG=%SRC%.LOD
rem parameters for test file
rem ========================
set PARA=test
rem test whether enough space in environment
rem ========================================
set PCB=A_rather_long_environment_string_for_testing
if (%PCB%)==(A_rather_long_environment_string_for_testing) goto OK
rem call self with 4096 byte env
rem ============================
set PCB=
%COMSPEC% /E:4096 /C %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
goto ende
:OK
echo Test %SRC% for all win32 compilers >%LOG%
ver >>%LOG%
set PCB=call fpc2 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc22 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc222 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc224 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc240 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc242 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc244 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc260 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc264 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc300 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc302 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call fpc311 -B -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=call vpc -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M2\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M3\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M4\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M5\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M6\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M7\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M9\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M10\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M12\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M17\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
set PCB=D:\DMX\M18\DCC32.EXE -b -dUSEDLL
del %SRC%.exe >nul
%PCB% %OPT% %SRC%.pas
if not (%1%)==() pause
echo. >>%LOG%
echo Results for %PCB% >>%LOG%
%SRC%.exe %PARA% >>%LOG%
echo.
echo **** Log file: %LOG%
:ende
set PCB=
set SRC=
set LOG=
set PARA=

78
Tocsg.Lib/VCL/EncLib/AES/#times.aes Normal file
View File

@ -0,0 +1,78 @@
Times in [s] for 512 MB: 128 bit key, 1.8 GHz P4, Win98
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Package/Compiler CTR CFB OFB ECB CBC OMAC
LibTom117/VC6 13.0 16.3 16.4 12.9 13.9 15.6
LTC117/GCC4.2.1 10.1 14.5 10.6 9.0 9.3 14.2
dcpcrypt2/D6 28.8 32.7 28.6 - 32.7 -
DEC5.1/D6 - 13.9 10.9 10.2 11.8 -
StrSecII/D6 9.0 11.5 9.1 7.7 9.3 -
WE/D3 9.0 8.1 8.1 7.7 9.1 9.1
WE/D6 9.0 8.0 8.0 7.7 8.4 9.1
WE/FPC 2.0.2 12.5 12.5 12.4 11.3 14.1 13.1
WE/FPC 2.2 -O3 9.9 9.1 9.1 9.0 11.2 9.0
WE/VPC 2.1 10.4 10.2 10.3 9.3 13.9 12.0
WE/BP7 47.1 41.4 41.4 34.3 51.0 45.3
Cycles (Fun=enc/dec, Bit=key size) compared to Gladman (ASM/C++)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Func/Bit ASM C++ D6 VPC FPC2 BP7
Enc/128 295 385 370 425 542 1490
Dec/128 293 376 382 405 549 1545
Enc/192 352 439 434 532 643 1768
Dec/192 346 443 451 476 648 1723
Enc/256 403 497 498 580 745 1948
Dec/256 407 507 518 549 749 1971
Cycles for encrypt/decrypt and key setup
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
D3
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 516 515 883 1668 55.6
192 448 446 743 1364 64.0
128 380 379 740 1260 75.5
D6
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 498 518 918 1648 57.6
192 434 451 732 1457 66.1
128 370 382 802 1338 77.5
D10
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 516 510 1029 1772 55.6
192 448 442 770 1398 64.0
128 380 377 814 1367 75.5
VP
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 580 549 1356 2134 49.5
192 532 476 1144 1812 53.9
128 425 405 1013 1569 67.5
FPC 1.1.10 DOS
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 745 749 1015 2609 38.5
192 643 648 828 2162 44.7
128 542 549 935 1971 53.0
FPC 2.0.2
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 751 755 1001 2673 38.2
192 648 653 843 2225 44.3
128 546 551 790 1986 52.5
FPC 2.2 -O3
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 572 589 1228 1914 50.1
192 493 506 867 1507 58.2
128 416 428 778 1353 69.0
BP7
KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)
256 1948 1971 5172 7410 14.7
192 1768 1723 4356 6274 16.2
128 1490 1545 4300 5909 19.3

BIN
Tocsg.Lib/VCL/EncLib/AES/$d25.zip Normal file
View File

Binary file not shown.

BIN
Tocsg.Lib/VCL/EncLib/AES/$log_aes.zip Normal file
View File

Binary file not shown.

BIN
Tocsg.Lib/VCL/EncLib/AES/Source.zip/aes_2017-11-17.zip Normal file
View File

Binary file not shown.

174
Tocsg.Lib/VCL/EncLib/AES/_comparm Normal file
View File

@ -0,0 +1,174 @@
#!/bin/bash -e
# Be sure to have LF as EOL
# and to chmod a+x
LOG=aes_arm.log
echo Results for FPC/ARM \(Raspberry Pi 3/B\) > $LOG
uname -a >> $LOG
echo -e -n FPC version \\x20 >> $LOG
fpc -iW >> $LOG
echo ====================================== >> $LOG
SRC=t_aescbc
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aescf8
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aescfb
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aescrp
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aesctr
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aesecb
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aesofb
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aes_as
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aes_cs
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aes_ws
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC test >> $LOG
SRC=t_aes_ws
fpc -dAES_ComprTab $SRC
echo >> $LOG
echo Result of $SRC with AES_ComprTab >> $LOG
echo -------------------------------------- >> $LOG
./$SRC test >> $LOG
SRC=t_aes_xl
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_cbccts
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_cmac
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_cprf
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_eax2
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_ecbcts
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_fbmodi
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_omac
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_xts
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aesccm
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_aesgcm
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG
SRC=t_ppp
fpc $SRC
echo >> $LOG
echo Result of $SRC >> $LOG
echo -------------------------------------- >> $LOG
./$SRC >> $LOG

385
Tocsg.Lib/VCL/EncLib/AES/aes_base.pas Normal file
View File

@ -0,0 +1,385 @@
unit AES_Base;
(*************************************************************************
DESCRIPTION : AES basic routines
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] http://csrc.nist.gov/fips/fips-197.pdf
[2] rijndael-alg-fst.c V2.0/3.0: Rijmen et al Aug1999/Dec2000
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.23 16.08.03 we From AESCrypt
0.24 16.08.03 we new xor_block
0.25 18.09.03 we Static tables, GF routines moved to aes_decr
0.26 21.09.03 we routines as functions
0.27 27.09.03 we FPC/go32v2
0.28 05.10.03 we STD.INC, TP5-6
0.29 07.12.03 we BugFix: exit if invalid key length
0.30 27.12.03 we BASM16: xorblock
0.31 01.01.04 we RotWord inline via shl/shr, SubWord function
0.32 15.01.04 we Keysetup like [2]
0.33 15.01.04 we BIT16: Keysetup with byte arrays
0.34 06.03.04 we removed exit in 128 bit key setup
0.35 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.36 12.10.04 we key setup with pointers
0.37 29.11.04 we FastInit
0.38 30.11.04 we AES_XorBlock, AESBLKSIZE
0.39 24.12.04 we Helper types PWA4, PLong
0.40 24.12.04 we FastInit, AES_Get/SetFastInit
0.41 09.07.06 we Checked: D9-D10
0.42 25.12.12 we {$J+} if needed
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2012 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses AES_Type;
{helper types}
type
TWA4 = packed array[0..3] of longint; {AES block as array of longint}
TBA4 = packed array[0..3] of byte; {AES "word" as array of byte }
TAWk = packed array[0..4*(AESMaxRounds+1)-1] of longint; {Key as array of longint}
PWA4 = ^TWA4;
PAWk = ^TAWk;
{-AES static tables}
const
SBox: array[byte] of byte =
($63, $7c, $77, $7b, $f2, $6b, $6f, $c5, $30, $01, $67, $2b, $fe, $d7, $ab, $76,
$ca, $82, $c9, $7d, $fa, $59, $47, $f0, $ad, $d4, $a2, $af, $9c, $a4, $72, $c0,
$b7, $fd, $93, $26, $36, $3f, $f7, $cc, $34, $a5, $e5, $f1, $71, $d8, $31, $15,
$04, $c7, $23, $c3, $18, $96, $05, $9a, $07, $12, $80, $e2, $eb, $27, $b2, $75,
$09, $83, $2c, $1a, $1b, $6e, $5a, $a0, $52, $3b, $d6, $b3, $29, $e3, $2f, $84,
$53, $d1, $00, $ed, $20, $fc, $b1, $5b, $6a, $cb, $be, $39, $4a, $4c, $58, $cf,
$d0, $ef, $aa, $fb, $43, $4d, $33, $85, $45, $f9, $02, $7f, $50, $3c, $9f, $a8,
$51, $a3, $40, $8f, $92, $9d, $38, $f5, $bc, $b6, $da, $21, $10, $ff, $f3, $d2,
$cd, $0c, $13, $ec, $5f, $97, $44, $17, $c4, $a7, $7e, $3d, $64, $5d, $19, $73,
$60, $81, $4f, $dc, $22, $2a, $90, $88, $46, $ee, $b8, $14, $de, $5e, $0b, $db,
$e0, $32, $3a, $0a, $49, $06, $24, $5c, $c2, $d3, $ac, $62, $91, $95, $e4, $79,
$e7, $c8, $37, $6d, $8d, $d5, $4e, $a9, $6c, $56, $f4, $ea, $65, $7a, $ae, $08,
$ba, $78, $25, $2e, $1c, $a6, $b4, $c6, $e8, $dd, $74, $1f, $4b, $bd, $8b, $8a,
$70, $3e, $b5, $66, $48, $03, $f6, $0e, $61, $35, $57, $b9, $86, $c1, $1d, $9e,
$e1, $f8, $98, $11, $69, $d9, $8e, $94, $9b, $1e, $87, $e9, $ce, $55, $28, $df,
$8c, $a1, $89, $0d, $bf, $e6, $42, $68, $41, $99, $2d, $0f, $b0, $54, $bb, $16);
{$ifdef CONST}
procedure AES_XorBlock(const B1, B2: TAESBlock; var B3: TAESBlock);
{-xor two blocks, result in third}
{$ifdef DLL} stdcall; {$endif}
function AES_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
{$else}
procedure AES_XorBlock(var B1, B2: TAESBlock; var B3: TAESBlock);
{-xor two blocks, result in third}
function AES_Init(var Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
{$endif}
procedure AES_SetFastInit(value: boolean);
{-set FastInit variable}
{$ifdef DLL} stdcall; {$endif}
function AES_GetFastInit: boolean;
{-Returns FastInit variable}
{$ifdef DLL} stdcall; {$endif}
implementation
{$ifdef D4Plus}
var
{$else}
{$ifdef J_OPT} {$J+} {$endif}
const
{$endif}
FastInit : boolean = true; {Clear only necessary context data at init}
{IV and buf remain uninitialized}
const
RCon: array[0..9] of longint= ($01,$02,$04,$08,$10,$20,$40,$80,$1b,$36);
{$ifdef BASM16}
{---------------------------------------------------------------------------}
procedure AES_XorBlock({$ifdef CONST} const {$else} var {$endif} B1, B2: TAESBlock; var B3: TAESBlock);
{-xor two blocks, result in third}
begin
asm
mov di,ds
lds si,[B1]
db $66; mov ax,[si]
db $66; mov bx,[si+4]
db $66; mov cx,[si+8]
db $66; mov dx,[si+12]
lds si,[B2]
db $66; xor ax,[si]
db $66; xor bx,[si+4]
db $66; xor cx,[si+8]
db $66; xor dx,[si+12]
lds si,[B3]
db $66; mov [si],ax
db $66; mov [si+4],bx
db $66; mov [si+8],cx
db $66; mov [si+12],dx
mov ds,di
end;
end;
{$else}
{---------------------------------------------------------------------------}
procedure AES_XorBlock({$ifdef CONST} const {$else} var {$endif} B1, B2: TAESBlock; var B3: TAESBlock);
{-xor two blocks, result in third}
var
a1: TWA4 absolute B1;
a2: TWA4 absolute B2;
a3: TWA4 absolute B3;
begin
a3[0] := a1[0] xor a2[0];
a3[1] := a1[1] xor a2[1];
a3[2] := a1[2] xor a2[2];
a3[3] := a1[3] xor a2[3];
end;
{$endif BASM16}
{---------------------------------------------------------------------------}
function AES_Init({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
var
pK: ^TAWK;
i : integer;
temp: longint;
{$ifdef BIT16}
s: TBA4;
t: TBA4 absolute temp;
{$endif}
Nk: word;
begin
AES_Init := 0;
if FastInit then with ctx do begin
{Clear only the necessary context data at init. IV and buf}
{remain uninitialized, other fields are initialized below.}
bLen :=0;
Flag :=0;
{$ifdef CONST}
IncProc := nil;
{$else}
{TP5-6 do not like IncProc := nil;}
fillchar(IncProc, sizeof(IncProc), 0);
{$endif}
end
else fillchar(ctx, sizeof(ctx), 0);
if (KeyBits<>128) and (KeyBits<>192) and (KeyBits<>256) then begin
AES_Init := AES_Err_Invalid_Key_Size;
exit;
end;
Nk := KeyBits div 32;
Move(Key, ctx.RK, 4*Nk);
ctx.KeyBits := KeyBits;
ctx.Rounds := 6 + Nk;
ctx.Decrypt := 0;
{Calculate encryption round keys, cf.[2]}
pK := addr(ctx.RK);
{$ifdef BIT16}
{16 bit: use byte arrays}
if keybits=128 then begin
for i:=0 to 9 do begin
temp := pK^[3];
{SubWord(RotWord(temp)) if "word" count mod 4 = 0}
s[0] := SBox[t[1]];
s[1] := SBox[t[2]];
s[2] := SBox[t[3]];
s[3] := SBox[t[0]];
pK^[4] := longint(s) xor pK^[0] xor RCon[i];
pK^[5] := pK^[1] xor pK^[4];
pK^[6] := pK^[2] xor pK^[5];
pK^[7] := pK^[3] xor pK^[6];
pK := addr(pK^[4]);
end;
end
else if keybits=192 then begin
for i:=0 to 7 do begin
temp := pK^[5];
{SubWord(RotWord(temp)) if "word" count mod 6 = 0}
s[0] := SBox[t[1]];
s[1] := SBox[t[2]];
s[2] := SBox[t[3]];
s[3] := SBox[t[0]];
pK^[ 6] := longint(s) xor pK^[0] xor RCon[i];
pK^[ 7] := pK^[1] xor pK^[6];
pK^[ 8] := pK^[2] xor pK^[7];
pK^[ 9] := pK^[3] xor pK^[8];
if i=7 then exit;
pK^[10] := pK^[4] xor pK^[ 9];
pK^[11] := pK^[5] xor pK^[10];
pK := addr(pK^[6]);
end;
end
else begin
for i:=0 to 6 do begin
temp := pK^[7];
{SubWord(RotWord(temp)) if "word" count mod 8 = 0}
s[0] := SBox[t[1]];
s[1] := SBox[t[2]];
s[2] := SBox[t[3]];
s[3] := SBox[t[0]];
pK^[ 8] := longint(s) xor pK^[0] xor RCon[i];
pK^[ 9] := pK^[1] xor pK^[ 8];
pK^[10] := pK^[2] xor pK^[ 9];
pK^[11] := pK^[3] xor pK^[10];
if i=6 then exit;
temp := pK^[11];
{SubWord(temp) if "word" count mod 8 = 4}
s[0] := SBox[t[0]];
s[1] := SBox[t[1]];
s[2] := SBox[t[2]];
s[3] := SBox[t[3]];
pK^[12] := longint(s) xor pK^[4];
pK^[13] := pK^[5] xor pK^[12];
pK^[14] := pK^[6] xor pK^[13];
pK^[15] := pK^[7] xor pK^[14];
pK := addr(pK^[8]);
end;
end;
{$else}
{32 bit use shift and mask}
if keybits=128 then begin
for i:=0 to 9 do begin
temp := pK^[3];
{SubWord(RotWord(temp)) if "word" count mod 4 = 0}
pK^[4] := (longint(SBox[(temp shr 8) and $ff]) ) xor
(longint(SBox[(temp shr 16) and $ff]) shl 8) xor
(longint(SBox[(temp shr 24) ]) shl 16) xor
(longint(SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[5] := pK^[1] xor pK^[4];
pK^[6] := pK^[2] xor pK^[5];
pK^[7] := pK^[3] xor pK^[6];
pK := addr(pK^[4]);
end;
end
else if keybits=192 then begin
for i:=0 to 7 do begin
temp := pK^[5];
{SubWord(RotWord(temp)) if "word" count mod 6 = 0}
pK^[ 6] := (longint(SBox[(temp shr 8) and $ff]) ) xor
(longint(SBox[(temp shr 16) and $ff]) shl 8) xor
(longint(SBox[(temp shr 24) ]) shl 16) xor
(longint(SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[ 7] := pK^[1] xor pK^[6];
pK^[ 8] := pK^[2] xor pK^[7];
pK^[ 9] := pK^[3] xor pK^[8];
if i=7 then exit;
pK^[10] := pK^[4] xor pK^[ 9];
pK^[11] := pK^[5] xor pK^[10];
pK := addr(pK^[6]);
end;
end
else begin
for i:=0 to 6 do begin
temp := pK^[7];
{SubWord(RotWord(temp)) if "word" count mod 8 = 0}
pK^[ 8] := (longint(SBox[(temp shr 8) and $ff]) ) xor
(longint(SBox[(temp shr 16) and $ff]) shl 8) xor
(longint(SBox[(temp shr 24) ]) shl 16) xor
(longint(SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[ 9] := pK^[1] xor pK^[ 8];
pK^[10] := pK^[2] xor pK^[ 9];
pK^[11] := pK^[3] xor pK^[10];
if i=6 then exit;
temp := pK^[11];
{SubWord(temp) if "word" count mod 8 = 4}
pK^[12] := (longint(SBox[(temp ) and $ff]) ) xor
(longint(SBox[(temp shr 8) and $ff]) shl 8) xor
(longint(SBox[(temp shr 16) and $ff]) shl 16) xor
(longint(SBox[(temp shr 24) ]) shl 24) xor
pK^[4];
pK^[13] := pK^[5] xor pK^[12];
pK^[14] := pK^[6] xor pK^[13];
pK^[15] := pK^[7] xor pK^[14];
pK := addr(pK^[8]);
end;
end;
{$endif}
end;
{---------------------------------------------------------------------------}
procedure AES_SetFastInit(value: boolean);
{-set FastInit variable}
begin
FastInit := value;
end;
{---------------------------------------------------------------------------}
function AES_GetFastInit: boolean;
{-Returns FastInit variable}
begin
AES_GetFastInit := FastInit;
end;
end.

280
Tocsg.Lib/VCL/EncLib/AES/aes_cbc.pas Normal file
View File

@ -0,0 +1,280 @@
unit AES_CBC;
(*************************************************************************
DESCRIPTION : AES CBC functions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
[4] Cipher text stealing: Schneier, Applied Cryptography 2.ed, ch.9.3
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 20.09.03 we initial version
0.20 21.09.03 we Cipher text stealing
0.21 21.09.03 we with Flag, functions, error codes
0.22 27.09.03 we FPC/go32v2
0.23 03.10.03 we 3-para encr/decr
0.24 03.10.03 we Fix overwrite source bug for decrypt
0.25 05.10.03 we STD.INC, TP5-6
0.26 12.06.04 we uses BLKSIZE constant
0.27 12.06.04 we check for nil pointers
0.28 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.29 30.11.04 we AES_XorBlock, AESBLKSIZE
0.30 01.12.04 we No more processing after short block
0.31 09.07.06 we Checked: D9-D10
0.34 16.11.08 we Use Ptr2Inc from BTypes
0.35 27.07.10 we Longint ILen in AES_CBC_En/Decrypt
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr, AES_Decr;
{$ifdef CONST}
function AES_CBC_Init_Encr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
function AES_CBC_Init_Decr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_CBC_Init_Encr(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CBC_Init_Decr(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$endif}
function AES_CBC_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CBC mode}
{$ifdef DLL} stdcall; {$endif}
function AES_CBC_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CBC mode}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_CBC_Init_Encr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_CBC_Init_Encr(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if invalid key size, encrypt IV}
begin
{-AES key expansion, error if invalid key size}
AES_CBC_Init_Encr := AES_Init_Encr(Key, KeyBits, ctx);
ctx.IV := IV;
end;
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_CBC_Init_Decr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_CBC_Init_Decr(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if invalid key size, encrypt IV}
begin
{-AES key expansion, error if invalid key size}
AES_CBC_Init_Decr := AES_Init_Decr(Key, KeyBits, ctx);
ctx.IV := IV;
end;
{---------------------------------------------------------------------------}
function AES_CBC_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CBC mode}
var
i,n: longint;
m: word;
begin
AES_CBC_Encrypt := 0;
if ILen<0 then ILen := 0;
if ctx.Decrypt<>0 then begin
AES_CBC_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CBC_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CBC_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_CBC_Encrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{Short block must be last, no more processing allowed}
if ctx.Flag and 1 <> 0 then begin
AES_CBC_Encrypt := AES_Err_Data_After_Short_Block;
exit;
end;
with ctx do begin
for i:=1 to n do begin
{ct[i] = encr(ct[i-1] xor pt[i]), cf. [3] 6.2}
AES_XorBlock(PAESBlock(ptp)^, IV, IV);
AES_Encrypt(ctx, IV, IV);
PAESBlock(ctp)^ := IV;
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing}
AES_XorBlock(PAESBlock(ptp)^, IV, IV);
AES_Encrypt(ctx, IV, IV);
buf := IV;
inc(Ptr2Inc(ptp),AESBLKSIZE);
for i:=0 to m-1 do IV[i] := IV[i] xor PAESBlock(ptp)^[i];
AES_Encrypt(ctx, IV, PAESBlock(ctp)^);
inc(Ptr2Inc(ctp),AESBLKSIZE);
move(buf,PAESBlock(ctp)^,m);
{Set short block flag}
Flag := Flag or 1;
end;
end;
end;
{---------------------------------------------------------------------------}
function AES_CBC_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CBC mode}
var
i,n: longint;
m: word;
tmp: TAESBlock;
begin
AES_CBC_Decrypt := 0;
if ILen<0 then ILen := 0;
if ctx.Decrypt=0 then begin
AES_CBC_Decrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CBC_Decrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CBC_Decrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_CBC_Decrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{Short block must be last, no more processing allowed}
if ctx.Flag and 1 <> 0 then begin
AES_CBC_Decrypt := AES_Err_Data_After_Short_Block;
exit;
end;
with ctx do begin
for i:=1 to n do begin
{pt[i] = decr(ct[i]) xor ct[i-1]), cf. [3] 6.2}
buf := IV;
IV := PAESBlock(ctp)^;
AES_Decrypt(ctx, IV, PAESBlock(ptp)^);
AES_XorBlock(PAESBlock(ptp)^, buf, PAESBlock(ptp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing, L=ILen (Schneier's n)}
buf := IV; {C(L-2)}
AES_Decrypt(ctx, PAESBlock(ctp)^, IV);
inc(Ptr2Inc(ctp),AESBLKSIZE);
fillchar(tmp,sizeof(tmp),0);
move(PAESBlock(ctp)^,tmp,m); {c[L]|0}
AES_XorBlock(tmp,IV,IV);
tmp := IV;
move(PAESBlock(ctp)^,tmp,m); {c[L]| C'}
AES_Decrypt(ctx,tmp,tmp);
AES_XorBlock(tmp, buf, PAESBlock(ptp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
move(IV,PAESBlock(ptp)^,m);
{Set short block flag}
Flag := Flag or 1;
end;
end;
end;
end.

377
Tocsg.Lib/VCL/EncLib/AES/aes_ccm.pas Normal file
View File

@ -0,0 +1,377 @@
unit AES_CCM;
(*************************************************************************
DESCRIPTION : AES Counter with CBC-MAC (CCM) mode functions
REQUIREMENTS : TP5-7, D1-D7/D9-D12/D17-D18, FPC, VP, WDOSX
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REMARKS : - The IV and buf fields of the contexts are used for temporary buffers
- Tag compare is constant time but if verification fails,
then plaintext is zero-filled
- Maximum header length is $FEFF
- Since CCM was designed for use in a packet processing
environment, there are no incremental functions. The ..Ex
functions can be used together with AES_Init_Encr to save
key setup overhead if the same key is used more than once.
REFERENCES : [1] RFC 3610, D. Whiting et al., Counter with CBC-MAC (CCM)
http://tools.ietf.org/html/rfc3610
[2] NIST Special Publication 800-38C, Recommendation for
Block Cipher Modes of Operation: The CCM Mode for
Authentication and Confidentiality
http://csrc.nist.gov/publications/nistpubs/800-38C/SP800-38C_updated-July20_2007.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.01 17.05.09 we Initial version
0.02 17.05.09 we Process full blocks, procedure IncCTR
0.03 17.05.09 we Remove adjustment of nLen
0.04 18.05.09 we Check static ranges and conditions, simplify ecoding of L in B0
0.05 18.05.09 we Check nLen
0.06 18.05.09 we Simplify encoding of l(m)
0.07 19.05.09 we Use ctx.IV, ctx.buf, ctx.bLen
0.08 19.05.09 we TP5-6
0.09 20.05.09 we Simplified functions
0.10 20.05.09 we If verification fails, ptp^ is zero-filled
0.11 21.05.09 we Special length check for BIT16
0.12 21.05.09 we ctx as var parameter in Ex functions
0.13 28.07.10 we Fix: Check ofs(dtp^) for 16 bit
0.14 31.08.15 we constant time compare in AES_CCM_Dec_VeriEX
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2009-2015 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
function AES_CCM_Enc_AuthEx(var ctx: TAESContext;
var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-CCM packet encrypt/authenticate without key setup}
function AES_CCM_Enc_Auth(var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} Key; KBytes: word; {key and byte length of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-All-in-one call for CCM packet encrypt/authenticate}
function AES_CCM_Dec_VeriEX(var ctx: TAESContext;
ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-CCM packet decrypt/verify without key setup. If ptag^ verification fails, ptp^ is zero-filled!}
function AES_CCM_Dec_Veri( ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} Key; KBytes: word; {key and byte length of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-All-in-one CCM packet decrypt/verify. If ptag^ verification fails, ptp^ is zero-filled!}
implementation
{---------------------------------------------------------------------------}
function AES_CCM_Core(var ctx: TAESContext; enc_auth: boolean;
var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
pnonce: pointer; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length, hLen <$FF00}
stp: pointer; sLen: longint; {source text: address / length}
dtp: pointer {dest. text: address}
): integer;
{-CCM core routine. Encrypt or decrypt (depending on enc_auth) source text}
{ to dest. text and calculate the CCM tag. Key setup must be done from caller}
var
ecc: TAESBlock; {encrypted counter}
err: integer;
len: longint;
k, L: word;
b: byte;
pb: pByte;
procedure IncCTR(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[16-L]}
var
j: integer;
begin
for j:=15 downto 16-L do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
begin
{Check static ranges and conditions}
if (sLen>0) and ((stp=nil) or (dtp=nil)) then err := AES_Err_NIL_Pointer
else if odd(tLen) or (tLen<4) or (tLen>16) then err := AES_Err_CCM_Tag_length
else if (hLen>0) and (hdr=nil) then err := AES_Err_NIL_Pointer
else if hLen>=$FF00 then err := AES_Err_CCM_Hdr_length
else if (nLen<7) or (nLen>13) then err := AES_Err_CCM_Nonce_length
{$ifdef BIT16}
else if (ofs(stp^)+sLen>$FFFF) or (ofs(dtp^)+sLen>$FFFF) then err := AES_Err_CCM_Text_length
{$endif}
else err := 0;
AES_CCM_Core := err;
if err<>0 then exit;
{calculate L value = max(number of bytes needed for sLen, 15-nLen)}
len := sLen;
L := 0;
while len>0 do begin
inc(L);
len := len shr 8;
end;
if nLen+L > 15 then begin
AES_CCM_Core := AES_Err_CCM_Nonce_length;
exit;
end;
{Force nLen+L=15. Since nLen<=13, L is at least 2}
L := 15-nLen;
with ctx do begin
{compose B_0 = Flags | Nonce N | l(m)}
{octet 0: Flags = 64*HdrPresent | 8*((tLen-2) div 2 | (L-1)}
if hLen>0 then b := 64 else b := 0;
buf[0] := b or ((tLen-2) shl 2) or (L-1);
{octets 1..15-L is nonce}
pb := pnonce;
for k:=1 to 15-L do begin
buf[k] := pb^;
inc(Ptr2Inc(pb));
end;
{octets 16-L .. 15: l(m)}
len := sLen;
for k:=1 to L do begin
buf[16-k] := len and $FF;
len := len shr 8;
end;
AES_Encrypt(ctx, buf, buf);
{process header}
if hLen > 0 then begin
{octets 0..1: encoding of hLen. Note: since we allow max $FEFF bytes}
{only these two octets are used. Generally up to 10 octets are needed.}
buf[0] := buf[0] xor (hLen shr 8);
buf[1] := buf[1] xor (hLen and $FF);
{now append the hdr data}
blen:= 2;
pb := hdr;
for k:=1 to hLen do begin
if blen=16 then begin
AES_Encrypt(ctx, buf, buf);
blen := 0;
end;
buf[blen] := buf[blen] xor pb^;
inc(blen);
inc(Ptr2Inc(pb));
end;
if blen<>0 then AES_Encrypt(ctx, buf, buf);
end;
{setup the counter for source text processing}
pb := pnonce;
IV[0] := (L-1) and $FF;
for k:=1 to 15 do begin
if k<16-L then begin
IV[k] := pb^;
inc(Ptr2Inc(pb));
end
else IV[k] := 0;
end;
{process full source text blocks}
while sLen>=16 do begin
IncCTR(IV);
AES_Encrypt(ctx,IV,ecc);
if enc_auth then begin
AES_XorBlock(PAESBlock(stp)^, buf, buf);
AES_XorBlock(PAESBlock(stp)^, ecc, PAESBlock(dtp)^);
end
else begin
AES_XorBlock(PAESBlock(stp)^, ecc, PAESBlock(dtp)^);
AES_XorBlock(PAESBlock(dtp)^, buf, buf);
end;
AES_Encrypt(ctx, buf, buf);
inc(Ptr2Inc(stp), AESBLKSIZE);
inc(Ptr2Inc(dtp), AESBLKSIZE);
dec(sLen, AESBLKSIZE);
end;
if sLen>0 then begin
{handle remaining bytes of source text}
IncCTR(IV);
AES_Encrypt(ctx, IV, ecc);
for k:=0 to word(sLen-1) do begin
if enc_auth then begin
b := pByte(stp)^;
pByte(dtp)^ := b xor ecc[k];
end
else begin
b := pByte(stp)^ xor ecc[k];
pByte(dtp)^ := b;
end;
buf[k] := buf[k] xor b;
inc(Ptr2Inc(stp));
inc(Ptr2Inc(dtp));
end;
AES_Encrypt(ctx, buf, buf);
end;
{setup counter for the tag (zero the count)}
for k:=15 downto 16-L do IV[k] := 0;
AES_Encrypt(ctx, IV, ecc);
{store the TAG}
AES_XorBlock(buf, ecc, tag);
end;
end;
{---------------------------------------------------------------------------}
function AES_CCM_Enc_AuthEx(var ctx: TAESContext;
var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-CCM packet encrypt/authenticate without key setup}
begin
AES_CCM_Enc_AuthEx := AES_CCM_Core(ctx,true,tag,tLen,@nonce,nLen,hdr,hLen,ptp,pLen,ctp);
end;
{---------------------------------------------------------------------------}
function AES_CCM_Enc_Auth(var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} Key; KBytes: word;{key and byte length of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-All-in-one call for CCM packet encrypt/authenticate}
var
ctx: TAESContext;
err: integer;
begin
err := AES_Init_Encr(Key, KBytes*8, ctx);
if err<>0 then AES_CCM_Enc_Auth := err
else AES_CCM_Enc_Auth := AES_CCM_Core(ctx,true,tag,tLen,@nonce,nLen,hdr,hLen,ptp,pLen,ctp);
fillchar(ctx, sizeof(ctx), 0);
end;
{---------------------------------------------------------------------------}
function AES_CCM_Dec_VeriEX(var ctx: TAESContext;
ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-CCM packet decrypt/verify without key setup. If ptag^ verification fails, ptp^ is zero-filled!}
var
tag: TAESBlock;
err,i: integer;
diff: byte;
begin
err := AES_CCM_Core(ctx,false,tag,tLen,@nonce,nLen,hdr,hLen,ctp,cLen,ptp);
if err=0 then begin
diff := 0;
for i:=0 to pred(tLen) do begin
diff := diff or (pByte(ptag)^ xor tag[i]);
inc(Ptr2Inc(ptag));
end;
err := (((integer(diff)-1) shr 8) and 1)-1; {0 compare, -1 otherwise}
err := err and AES_Err_CCM_Verify_Tag;
end;
fillchar(tag, sizeof(tag),0);
AES_CCM_Dec_VeriEx := err;
if err<>0 then fillchar(ptp^, cLen, 0);
end;
{---------------------------------------------------------------------------}
function AES_CCM_Dec_Veri( ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
{$ifdef CONST}const{$else}var{$endif} Key; KBytes: word;{key and byte length of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-All-in-one CCM packet decrypt/verify. If ptag^ verification fails, ptp^ is zero-filled!}
var
ctx: TAESContext;
err: integer;
begin
err := AES_Init_Encr(Key, KBytes*8, ctx);
if err<>0 then AES_CCM_Dec_Veri := err
else AES_CCM_Dec_Veri := AES_CCM_Dec_VeriEX(ctx,ptag,tLen,nonce,nLen,hdr,hLen,ctp,cLen,ptp);
fillchar(ctx, sizeof(ctx), 0);
end;
end.

219
Tocsg.Lib/VCL/EncLib/AES/aes_cfb.pas Normal file
View File

@ -0,0 +1,219 @@
unit AES_CFB;
(*************************************************************************
DESCRIPTION : AES CFB128 functions
Because of buffering en/decrypting is associative
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 16.08.03 we initial version
0.11 21.09.03 we functions, error codes
0.12 27.09.03 we FPC/go32v2
0.13 03.10.03 we 3-para encr/decr
0.14 05.10.03 we STD.INC, TP5-6
0.15 01.01.04 we Handle full blocks first
0.16 01.01.04 we Decrypt: bugfix for ctp=ptp
0.17 12.06.04 we uses BLKSIZE constant
0.18 12.06.04 we check for nil pointers
0.19 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.20 30.11.04 we AES_XorBlock, AESBLKSIZE
0.21 09.07.06 we Checked: D9-D10
0.22 16.11.08 we Use Ptr2Inc, pByte from BTypes
0.23 27.07.10 we Longint ILen in AES_CFB_En/Decrypt
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
{$ifdef CONST}
function AES_CFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_CFB_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$endif}
function AES_CFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB128 mode}
{$ifdef DLL} stdcall; {$endif}
function AES_CFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB128 mode}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_CFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_CFB_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if invalid key size, encrypt IV}
var
err: integer;
begin
{-AES key expansion, error if invalid key size}
err := AES_Init_Encr(Key, KeyBits, ctx);
AES_CFB_Init := err;
if err=0 then begin
{encrypt IV}
AES_Encrypt(ctx, IV, ctx.IV);
end;
end;
{---------------------------------------------------------------------------}
function AES_CFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB128 mode}
begin
AES_CFB_Encrypt := 0;
if ctx.Decrypt<>0 then begin
AES_CFB_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CFB_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CFB_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
if ctx.blen=0 then begin
{Handle full blocks first}
while ILen>=AESBLKSIZE do with ctx do begin
{Cipher text = plain text xor encr(IV/CT), cf. [3] 6.3}
AES_XorBlock(PAESBlock(ptp)^, IV, PAESBlock(ctp)^);
AES_Encrypt(ctx, PAESBlock(ctp)^, IV);
inc(Ptr2Inc(ptp), AESBLKSIZE);
inc(Ptr2Inc(ctp), AESBLKSIZE);
dec(ILen, AESBLKSIZE);
end;
end;
{Handle remaining bytes}
while ILen>0 do with ctx do begin
{Test buffer empty}
if bLen>=AESBLKSIZE then begin
AES_Encrypt(ctx, buf, IV);
bLen := 0;
end;
buf[bLen] := IV[bLen] xor pByte(ptp)^;
pByte(ctp)^ := buf[bLen];
inc(bLen);
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
{---------------------------------------------------------------------------}
function AES_CFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB128 mode}
begin
AES_CFB_Decrypt := 0;
if ctx.Decrypt<>0 then begin
AES_CFB_Decrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CFB_Decrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CFB_Decrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
if ctx.blen=0 then begin
{Handle full blocks first}
while ILen>=AESBLKSIZE do with ctx do begin
{plain text = cypher text xor encr(IV/CT), cf. [3] 6.3}
{must use buf, otherwise overwrite bug if ctp=ptp}
buf := PAESBlock(ctp)^;
AES_XorBlock(buf, IV, PAESBlock(ptp)^);
AES_Encrypt(ctx, buf, IV);
inc(Ptr2Inc(ptp), AESBLKSIZE);
inc(Ptr2Inc(ctp), AESBLKSIZE);
dec(ILen, AESBLKSIZE);
end;
end;
{Handle remaining bytes}
while ILen>0 do with ctx do begin
{Test buffer empty}
if bLen>=AESBLKSIZE then begin
AES_Encrypt(ctx, buf, IV);
bLen := 0;
end;
buf[bLen] := pByte(ctp)^;
pByte(ptp)^ := buf[bLen] xor IV[bLen];
inc(bLen);
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
end.

177
Tocsg.Lib/VCL/EncLib/AES/aes_cfb8.pas Normal file
View File

@ -0,0 +1,177 @@
unit AES_CFB8;
(*************************************************************************
DESCRIPTION : AES CFB8 functions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 25.12.07 W.Ehrhardt Initial encrypt version
0.11 25.12.07 we AES_CFB8_Decrypt
0.12 16.11.08 we Use Ptr2Inc, pByte from BTypes
0.13 27.07.10 we Longint ILen in AES_CFB8_En/Decrypt
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2007-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
{$ifdef CONST}
function AES_CFB8_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, store IV}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_CFB8_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, store IV}
{$endif}
function AES_CFB8_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB8 mode}
{$ifdef DLL} stdcall; {$endif}
function AES_CFB8_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB8 mode}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_CFB8_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_CFB8_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if invalid key size, store IV}
var
err: integer;
begin
{-AES key expansion, error if invalid key size}
err := AES_Init_Encr(Key, KeyBits, ctx);
AES_CFB8_Init := err;
if err=0 then ctx.IV := IV;
end;
{---------------------------------------------------------------------------}
function AES_CFB8_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB8 mode}
begin
AES_CFB8_Encrypt := 0;
if ctx.Decrypt<>0 then begin
AES_CFB8_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CFB8_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CFB8_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
{Encrypt ILen bytes from ptp^ to ctp^ in CFB8 mode}
while ILen>0 do with ctx do begin
AES_Encrypt(ctx, IV, buf);
{encrypt next btye}
pByte(ctp)^ := buf[0] xor pByte(ptp)^;
{shift 8 bits}
move(IV[1],IV[0],AESBLKSIZE-1);
IV[AESBLKSIZE-1] := pByte(ctp)^;
{increment pointers}
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
{---------------------------------------------------------------------------}
function AES_CFB8_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB8 mode}
begin
AES_CFB8_Decrypt := 0;
if ctx.Decrypt<>0 then begin
AES_CFB8_Decrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CFB8_Decrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CFB8_Decrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
{Decrypt ILen bytes from ctp^ to ptp^ in CFB8 mode}
while ILen>0 do with ctx do begin
AES_Encrypt(ctx, IV, buf);
{shift 8 bits}
move(IV[1],IV[0],AESBLKSIZE-1);
IV[AESBLKSIZE-1] := pByte(ctp)^;
{decrypt next byte}
pByte(ptp)^ := buf[0] xor pByte(ctp)^;
{increment pointers}
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
end.

117
Tocsg.Lib/VCL/EncLib/AES/aes_cmac.pas Normal file
View File

@ -0,0 +1,117 @@
unit AES_CMAC;
(*************************************************************************
DESCRIPTION : AES CMAC routines
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] NIST Special Publication 800-38B, Recommendation for Block
Cipher Modes of Operation: The CMAC Mode for Authentication
http://csrc.nist.gov/publications/nistpubs/800-38B/SP_800-38B.pdf
[2] OMAC page: http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/omac.html
[3] T.Iwata and K.Kurosawa. OMAC: One-Key CBC MAC - Addendum
http://csrc.nist.gov/CryptoToolkit/modes/proposedmodes/omac/omac-ad.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version, wrapper for OMAC
0.11 09.07.06 we Calls to AES_OMAC_UpdateXL, AES_OMACx_Final
0.12 28.07.10 we AES_CMAC_Update with ILen: longint, XL Version with $define OLD_XL_Version
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2006-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
AES_Type, AES_OMAC;
function AES_CMAC_Init({$ifdef CONST} const Key {$else} var Key {$endif}; KeyBits: word; var ctx: TAESContext): integer;
{-CMAC init: AES key expansion, error if inv. key size}
{$ifdef DLL} stdcall; {$endif}
function AES_CMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-CMAC data input, may be called more than once}
{$ifdef DLL} stdcall; {$endif}
procedure AES_CMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate CMAC=OMAC1 tag}
{$ifdef DLL} stdcall; {$endif}
{$ifdef OLD_XL_Version}
function AES_CMAC_UpdateXL (data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-CMAC data input, may be called more than once}
{$endif}
implementation
{---------------------------------------------------------------------------}
function AES_CMAC_Init({$ifdef CONST} const Key {$else} var Key {$endif}; KeyBits: word; var ctx: TAESContext): integer;
{-CMAC init: AES key expansion, error if inv. key size}
begin
AES_CMAC_Init := AES_OMAC_Init(Key, KeyBits, ctx);
end;
{$ifdef OLD_XL_Version}
{---------------------------------------------------------------------------}
function AES_CMAC_UpdateXL (data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-CMAC data input, may be called more than once}
begin
AES_CMAC_UpdateXL := AES_OMAC_Update(data, ILen, ctx);
end;
{$endif}
{---------------------------------------------------------------------------}
function AES_CMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-CMAC data input, may be called more than once}
begin
AES_CMAC_Update := AES_OMAC_Update(data, ILen, ctx);;
end;
{---------------------------------------------------------------------------}
procedure AES_CMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate CMAC=OMAC1 tag}
begin
AES_OMACx_Final(false, tag, ctx);
end;
end.

69
Tocsg.Lib/VCL/EncLib/AES/aes_conf.inc Normal file
View File

@ -0,0 +1,69 @@
(*************************************************************************
DESCRIPTION : AES configuration include file
REQUIREMENTS : TP5-7, D1-D7/D9-D10, FPC, VP (Undef BASM16 for 286)
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version
0.11 09.07.06 we Common defines for encrypt/decryt tables
0.12 19.07.06 we Cond. defines AES_Diag, AES_Encr/Decr_DummyAlign
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2006 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{Use additional 1K expanded able Te4/Td4 for last encryption round}
{.$define AES_LONGBOX}
{Use 2K tables TCe/TCd instead of four 1K tables Te0 .. Te3, Td0 .. Td3}
{.$define AES_ComprTab}
{Interface some diagnostic data, eg Enc/Dec table offsets mod 16}
{$define AES_Diag}
{Use to align TCe to 8 byte boundary, inserts dummy longint}
{Inspect the map file and/or use AES_Diag/TCe_Diag}
{.$define AES_Encr_DummyAlign}
{Use to align TCd to 8 byte boundary, inserts dummy longint}
{Inspect the map file and/or use AES_Diag/TCd_Diag}
{.$define AES_Decr_DummyAlign}
{---------------------------------------------------------------------------}
{Consistency check - do not change!}
{$ifdef AES_ComprTab}
{$ifdef AES_LONGBOX}
{$undef AES_LONGBOX}
{$endif}
{$endif}

137
Tocsg.Lib/VCL/EncLib/AES/aes_cprf.pas Normal file
View File

@ -0,0 +1,137 @@
unit aes_cprf;
{Variable-length key AES CMAC Pseudo-Random Function-128}
{$i STD.INC}
interface
uses
AES_Type, AES_OMAC;
(*************************************************************************
DESCRIPTION : Variable-length key AES CMAC Pseudo-Random Function-128
REQUIREMENTS : TP5-7, D1-D7/D9-D10, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] RFC 4615: The Advanced Encryption Standard-Cipher-based
Message Authentication Code-Pseudo-Random Function-128
(AES-CMAC-PRF-128) Algorithm for the Internet Key
Exchange Protocol (IKE)
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 28.05.07 W.Ehrhardt Initial version
0.11 28.05.07 we function returns OMAC results
0.12 16.06.07 we AES_CPRF128_selftest stdcall
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2007 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
function AES_CPRF128({$ifdef CONST} const Key {$else} var Key {$endif}; KeyBytes: word;
msg: pointer; msglen: longint; var PRV: TAESBlock): integer;
{Calculate variable-length key AES CMAC Pseudo-Random Function-128 for msg}
{returns AES_OMAC error and 128-bit pseudo-random value PRV}
{$ifdef DLL} stdcall; {$endif}
function AES_CPRF128_selftest: boolean;
{-Selftest with RFC 4615 test vectors}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
function AES_CPRF128({$ifdef CONST} const Key {$else} var Key {$endif}; KeyBytes: word;
msg: pointer; msglen: longint; var PRV: TAESBlock): integer;
{Calculate variable-length key AES CMAC Pseudo-Random Function-128 for msg}
{returns AES_OMAC error and 128-bit pseudo-random value PRV}
var
LK: TAESBlock; {local 128 bit key}
ctx: TAESContext;
err: integer;
const
ZB: TAESBlock = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
begin
if KeyBytes=16 then begin
{If the key, is exactly 128 bits, then we use it as-is (copy to local)}
move(Key, LK, 16);
err := 0;
end
else begin
{If key length is not 128 bits, then we derive the local key LK by
applying the AES-CMAC algorithm using a 128-bit zero as the CMAC key
and Key as the input message: LK := AES-CMAC(0, Key, KeyBytes)}
err := AES_OMAC_Init(ZB, 128, ctx);
if err=0 then err := AES_OMAC_Update(@Key, KeyBytes, ctx);
if err=0 then AES_OMAC_Final(LK, ctx);
end;
{PRV := AES-CMAC(LK, msg, msglen)}
if err=0 then err := AES_OMAC_Init(LK, 128, ctx);
if err=0 then err := AES_OMAC_Update(msg, msglen, ctx);
if err=0 then AES_OMAC_Final(PRV, ctx);
AES_CPRF128 := err;
end;
{---------------------------------------------------------------------------}
function AES_CPRF128_selftest: boolean;
{-Selftest with RFC 4615 test vectors}
var
PRV: TAESBlock;
i,j: integer;
const
{Test vectors from RFC section 4, Message is fix}
msg: array[0..19] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,
$0a,$0b,$0c,$0d,$0e,$0f,$10,$11,$12,$13);
{Base key is fix, but test three diffenrent length >16, =16, <16}
key: array[0..17] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,
$0a,$0b,$0c,$0d,$0e,$0f,$ed,$cb);
KL: array[1..3] of word =(18,16,10);
{PRF outputs}
PRA: array[1..3] of TAESBlock = (($84,$a3,$48,$a4,$a4,$5d,$23,$5b,$ab,$ff,$fc,$0d,$2b,$4d,$a0,$9a),
($98,$0a,$e8,$7b,$5f,$4c,$9c,$52,$14,$f5,$b6,$a8,$45,$5e,$4c,$2d),
($29,$0d,$9e,$11,$2e,$db,$09,$ee,$14,$1f,$cf,$64,$c0,$b7,$2f,$3d));
begin
AES_CPRF128_selftest := false;
for i:=1 to 3 do begin
if AES_CPRF128(Key, KL[i], @msg, sizeof(msg), PRV)<>0 then exit;
for j:=0 to 15 do if PRV[j]<>PRA[i][j] then exit;
end;
AES_CPRF128_selftest := true;
end;
end.

350
Tocsg.Lib/VCL/EncLib/AES/aes_ctr.pas Normal file
View File

@ -0,0 +1,350 @@
unit AES_CTR;
(*************************************************************************
DESCRIPTION : AES CTR mode functions
Because of buffering en/decrypting is associative
User can supply a custom increment function
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
REMARKS : - If a predefined or user-supplied INCProc is used, it must
be set before using AES_CTR_Seek.
- AES_CTR_Seek may be time-consuming for user-defined
INCProcs, because this function is called many times.
See AES_CTR_Seek how to provide user-supplied short-cuts.
WARNING : - CTR mode demands that the same key / initial CTR pair is
never reused for encryption. This requirement is especially
important for the CTR_Seek function. If different data is
written to the same position there will be leakage of
information about the plaintexts. Therefore CTR_Seek should
normally be used for random reads only.
- Default IncProc changed to IncMSBFull in V0.30, for old
defaults call AES_SetIncProc(AES_IncMSBPart,.) after AES_CTR_Init
or (less flexible) set DefaultIncMSBPart := true
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 16.08.03 we initial version
0.20 15.09.03 we use IncProc, with IncLSB, IncMSB
0.21 20.09.03 we fixed obscure FPC @ bug
0.22 21.09.03 we functions, error codes
0.23 27.09.03 we FPC/go32v2
0.24 03.10.03 we 3-para encr/decr
0.25 05.10.03 we STD.INC, TP5-6
0.26 05.10.03 we SetIncProc, Init without IncP
0.27 05.10.03 we Bugfix for FPC: @ and IncProc
0.28 01.01.04 we Handle full blocks first
0.30 11.06.04 we 4 IncProcs, default IncMSBFull
0.31 12.06.04 we uses BLKSIZE constant
0.32 12.06.04 we check for nil pointers
0.33 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.34 30.11.04 we AES_XorBlock, AESBLKSIZE
0.35 01.12.04 we AES_ prefix for increment routines
0.36 09.07.06 we Checked: D9-D10
0.37 23.06.07 we Use conditional define FPC_ProcVar
0.38 21.06.08 we Make IncProcs work with FPC -dDebug
0.39 16.11.08 we Use Ptr2Inc, pByte from BTypes
0.40 19.06.10 we Initial version of AES_CTR_Seek
0.41 20.06.10 we AES_CTR_Seek: calculate IV if IncProc is known
0.42 20.06.10 we AES_CTR_Seek64
0.43 21.06.10 we AES_CTR_Seek: Fix loop for user-defined IncProcs
0.44 27.07.10 we Longint ILen in AES_CTR_En/Decrypt
0.45 31.07.10 we AES_CTR_Seek source moved to aes_seek.inc
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
const
DefaultIncMSBPart: boolean = false; {if true use AES_IncMSBPart as default}
{$ifdef CONST}
function AES_CTR_Init(const Key; KeyBits: word; const CTR: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if inv. key size, encrypt CTR}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_CTR_Init(var Key; KeyBits: word; var CTR: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if inv. key size, encrypt CTR}
{$endif}
{$ifndef DLL}
function AES_CTR_Seek({$ifdef CONST}const{$else}var{$endif} iCTR: TAESBlock;
SOL, SOH: longint; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SOH*2^32+SOL,}
{ SOH >= 0. iCTR is the initial CTR for offset 0, i.e. the same as in AES_CTR_Init.}
{$ifdef HAS_INT64}
function AES_CTR_Seek64(const iCTR: TAESBlock; SO: int64; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SO >= 0;}
{ iCTR is the initial CTR value for offset 0, i.e. the same as in AES_CTR_Init.}
{$endif}
{$endif}
function AES_CTR_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode}
{$ifdef DLL} stdcall; {$endif}
function AES_CTR_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode}
{$ifdef DLL} stdcall; {$endif}
function AES_SetIncProc(IncP: TIncProc; var ctx: TAESContext): integer;
{-Set user supplied IncCTR proc}
{$ifdef DLL} stdcall; {$endif}
procedure AES_IncMSBFull(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[0]}
{$ifdef DLL} stdcall; {$endif}
procedure AES_IncLSBFull(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[15]}
{$ifdef DLL} stdcall; {$endif}
procedure AES_IncMSBPart(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[8]}
{$ifdef DLL} stdcall; {$endif}
procedure AES_IncLSBPart(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[7]}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
procedure AES_IncMSBPart(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[8]}
var
j: integer;
begin
for j:=15 downto 8 do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure AES_IncLSBPart(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[7]}
var
j: integer;
begin
for j:=0 to 7 do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure AES_IncMSBFull(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[0]}
var
j: integer;
begin
for j:=15 downto 0 do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure AES_IncLSBFull(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[15]}
var
j: integer;
begin
for j:=0 to 15 do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
function AES_SetIncProc(IncP: TIncProc; var ctx: TAESContext): integer;
{-Set user supplied IncCTR proc}
begin
AES_SetIncProc := AES_Err_MultipleIncProcs;
with ctx do begin
{$ifdef FPC_ProcVar}
if IncProc=nil then begin
IncProc := IncP;
AES_SetIncProc := 0;
end;
{$else}
if @IncProc=nil then begin
IncProc := IncP;
AES_SetIncProc := 0;
end;
{$endif}
end;
end;
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_CTR_Init(const Key; KeyBits: word; const CTR: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_CTR_Init(var Key; KeyBits: word; var CTR: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if inv. key size, encrypt CTR}
var
err: integer;
begin
{AES key expansion, error if inv. key size}
err := AES_Init_Encr(Key, KeyBits, ctx);
if (err=0) and DefaultIncMSBPart then begin
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncMSBPart, ctx);
{$else}
err := AES_SetIncProc(AES_IncMSBPart, ctx);
{$endif}
end;
if err=0 then begin
ctx.IV := CTR;
{encrypt CTR}
AES_Encrypt(ctx, CTR, ctx.buf);
end;
AES_CTR_Init := err;
end;
{---------------------------------------------------------------------------}
function AES_CTR_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode}
begin
AES_CTR_Encrypt := 0;
if ctx.Decrypt<>0 then begin
AES_CTR_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_CTR_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_CTR_Encrypt := AES_Err_NIL_Pointer; {nil pointer to block with nonzero length}
exit;
end;
end;
if ctx.blen=0 then begin
{Handle full blocks first}
while ILen>=AESBLKSIZE do with ctx do begin
{Cipher text = plain text xor encr(CTR), cf. [3] 6.5}
AES_XorBlock(PAESBlock(ptp)^, buf, PAESBlock(ctp)^);
inc(Ptr2Inc(ptp), AESBLKSIZE);
inc(Ptr2Inc(ctp), AESBLKSIZE);
dec(ILen, AESBLKSIZE);
{use AES_IncMSBFull if IncProc=nil}
{$ifdef FPC_ProcVar}
if IncProc=nil then AES_IncMSBFull(IV) else IncProc(IV);
{$else}
if @IncProc=nil then AES_IncMSBFull(IV) else IncProc(IV);
{$endif}
AES_Encrypt(ctx, IV, buf);
end;
end;
{Handle remaining bytes}
while ILen>0 do with ctx do begin
{Refill buffer with encrypted CTR}
if bLen>=AESBLKSIZE then begin
{use AES_IncMSBFull if IncProc=nil}
{$ifdef FPC_ProcVar}
if IncProc=nil then AES_IncMSBFull(IV) else IncProc(IV);
{$else}
if @IncProc=nil then AES_IncMSBFull(IV) else IncProc(IV);
{$endif}
AES_Encrypt(ctx, IV, buf);
bLen := 0;
end;
{Cipher text = plain text xor encr(CTR), cf. [3] 6.5}
pByte(ctp)^ := buf[bLen] xor pByte(ptp)^;
inc(bLen);
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
{---------------------------------------------------------------------------}
function AES_CTR_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode}
begin
{Decrypt = encrypt for CTR mode}
AES_CTR_Decrypt := AES_CTR_Encrypt(ctp, ptp, ILen, ctx);
end;
{$ifndef DLL}
{$i aes_seek.inc}
{$endif}
end.

191
Tocsg.Lib/VCL/EncLib/AES/aes_decr.pas Normal file
View File

@ -0,0 +1,191 @@
unit AES_Decr;
(*************************************************************************
DESCRIPTION : AES decrypt functions
(not needed for CFB/CTR/OFB mode)
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] http://csrc.nist.gov/fips/fips-197.pdf
[2] rijndael-alg-fst.c V2.0/3.0: Rijmen et al Aug1999/Dec2000
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.22 16.08.03 we longint statt word32
0.23 16.08.03 we separate aes_decr
0.24 16.08.03 we new xor_block
0.25 18.09.03 we Static tables, GF routines from aes_base, D4+
0.26 20.09.03 we optimized round code, no more move/if
0.27 21.09.03 we with Flag, functions, error codes
0.28 27.09.03 we without GFMul and -tables
0.29 27.09.03 we FPC/go32v2
0.30 28.09.03 we reorder round loop: gain 1 transformation t->block
0.31 28.09.03 we merge last xorblock
0.32 28.09.03 we two rounds in each loop
0.33 03.10.03 we 3-para encr/decr
0.34 03.10.03 we two local blocks if partial unroll
0.35 03.10.03 we BASM for BP7
0.36 04.10.03 we remove add di,4
0.37 05.10.03 we STD.INC, TP6
0.38 05.10.03 we TP5,TP5.5
0.39 28.12.03 we DPerm removed
0.40 29.12.03 we BASM16: Bugfix if seg(BO)<>ds, xorblock in asm
0.41 29.12.03 we Delphi/VP: Pointer version
0.42 29.12.03 we InvMixColumn with SBox,T5..T8, Bugfix
0.43 29.12.03 we InvMixColumn with TBA4 if not BIT32
0.44 15.01.04 we InvMixColumn inline
0.45 16.01.04 we MakeDecrKey as BIT32, BASM16, BIT16
0.46 14.08.04 we UseLongBox/Td4
0.47 30.11.04 we AES_XorBlock, AESBLKSIZE
0.48 24.12.04 we STD code and Td0..Td3 like [2], AES_DECR ifdefs
0.49 24.12.04 we New ifdef logic, move replacement code to inc
0.50 24.12.04 we TP5/5.5 with round key pointer
0.51 24.12.04 we Fully unrolled 32 bit in dec_full.inc
0.52 24.12.04 we BASM16: lea trick for 4*bx
0.53 25.12.04 we BIT32: rearrange loop for descending key access
0.54 27.12.04 we All: rearrange loop for descending key access
0.55 04.03.05 we FPC 1.9.8, STD.INC V1.10, StrictLong
0.56 05.05.05 we $R- for StrictLong, D9: errors if $R+ even if warnings off
0.57 09.07.06 we Compressed tables, code in INC files
0.58 19.07.06 we TCd_Diag
0.59 21.11.08 we Use __P2I from BTypes
0.60 01.12.12 we separate BIT64 include statements
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2012 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses AES_Type, AES_Base;
{$i aes_conf.inc}
{$ifdef AES_Diag}
{$ifdef AES_ComprTab}
var
TCd_Diag: integer; {offset of TCd table mod 15}
{should be 0 or 8 for optimal alignment}
{$endif}
{$endif}
{$ifdef CONST}
function AES_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, InvMixColumn(Key) for Decypt, error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
procedure AES_Decrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_Init_Decr(var Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, InvMixColumn(Key) for Decypt, error if invalid key size}
procedure AES_Decrypt(var ctx: TAESContext; var BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
{$endif}
implementation
uses BTypes;
type
PLong = ^longint;
{$ifdef AES_ComprTab}
{$i dec_cdat.inc}
{$ifndef BIT16}
{$ifdef BIT64}
{$i dec_cp16.inc} {This version is faster for FPC260/Win7-64!!!}
{$else}
{$i dec_cp32.inc}
{$endif}
{$else}
{$ifdef BASM16}
{$i dec_ca16.inc}
{$else}
{$i dec_cp16.inc}
{$endif}
{$endif}
{$else}
{$i dec_fdat.inc}
{$ifndef BIT16}
{$ifdef BIT64}
{$i dec_fp16.inc} {This version is faster for FPC260/Win7-64!!!}
{$else}
{$i dec_fp32.inc}
{$endif}
{$else}
{$ifdef BASM16}
{$i dec_fa16.inc}
{$else}
{$i dec_fp16.inc}
{$endif}
{$endif}
{$endif}
{---------------------------------------------------------------------------}
function AES_Init_Decr({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, InvMixColumn(Key) for decrypt, error if invalid key size}
begin
AES_Init_Decr := AES_Init(Key, KeyBits, ctx);
MakeDecrKey(ctx);
ctx.Decrypt := 1;
end;
{$ifdef AES_ComprTab}
begin
{$ifdef AES_Diag}
TCd_Diag := __P2I(@TCd) and 15;
{$endif}
{$ifdef AES_Decr_DummyAlign}
if TCdDummy<>0 then ;
{$endif}
{$endif}
end.

168
Tocsg.Lib/VCL/EncLib/AES/aes_dll.dpr Normal file
View File

@ -0,0 +1,168 @@
library AES_DLL;
{$ifndef DLL}
error('compile with $define DLL');
end.
{$endif}
(*************************************************************************
DESCRIPTION : DLL for AES
REQUIREMENTS : D2-D7/D9-D10/D12, compile with $define DLL
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REMARK : AES_CTR_Seek/64 will be supplied by interface unit
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 02.07.04 W.Ehrhardt Initial version
0.11 30.11.04 we AES_XorBlock, AESBLKSIZE
0.12 01.12.04 we AES_ prefix for CTR increment routines
0.13 24.12.04 we AES_Get/SetFastInit
0.14 09.07.06 we Checked: D9-D10
0.15 09.07.06 we Added CMAC, updated OMAC
0.16 16.06.07 we AES_CPRF128
0.17 29.09.07 we AES_XTS
0.18 25.12.07 we AES_CFB8
0.19 20.07.08 we All-in-one functions AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.20 21.05.09 we AES_CCM
0.21 06.07.09 we AES_DLL_Version returns PAnsiChar
0.22 22.06.10 we AES_CTR_Seek
0.23 27.07.10 we Longint ILen in AES_xxx_En/Decrypt
0.24 28.07.10 we Removed OMAC/CMAC XL versions
0.25 31.07.10 we Removed AES_CTR_Seek (handled in interface unit)
0.26 27.09.10 we AES_GCM
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2004-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
uses
aes_type, aes_base, aes_encr, aes_decr, aes_cfb8,
aes_ctr, aes_cfb, aes_ofb, aes_cbc, aes_ecb,
aes_omac, aes_cmac, aes_eax, aes_cprf, aes_xts,
aes_ccm, aes_gcm;
{$R *.RES}
{---------------------------------------------------------------------------}
function AES_DLL_Version: PAnsiChar; stdcall;
{-Return DLL version as PAnsiChar}
begin
Result := '0.26';
end;
exports AES_DLL_Version name 'AES_DLL_Version';
exports AES_XorBlock name 'AES_XorBlock';
exports AES_SetFastInit name 'AES_SetFastInit';
exports AES_GetFastInit name 'AES_GetFastInit';
exports AES_Init name 'AES_Init';
exports AES_Init_Encr name 'AES_Init_Encr';
exports AES_Encrypt name 'AES_Encrypt';
exports AES_ECB_Init_Encr name 'AES_ECB_Init_Encr';
exports AES_ECB_Init_Decr name 'AES_ECB_Init_Decr';
exports AES_ECB_Encrypt name 'AES_ECB_Encrypt';
exports AES_ECB_Decrypt name 'AES_ECB_Decrypt';
exports AES_Init_Decr name 'AES_Init_Decr';
exports AES_Decrypt name 'AES_Decrypt';
exports AES_CBC_Init_Encr name 'AES_CBC_Init_Encr';
exports AES_CBC_Init_Decr name 'AES_CBC_Init_Decr';
exports AES_CBC_Encrypt name 'AES_CBC_Encrypt';
exports AES_CBC_Decrypt name 'AES_CBC_Decrypt';
exports AES_CFB_Init name 'AES_CFB_Init';
exports AES_CFB_Encrypt name 'AES_CFB_Encrypt';
exports AES_CFB_Decrypt name 'AES_CFB_Decrypt';
exports AES_CFB8_Init name 'AES_CFB8_Init';
exports AES_CFB8_Encrypt name 'AES_CFB8_Encrypt';
exports AES_CFB8_Decrypt name 'AES_CFB8_Decrypt';
exports AES_OFB_Init name 'AES_OFB_Init';
exports AES_OFB_Encrypt name 'AES_OFB_Encrypt';
exports AES_OFB_Decrypt name 'AES_OFB_Decrypt';
exports AES_CTR_Init name 'AES_CTR_Init';
exports AES_CTR_Encrypt name 'AES_CTR_Encrypt';
exports AES_CTR_Decrypt name 'AES_CTR_Decrypt';
exports AES_SetIncProc name 'AES_SetIncProc';
exports AES_IncMSBFull name 'AES_IncMSBFull';
exports AES_IncLSBFull name 'AES_IncLSBFull';
exports AES_IncMSBPart name 'AES_IncMSBPart';
exports AES_IncLSBPart name 'AES_IncLSBPart';
exports AES_OMAC_Init name 'AES_OMAC_Init';
exports AES_OMAC_Update name 'AES_OMAC_Update';
exports AES_OMAC_Final name 'AES_OMAC_Final';
exports AES_OMAC1_Final name 'AES_OMAC1_Final';
exports AES_OMAC2_Final name 'AES_OMAC2_Final';
exports AES_OMACx_Final name 'AES_OMACx_Final';
exports AES_CMAC_Init name 'AES_CMAC_Init';
exports AES_CMAC_Update name 'AES_CMAC_Update';
exports AES_CMAC_Final name 'AES_CMAC_Final';
exports AES_EAX_Init name 'AES_EAX_Init';
exports AES_EAX_Provide_Header name 'AES_EAX_Provide_Header';
exports AES_EAX_Encrypt name 'AES_EAX_Encrypt';
exports AES_EAX_Decrypt name 'AES_EAX_Decrypt';
exports AES_EAX_Final name 'AES_EAX_Final';
exports AES_EAX_Enc_Auth name 'AES_EAX_Enc_Auth';
exports AES_EAX_Dec_Veri name 'AES_EAX_Dec_Veri';
exports AES_CPRF128 name 'AES_CPRF128';
exports AES_CPRF128_selftest name 'AES_CPRF128_selftest';
exports AES_XTS_Init_Encr name 'AES_XTS_Init_Encr';
exports AES_XTS_Encrypt name 'AES_XTS_Encrypt';
exports AES_XTS_Init_Decr name 'AES_XTS_Init_Decr';
exports AES_XTS_Decrypt name 'AES_XTS_Decrypt';
exports AES_CCM_Dec_Veri name 'AES_CCM_Dec_Veri';
exports AES_CCM_Dec_VeriEX name 'AES_CCM_Dec_VeriEX';
exports AES_CCM_Enc_Auth name 'AES_CCM_Enc_Auth';
exports AES_CCM_Enc_AuthEx name 'AES_CCM_Enc_AuthEx';
exports AES_GCM_Init name 'AES_GCM_Init';
exports AES_GCM_Reset_IV name 'AES_GCM_Reset_IV';
exports AES_GCM_Encrypt name 'AES_GCM_Encrypt';
exports AES_GCM_Decrypt name 'AES_GCM_Decrypt';
exports AES_GCM_Add_AAD name 'AES_GCM_Add_AAD';
exports AES_GCM_Final name 'AES_GCM_Final';
exports AES_GCM_Enc_Auth name 'AES_GCM_Enc_Auth';
exports AES_GCM_Dec_Veri name 'AES_GCM_Dec_Veri';
end.

BIN
Tocsg.Lib/VCL/EncLib/AES/aes_dll.res Normal file
View File

Binary file not shown.

362
Tocsg.Lib/VCL/EncLib/AES/aes_eax.pas Normal file
View File

@ -0,0 +1,362 @@
unit AES_EAX;
(*************************************************************************
DESCRIPTION : AES EAX mode functions
REQUIREMENTS : TP5-7, D1-D7/D9-D12/D17-D18, FPC, VP, WDOSX
EXTERNAL DATA : ---
MEMORY USAGE : Stack: local EAX ctx in AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
DISPLAY MODE : ---
REFERENCES : [1] EAX: A Conventional Authenticated-Encryption Mode,
M.Bellare, P.Rogaway, D.Wagner <http://eprint.iacr.org/2003/069>
[2] http://csrc.nist.gov/CryptoToolkit/modes/proposedmodes/eax/eax-spec.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 11.06.04 we initial version (BP7+)
0.11 12.06.04 we uses BLKSIZE constant
0.12 13.06.04 we TP5/5.5/6
0.13 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.14 30.11.04 we AES_XorBlock, AESBLKSIZE
0.15 09.07.06 we Checked: D9-D10
0.16 14.06.07 we Type TAES_EAXContext
0.17 20.07.08 we All-in-one functions AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.18 01.08.08 we Fix for loop in Internal_Veri
0.19 02.08.08 we Local ctx for AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.20 06.08.08 we Suppress D4+ warning
0.21 09.08.08 we Check tLen in ANU_EAX_Dec_Veri
0.22 16.11.08 we Use Ptr2Inc, pByte from BTypes
0.23 27.07.10 we Longint ILen in AES_EAX_En/Decrypt
0.25 31.08.15 we constant time compare in Internal_Veri
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2004-2015 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
{Use TEAXContext for legacy AES_EAX source codes. The new}
{context type TAES_EAXContext should be used instead.}
{.$define Support_Old_AES_EAXContext_Type}
interface
uses
BTypes, AES_Type, AES_Base, AES_CTR, AES_OMAC;
type
TAES_EAXContext = packed record
HdrOMAC : TAESContext; {Hdr OMAC1 context}
MsgOMAC : TAESContext; {Msg OMAC1 context}
ctr_ctx : TAESContext; {Msg AESCTR context}
NonceTag: TAESBlock; {nonce tag }
tagsize : word; {tag size (unused) }
flags : word; {ctx flags (unused)}
end;
{$ifdef Support_Old_AES_EAXContext_Type}
TEAXContext = TAES_EAXContext;
{$endif}
{$ifdef CONST}
function AES_EAX_Init(const Key; KBits: word; const nonce; nLen: word; var ctx: TAES_EAXContext): integer;
{$ifdef DLL} stdcall; {$endif}
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
{$else}
function AES_EAX_Init(var Key; KBits: word; var nonce; nLen: word; var ctx: TAES_EAXContext): integer;
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
{$endif}
function AES_EAX_Provide_Header(Hdr: pointer; hLen: word; var ctx: TAES_EAXContext): integer;
{$ifdef DLL} stdcall; {$endif}
{-Supply a message header. The header "grows" with each call}
function AES_EAX_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{$ifdef DLL} stdcall; {$endif}
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
function AES_EAX_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{$ifdef DLL} stdcall; {$endif}
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
procedure AES_EAX_Final(var tag: TAESBlock; var ctx: TAES_EAXContext);
{$ifdef DLL} stdcall; {$endif}
{-Compute EAX tag from context}
function AES_EAX_Enc_Auth(var tag: TAESBlock; {Tag record}
{$ifdef CONST}const{$else}var{$endif} Key; KBits: word; {key and bitlength of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-All-in-one call to encrypt/authenticate}
function AES_EAX_Dec_Veri( ptag: pointer; tLen: word; {Tag: address / length (0..16)}
{$ifdef CONST}const{$else}var{$endif} Key; KBits: word; {key and bitlength of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{$ifdef DLL} stdcall; {$endif}
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
implementation
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_EAX_Init(const Key; KBits: word; const nonce; nLen: word; var ctx: TAES_EAXContext): integer;
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
{$else}
function AES_EAX_Init(var Key; KBits: word; var nonce; nLen: word; var ctx: TAES_EAXContext): integer;
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
{$endif}
var
err: integer;
t_n: TAESBlock;
begin
fillchar(ctx, sizeof(ctx), 0);
{Initialize OMAC context with key}
err := AES_OMAC_Init(Key, KBits, ctx.HdrOMAC);
if err=0 then begin
{copy fresh context, first use MsgOMAC for nonce OMAC}
ctx.MsgOMAC := ctx.HdrOMAC;
fillchar(t_n, sizeof(t_n), 0);
err := AES_OMAC_Update(@t_n, sizeof(t_n), ctx.MsgOMAC);
if err=0 then err := AES_OMAC_Update(@nonce, nLen, ctx.MsgOMAC);
if err=0 then AES_OMAC_Final(ctx.NonceTag, ctx.MsgOMAC);
{inititialize AES-CTR context}
if err=0 then err := AES_CTR_Init(Key, KBits, ctx.NonceTag, ctx.ctr_ctx);
if err=0 then begin
{initialize msg OMAC}
ctx.MsgOMAC := ctx.HdrOMAC;
t_n[AESBLKSIZE-1] := 2;
err := AES_OMAC_Update(@t_n, sizeof(t_n), ctx.MsgOMAC);
{initialize header OMAC}
t_n[AESBLKSIZE-1] := 1;
if err=0 then err := AES_OMAC_Update(@t_n, sizeof(t_n), ctx.HdrOMAC);
end;
end;
AES_EAX_Init := err;
end;
{---------------------------------------------------------------------------}
function AES_EAX_Provide_Header(Hdr: pointer; hLen: word; var ctx: TAES_EAXContext): integer;
{-Supply a message header. The header "grows" with each call}
begin
AES_EAX_Provide_Header := AES_OMAC_Update(Hdr, hLen, ctx.HdrOMAC);
end;
{---------------------------------------------------------------------------}
function AES_EAX_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
var
err: integer;
begin
{encrypt (and check for nil pointers)}
err := AES_CTR_Encrypt(ptp, ctp, ILen, ctx.ctr_ctx);
if err=0 then begin
{OMAC1 ciphertext}
err := AES_OMAC_Update(ctp, ILen, ctx.MsgOMAC);
end;
AES_EAX_Encrypt := err;
end;
{---------------------------------------------------------------------------}
function AES_EAX_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
var
err: integer;
begin
{OMAC1 ciphertext}
err := AES_OMAC_Update(ctp, ILen, ctx.MsgOMAC);
if err=0 then begin
{decrypt}
err := AES_CTR_Decrypt(ctp, ptp, ILen, ctx.ctr_ctx);
end;
AES_EAX_Decrypt := err;
end;
{---------------------------------------------------------------------------}
procedure AES_EAX_Final(var tag: TAESBlock; var ctx: TAES_EAXContext);
{-Compute EAX tag from context}
var
ht: TAESBlock;
begin
AES_OMAC1_Final(ht, ctx.HdrOMAC);
AES_OMAC1_Final(tag, ctx.MsgOMAC);
AES_XorBlock(tag,ht,tag);
AES_XorBlock(tag,ctx.NonceTag,tag);
end;
{---------------------------------------------------------------------------}
function AES_EAX_Enc_Auth(var tag: TAESBlock; {Tag record}
{$ifdef CONST}const{$else}var{$endif} Key; KBits: word; {key and bitlength of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-All-in-one call to encrypt/authenticate}
var
err : integer;
ILen: word;
ctx : TAES_EAXContext;
const
CHUNK=$8000;
begin
{$ifdef BIT16}
if (pLen>$FFFF) or (ofs(ptp^)+pLen>$FFFF) or (ofs(ctp^)+pLen>$FFFF) then begin
AES_EAX_Enc_Auth := AES_Err_EAX_Inv_Text_Length;
exit;
end;
{$endif}
if (ptp=nil) or (ctp=nil) then begin
if pLen>0 then begin
AES_EAX_Enc_Auth := AES_Err_NIL_Pointer;
exit;
end;
end;
err := AES_EAX_Init(Key, KBits, nonce, nLen, ctx);
if err=0 then err := AES_EAX_Provide_Header(Hdr, hLen, ctx);
while (err=0) and (pLen>0) do begin
if pLen>CHUNK then ILen := CHUNK else ILen := pLen;
err := AES_EAX_Encrypt(ptp, ctp, ILen, ctx);
inc(Ptr2Inc(ptp), ILen);
inc(Ptr2Inc(ctp), ILen);
dec(pLen, ILen);
end;
if err=0 then AES_EAX_Final(tag, ctx);
fillchar(ctx, sizeof(ctx), 0);
AES_EAX_Enc_Auth := err;
end;
{---------------------------------------------------------------------------}
function Internal_Veri(var ctx: TAES_EAXContext; ptag: pointer; tLen: word;
ctp: pointer; cLen: longint): integer;
{-calculate and verify tLen bytes of ptag^, performs OMAC phase of EAX}
var
err,i: integer;
ILen: word;
atag: TAESBlock;
diff: byte;
const
CHUNK=$8000;
begin
{internal, assumes ctx is initialized, nonce and header}
{are processed, cLen, tLen are with in allowed ranges}
err := 0;
{calculate the ciphertext OMAC}
while (err=0) and (cLen>0) do begin
if cLen>CHUNK then ILen := CHUNK else ILen := cLen;
err := AES_OMAC_Update(ctp, ILen, ctx.MsgOMAC);
inc(Ptr2Inc(ctp), ILen);
dec(cLen, ILen);
end;
if (err=0) and (tLen>0) then begin
{calculate actual tag and compare with supplied tag}
AES_EAX_Final(atag, ctx);
diff := 0;
for i:=0 to pred(tLen) do begin
diff := diff or (pByte(ptag)^ xor atag[i]);
inc(Ptr2Inc(ptag));
end;
err := (((integer(diff)-1) shr 8) and 1)-1; {0 compare, -1 otherwise}
err := err and AES_Err_EAX_Verify_Tag;
end;
Internal_Veri := err;
end;
{---------------------------------------------------------------------------}
function AES_EAX_Dec_Veri( ptag: pointer; tLen: word; {Tag: address / length (0..16)}
{$ifdef CONST}const{$else}var{$endif} Key; KBits: word; {key and bitlength of key}
{$ifdef CONST}const{$else}var{$endif} nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
var
err : integer;
ILen: word;
ctx : TAES_EAXContext;
const
CHUNK=$8000;
begin
{$ifdef BIT16}
if (cLen>$FFFF) or (ofs(ptp^)+cLen>$FFFF) or (ofs(ctp^)+cLen>$FFFF) then begin
AES_EAX_Dec_Veri := AES_Err_EAX_Inv_Text_Length;
exit;
end;
{$endif}
if (ptp=nil) or (ctp=nil) then begin
if cLen>0 then begin
AES_EAX_Dec_Veri := AES_Err_NIL_Pointer;
exit;
end;
end;
if tLen>AESBLKSIZE then begin
AES_EAX_Dec_Veri := AES_Err_EAX_Inv_TAG_Length;
exit;
end;
err := AES_EAX_Init(Key, KBits, nonce, nLen, ctx);
if err=0 then err := AES_EAX_Provide_Header(Hdr, hLen, ctx);
if err=0 then begin
{First pass through ciphertext, calculated and compare tag}
err := Internal_Veri(ctx, ptag, tLen, ctp, cLen);
{if error or verfication failed, decrypt loop is skipped}
while (err=0) and (cLen>0) do begin
if cLen>CHUNK then ILen := CHUNK else ILen := cLen;
err := AES_CTR_Decrypt(ctp, ptp, ILen, ctx.ctr_ctx);
inc(Ptr2Inc(ptp), ILen);
inc(Ptr2Inc(ctp), ILen);
dec(cLen, ILen);
end;
end;
fillchar(ctx, sizeof(ctx), 0);
AES_EAX_Dec_Veri:= err;
end;
end.

250
Tocsg.Lib/VCL/EncLib/AES/aes_ecb.pas Normal file
View File

@ -0,0 +1,250 @@
unit AES_ECB;
(*************************************************************************
DESCRIPTION : AES ECB functions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
[4] Cipher text stealing: Schneier, Applied Cryptography 2.ed, ch.9.1
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 21.09.03 we initial version a la CBC
0.11 27.09.03 we FPC/go32v2
0.12 03.10.03 we 3-para encr/decr
0.13 05.10.03 we STD.INC, TP5-6
0.14 12.06.04 we uses BLKSIZE constant
0.15 12.06.04 we check for nil pointers
0.16 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.17 30.11.04 we AES_XorBlock, AESBLKSIZE
0.18 01.12.04 we No more processing after short block
0.19 09.07.06 we Checked: D9-D10
0.20 15.11.08 we Use Ptr2Inc from BTypes
0.21 27.07.10 we Longint ILen in AES_ECB_En/Decrypt
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr, AES_Decr;
{$ifdef CONST}
function AES_ECB_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
function AES_ECB_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_ECB_Init_Encr(var Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_ECB_Init_Decr(var Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$endif}
function AES_ECB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in ECB mode}
{$ifdef DLL} stdcall; {$endif}
function AES_ECB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in ECB mode}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
function AES_ECB_Init_Encr({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
begin
{-AES key expansion, error if invalid key size}
AES_ECB_Init_Encr := AES_Init_Encr(Key, KeyBits, ctx);
end;
{---------------------------------------------------------------------------}
function AES_ECB_Init_Decr({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
begin
{-AES key expansion, error if invalid key size}
AES_ECB_Init_Decr := AES_Init_Decr(Key, KeyBits, ctx);
end;
{---------------------------------------------------------------------------}
function AES_ECB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in ECB mode}
var
i,n: longint;
m: word;
tmp: TAESBlock;
begin
AES_ECB_Encrypt := 0;
if ILen<0 then ILen := 0;
if ctx.Decrypt<>0 then begin
AES_ECB_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_ECB_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_ECB_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_ECB_Encrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{Short block must be last, no more processing allowed}
if ctx.Flag and 1 <> 0 then begin
AES_ECB_Encrypt := AES_Err_Data_After_Short_Block;
exit;
end;
with ctx do begin
for i:=1 to n do begin
AES_Encrypt(ctx, PAESBlock(ptp)^, PAESBlock(ctp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing}
AES_Encrypt(ctx, PAESBlock(ptp)^, buf);
inc(Ptr2Inc(ptp),AESBLKSIZE);
tmp := buf;
move(PAESBlock(ptp)^, tmp, m);
AES_Encrypt(ctx, tmp, PAESBlock(ctp)^);
inc(Ptr2Inc(ctp),AESBLKSIZE);
move(buf,PAESBlock(ctp)^,m);
{Set short block flag}
Flag := Flag or 1;
end;
end;
end;
{---------------------------------------------------------------------------}
function AES_ECB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in ECB mode}
var
i,n: longint;
m: word;
tmp: TAESBlock;
begin
AES_ECB_Decrypt := 0;
if ILen<0 then ILen := 0;
if ctx.Decrypt=0 then begin
AES_ECB_Decrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_ECB_Decrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_ECB_Decrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_ECB_Decrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{Short block must be last, no more processing allowed}
if ctx.Flag and 1 <> 0 then begin
AES_ECB_Decrypt := AES_Err_Data_After_Short_Block;
exit;
end;
with ctx do begin
for i:=1 to n do begin
AES_Decrypt(ctx, PAESBlock(ctp)^, PAESBlock(ptp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing}
AES_Decrypt(ctx, PAESBlock(ctp)^, buf);
inc(Ptr2Inc(ctp),AESBLKSIZE);
tmp := buf;
move(PAESBlock(ctp)^, tmp, m);
AES_Decrypt(ctx, tmp, PAESBlock(ptp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
move(buf,PAESBlock(ptp)^,m);
{Set short block flag}
Flag := Flag or 1;
end;
end;
end;
end.

180
Tocsg.Lib/VCL/EncLib/AES/aes_encr.pas Normal file
View File

@ -0,0 +1,180 @@
unit AES_Encr;
(*************************************************************************
DESCRIPTION : AES encrypt functions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] http://csrc.nist.gov/fips/fips-197.pdf
[2] rijndael-alg-fst.c V2.0/3.0: Rijmen et al Aug1999/Dec2000
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.22 16.08.03 we longint statt word32
0.23 16.08.03 we separate aes_encr
0.24 16.08.03 we new xor_block
0.25 18.09.03 we Static tables, D4+
0.26 20.09.03 we optimized round code, no more move/if
0.27 21.09.03 we functions, error codes
0.28 27.09.03 we FPC/go32v2
0.29 28.09.03 we removed temporary s-Block
0.30 28.09.03 we two rounds in each loop, merge last xorblock
0.31 03.10.03 we 3-para encr/decr
0.32 03.10.03 we two local blocks if partial unroll
0.33 03.10.03 we BASM for BP7
0.34 04.10.03 we remove add di,4
0.35 05.10.03 we STD.INC, TP6
0.36 05.10.03 we TP5,TP5.5
0.37 27.12.03 we EPerm removed
0.38 28.12.03 we Delphi/VP: Pointer version
BASM16: changed variable order
0.39 28.12.03 we BASM16: SBox code in asm,
PTR: merge SBox code with XOR RK
0.40 29.12.03 we BASM16: xorblock in asm, PTR: reorder
0.41 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.42 14.08.04 we UseLongBox/Te4
0.43 30.11.04 we AES_XorBlock, AESBLKSIZE
0.44 24.12.04 we STD code and Te0..Te3 like [2], AES_ENCR ifdefs
0.45 24.12.04 we New ifdef logic, move replacement code to inc
0.46 24.12.04 we TP5/5.5 with round key pointer
0.47 24.12.04 we BASM16: lea trick for 4*bx
0.48 04.03.05 we FPC 1.9.8, STD.INC V1.10, StrictLong
0.49 05.05.05 we $R- for StrictLong, D9: errors if $R+ even if warnings off
0.50 09.07.06 we Compressed tables, code in INC files
0.51 19.07.06 we TCe_Diag
0.52 21.11.08 we Use __P2I from BTypes
0.53 01.12.12 we separate BIT64 include statements
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2012 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
AES_Type, AES_Base;
{$i aes_conf.inc}
{$ifdef AES_Diag}
{$ifdef AES_ComprTab}
var
TCe_Diag: integer; {offset of TCe table mod 15}
{should be 0 or 8 for optimal alignment}
{$endif}
{$endif}
{$ifdef CONST}
function AES_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
procedure AES_Encrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_Init_Encr(var Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
procedure AES_Encrypt(var ctx: TAESContext; var BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
{$endif}
implementation
uses BTypes;
{$ifdef AES_ComprTab}
{$i enc_cdat.inc}
{$ifndef BIT16}
{$ifdef BIT64}
{$i enc_cp16.inc} {This version is faster for FPC260/Win7-64!!!}
{$else}
{$i enc_cp32.inc}
{$endif}
{$else}
{$ifdef BASM16}
{$i enc_ca16.inc}
{$else}
{$i enc_cp16.inc}
{$endif}
{$endif}
{$else}
{$i enc_fdat.inc}
{$ifndef BIT16}
{$ifdef BIT64}
{$i enc_fp16.inc} {This version is faster for FPC260/Win7-64!!!}
{$else}
{$i enc_fp32.inc}
{$endif}
{$else}
{$ifdef BASM16}
{$i enc_fa16.inc}
{$else}
{$i enc_fp16.inc}
{$endif}
{$endif}
{$endif}
{---------------------------------------------------------------------------}
function AES_Init_Encr({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
begin
AES_Init_Encr := AES_Init(Key, KeyBits, ctx);
end;
{$ifdef AES_ComprTab}
begin
{$ifdef AES_Diag}
TCe_Diag := __P2I(@TCe) and 15;
{$endif}
{$ifdef AES_Encr_DummyAlign}
if TCeDummy<>0 then ;
{$endif}
{$endif}
end.

1017
Tocsg.Lib/VCL/EncLib/AES/aes_gcm.pas Normal file
View File

File diff suppressed because it is too large Load Diff

519
Tocsg.Lib/VCL/EncLib/AES/aes_intf.pas Normal file
View File

@ -0,0 +1,519 @@
unit AES_INTF;
(*************************************************************************
DESCRIPTION : Interface unit for AES_DLL
REQUIREMENTS : D2-D7/D9-D10/D12, FPC
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 02.07.04 W.Ehrhardt Initial version
0.11 30.11.04 we AES_XorBlock, AESBLKSIZE
0.12 01.12.04 we AES_Err_Data_After_Short_Block
0.23 01.12.04 we AES_ prefix for CTR increment routines
0.24 24.12.04 we AES_Get/SetFastInit
0.25 09.07.06 we CMAC, updated OMAC, checked: D9-D10
0.26 14.06.07 we Type TAES_EAXContext
0.27 16.06.07 we AES_CPRF128
0.28 29.09.07 we AES_XTS
0.29 25.12.07 we AES_CFB8
0.30 20.07.08 we All-in-one functions AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.31 02.08.08 we Removed ctx parameter in AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.32 21.05.09 we AES_CCM
0.33 05.07.09 we external 'aes_dll.dll'
0.34 06.07.09 we AES_DLL_Version returns PAnsiChar
0.35 22.06.10 we AES_CTR_Seek, AES_CTR_Seek64
0.36 27.07.10 we Longint ILen, AES_Err_Invalid_16Bit_Length
0.37 28.07.10 we Removed OMAC/CMAC XL versions
0.38 31.07.10 we AES_CTR_Seek via aes_seek.inc
0.38 27.09.10 we AES_GCM
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
const
AES_Err_Invalid_Key_Size = -1; {Key size <> 128, 192, or 256 Bits}
AES_Err_Invalid_Mode = -2; {Encr/Decr with Init for Decr/Encr}
AES_Err_Invalid_Length = -3; {No full block for cipher stealing}
AES_Err_Data_After_Short_Block = -4; {Short block must be last}
AES_Err_MultipleIncProcs = -5; {More than one IncProc Setting }
AES_Err_NIL_Pointer = -6; {nil pointer to block with nonzero length}
AES_Err_EAX_Inv_Text_Length = -7; {More than 64K text length in EAX all-in-one for 16 Bit}
AES_Err_EAX_Inv_TAG_Length = -8; {EAX all-in-one tag length not 0..16}
AES_Err_EAX_Verify_Tag = -9; {EAX all-in-one tag does not compare}
AES_Err_CCM_Hdr_length = -10; {CCM header length >= $FF00}
AES_Err_CCM_Nonce_length = -11; {CCM nonce length < 7 or > 13}
AES_Err_CCM_Tag_length = -12; {CCM tag length not in [4,6,8,19,12,14,16]}
AES_Err_CCM_Verify_Tag = -13; {Computed CCM tag does not compare}
AES_Err_CCM_Text_length = -14; {16 bit plain/cipher text length to large}
AES_Err_CTR_SeekOffset = -15; {Negative offset in AES_CTR_Seek}
AES_Err_GCM_Verify_Tag = -17; {GCM all-in-one tag does not compare}
AES_Err_GCM_Auth_After_Final = -18; {Auth after final or multiple finals}
AES_Err_Invalid_16Bit_Length = -20; {BaseAddr + length > $FFFF for 16 bit code}
const
AESMaxRounds = 14;
type
TAESBlock = packed array[0..15] of byte;
PAESBlock = ^TAESBlock;
TKeyArray = packed array[0..AESMaxRounds] of TAESBlock;
TIncProc = procedure(var CTR: TAESBlock); {$ifdef USEDLL} stdcall; {$endif}
{user supplied IncCTR proc}
TAESContext = packed record
RK : TKeyArray; {Key (encr. or decr.) }
IV : TAESBlock; {IV or CTR }
buf : TAESBlock; {Work buffer }
bLen : word; {Bytes used in buf }
Rounds : word; {Number of rounds }
KeyBits : word; {Number of bits in key }
Decrypt : byte; {<>0 if decrypting key }
Flag : byte; {Bit 1: Short block }
IncProc : TIncProc; {Increment proc CTR-Mode}
end;
const
AESBLKSIZE = sizeof(TAESBlock);
type
TAES_EAXContext = packed record
HdrOMAC : TAESContext; {Hdr OMAC1 context}
MsgOMAC : TAESContext; {Msg OMAC1 context}
ctr_ctx : TAESContext; {Msg AESCTR context}
NonceTag: TAESBlock; {nonce tag }
tagsize : word; {tag size (unused) }
flags : word; {ctx flags (unused)}
end;
type
TAES_XTSContext = packed record
main : TAESContext; {Main context}
tweak: TAESContext; {Tweak context}
end;
type
TGCM_Tab4K = array[0..255] of TAESBlock; {64 KB gf_mul_h table }
type
TBit64 = packed array[0..1] of longint; {64 bit counter }
type
TAES_GCMContext = packed record
actx : TAESContext; {Basic AES context }
aad_ghv : TAESBlock; {ghash value AAD }
txt_ghv : TAESBlock; {ghash value ciphertext}
ghash_h : TAESBlock; {ghash H value }
gf_t4k : TGCM_Tab4K; {gf_mul_h table }
aad_cnt : TBit64; {processed AAD bytes }
atx_cnt : TBit64; {authent. text bytes }
y0_val : longint; {initial 32-bit ctr val}
end;
function AES_DLL_Version: PAnsiChar;
stdcall; external 'aes_dll.dll' name 'AES_DLL_Version';
{-Return DLL version as PAnsiChar}
procedure AES_XorBlock(const B1, B2: TAESBlock; var B3: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_XorBlock';
{-xor two blocks, result in third}
function AES_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_Init';
{-AES key expansion, error if invalid key size}
procedure AES_SetFastInit(value: boolean);
stdcall; external 'aes_dll.dll' name 'AES_SetFastInit';
{-set FastInit variable}
function AES_GetFastInit: boolean;
stdcall; external 'aes_dll.dll' name 'AES_GetFastInit';
{-Returns FastInit variable}
function AES_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_Init_Encr';
{-AES key expansion, error if invalid key size}
procedure AES_Encrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_Encrypt';
{-encrypt one block, not checked: key must be encryption key}
function AES_ECB_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_ECB_Init_Encr';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_ECB_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_ECB_Init_Decr';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_ECB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_ECB_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in ECB mode}
function AES_ECB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_ECB_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in ECB mode}
function AES_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_Init_Decr';
{-AES key expansion, InvMixColumn(Key) for Decypt, error if invalid key size}
procedure AES_Decrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_Decrypt';
{-decrypt one block (in ECB mode)}
function AES_CBC_Init_Encr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CBC_Init_Encr';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CBC_Init_Decr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CBC_Init_Decr';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CBC_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CBC_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CBC mode}
function AES_CBC_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CBC_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in CBC mode}
function AES_CFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB_Init';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB128 mode}
function AES_CFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB128 mode}
function AES_CFB8_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB8_Init';
{-AES key expansion, error if invalid key size, store IV}
function AES_CFB8_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB8_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB8 mode}
function AES_CFB8_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CFB8_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB8 mode}
function AES_OFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_OFB_Init';
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_OFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_OFB_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in OFB mode}
function AES_OFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_OFB_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in OFB mode}
function AES_CTR_Init(const Key; KeyBits: word; const CTR: TAESBlock; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CTR_Init';
{-AES key expansion, error if inv. key size, encrypt CTR}
function AES_CTR_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CTR_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode}
function AES_CTR_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CTR_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode}
function AES_CTR_Seek(const iCTR: TAESBlock; SOL, SOH: longint; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SOH*2^32+SOL,}
{ SOH >= 0. iCTR is the initial CTR for offset 0, i.e. the same as in AES_CTR_Init.}
{$ifdef HAS_INT64}
function AES_CTR_Seek64(const iCTR: TAESBlock; SO: int64; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SO >= 0;}
{ iCTR is the initial CTR value for offset 0, i.e. the same as in AES_CTR_Init.}
{$endif}
function AES_SetIncProc(IncP: TIncProc; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_SetIncProc';
{-Set user supplied IncCTR proc}
procedure AES_IncMSBFull(var CTR: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_IncMSBFull';
{-Increment CTR[15]..CTR[0]}
procedure AES_IncLSBFull(var CTR: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_IncLSBFull';
{-Increment CTR[0]..CTR[15]}
procedure AES_IncMSBPart(var CTR: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_IncMSBPart';
{-Increment CTR[15]..CTR[8]}
procedure AES_IncLSBPart(var CTR: TAESBlock);
stdcall; external 'aes_dll.dll' name 'AES_IncLSBPart';
{-Increment CTR[0]..CTR[7]}
function AES_OMAC_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_OMAC_Init';
{-OMAC init: AES key expansion, error if inv. key size}
function AES_OMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_OMAC_Update';
{-OMAC data input, may be called more than once}
procedure AES_OMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
stdcall; external 'aes_dll.dll' name 'AES_OMAC_Final';
{-end data input, calculate OMAC=OMAC1 tag}
procedure AES_OMAC1_Final(var tag: TAESBlock; var ctx: TAESContext);
stdcall; external 'aes_dll.dll' name 'AES_OMAC1_Final';
{-end data input, calculate OMAC1 tag}
procedure AES_OMAC2_Final(var tag: TAESBlock; var ctx: TAESContext);
stdcall; external 'aes_dll.dll' name 'AES_OMAC2_Final';
{-end data input, calculate OMAC2 tag}
procedure AES_OMACx_Final(OMAC2: boolean; var tag: TAESBlock; var ctx: TAESContext);
stdcall; external 'aes_dll.dll' name 'AES_OMACx_Final';
{-end data input, calculate OMAC tag}
function AES_CMAC_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CMAC_Init';
{-CMAC init: AES key expansion, error if inv. key size}
function AES_CMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_CMAC_Update';
{-CMAC data input, may be called more than once}
procedure AES_CMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
stdcall; external 'aes_dll.dll' name 'AES_CMAC_Final';
{-end data input, calculate CMAC=OMAC1 tag}
function AES_EAX_Init(const Key; KBits: word; const nonce; nLen: word; var ctx: TAES_EAXContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Init';
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
function AES_EAX_Provide_Header(Hdr: pointer; hLen: word; var ctx: TAES_EAXContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Provide_Header';
{-Supply a message header. The header "grows" with each call}
function AES_EAX_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
function AES_EAX_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Decrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
procedure AES_EAX_Final(var tag: TAESBlock; var ctx: TAES_EAXContext);
stdcall; external 'aes_dll.dll' name 'AES_EAX_Final';
{-Compute EAX tag from context}
function AES_EAX_Enc_Auth(var tag: TAESBlock; {Tag record}
const Key; KBits: word; {key and bitlength of key}
const nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Enc_Auth';
{-All-in-one call to encrypt/authenticate}
function AES_EAX_Dec_Veri( ptag: pointer; tLen : word; {Tag: address / length (0..16)}
const Key; KBits: word; {key and bitlength of key}
const nonce; nLen : word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_EAX_Dec_Veri';
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
function AES_CPRF128(const Key; KeyBytes: word; msg: pointer; msglen: longint; var PRV: TAESBlock): integer;
stdcall; external 'aes_dll.dll' name 'AES_CPRF128';
{Calculate variable-length key AES CMAC Pseudo-Random Function-128 for msg}
{returns AES_OMAC error and 128-bit pseudo-random value PRV}
function AES_CPRF128_selftest: boolean;
stdcall; external 'aes_dll.dll' name 'AES_CPRF128_selftest';
{-Selftest with RFC 4615 test vectors}
function AES_XTS_Init_Encr(const K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_XTS_Init_Encr';
{-Init XTS encrypt context (key expansion), error if invalid key size}
function AES_XTS_Encrypt(ptp, ctp: Pointer; ILen: longint; const twk: TAESBlock; var ctx: TAES_XTSContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_XTS_Encrypt';
{-Encrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
function AES_XTS_Init_Decr(const K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_XTS_Init_Decr';
{-Init XTS decrypt context (key expansion), error if invalid key size}
function AES_XTS_Decrypt(ctp, ptp: Pointer; ILen: longint; const twk: TAESBlock; var ctx: TAES_XTSContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_XTS_Decrypt';
{-Decrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
function AES_CCM_Enc_AuthEx(var ctx: TAESContext;
var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_CCM_Enc_AuthEx';
{-CCM packet encrypt/authenticate without key setup}
function AES_CCM_Enc_Auth(var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const Key; KBytes: word; {key and byte length of key}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_CCM_Enc_Auth';
{-All-in-one call for CCM packet encrypt/authenticate}
function AES_CCM_Dec_VeriEX(var ctx: TAESContext;
ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_CCM_Dec_VeriEX';
{-CCM packet decrypt/verify without key setup. If ptag^ verification fails, ptp^ is zero-filled!}
function AES_CCM_Dec_Veri( ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const Key; KBytes: word; {key and byte length of key}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_CCM_Dec_Veri';
{-All-in-one CCM packet decrypt/verify. If ptag^ verification fails, ptp^ is zero-filled!}
function AES_GCM_Init(const Key; KeyBits: word; var ctx: TAES_GCMContext): integer;
{-Init context, calculate key-dependent GF(2^128) element H=E(K,0) and mul tables}
stdcall; external 'aes_dll.dll' name 'AES_GCM_Init';
function AES_GCM_Reset_IV(pIV: pointer; IV_len: word; var ctx: TAES_GCMContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Reset_IV';
{-Reset: keep key but start new encryption with given IV}
function AES_GCM_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_GCMContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Encrypt';
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update auth data}
function AES_GCM_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_GCMContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Decrypt';
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode, update auth data}
function AES_GCM_Add_AAD(pAAD: pointer; aLen: longint; var ctx: TAES_GCMContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Add_AAD';
{-Add additional authenticated data (will not be encrypted)}
function AES_GCM_Final(var tag: TAESBlock; var ctx: TAES_GCMContext): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Final';
{-Compute GCM tag from context}
function AES_GCM_Enc_Auth(var tag: TAESBlock; {Tag record}
const Key; KBits: word; {key and bitlength of key}
pIV: pointer; IV_len: word; {IV: address / length}
pAAD: pointer; aLen: word; {AAD: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer; {ciphertext: address}
var ctx: TAES_GCMContext {context, will be cleared}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Enc_Auth';
{-All-in-one call to encrypt/authenticate}
function AES_GCM_Dec_Veri( ptag: pointer; tLen: word; {Tag: address / length (0..16)}
const Key; KBits: word; {key and bitlength of key}
pIV: pointer; IV_len: word; {IV: address / length}
pAAD: pointer; aLen: word; {AAD: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer; {plaintext: address}
var ctx: TAES_GCMContext {context, will be cleared}
): integer;
stdcall; external 'aes_dll.dll' name 'AES_GCM_Dec_Veri';
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
implementation
{$i aes_seek.inc}
end.

534
Tocsg.Lib/VCL/EncLib/AES/aes_intv.pas Normal file
View File

@ -0,0 +1,534 @@
unit AES_INTV;
{$ifdef VirtualPascal}
{$stdcall+}
{$else}
Error('Interface unit for VirtualPascal');
{$endif}
(*************************************************************************
DESCRIPTION : Interface unit for AES_DLL
REQUIREMENTS : VirtualPascal
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 02.07.04 W.Ehrhardt Initial version from AES_Intf
0.20 03.07.04 we VirtualPascal syntax
0.21 30.11.04 we AES_XorBlock, AESBLKSIZE
0.22 01.12.04 we AES_Err_Data_After_Short_Block
0.23 01.12.04 we AES_ prefix for CTR increment routines
0.24 24.12.04 we AES_Get/SetFastInit
0.25 09.07.06 we CMAC, updated OMAC
0.26 14.06.07 we Type TAES_EAXContext
0.27 16.06.07 we AES_CPRF128
0.28 29.09.07 we AES_XTS
0.29 25.12.07 we AES_CFB8
0.30 20.07.08 we All-in-one functions AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.31 02.08.08 we Removed ctx parameter in AES_EAX_Enc_Auth/AES_EAX_Dec_Veri
0.32 21.05.09 we AES_CCM
0.33 06.07.09 we AES_DLL_Version returns PAnsiChar
0.34 22.06.10 we AES_CTR_Seek
0.35 27.07.10 we Longint ILen, AES_Err_Invalid_16Bit_Length
0.36 28.07.10 we Removed OMAC/CMAC XL versions
0.37 31.07.10 we AES_CTR_Seek via aes_seek.inc
0.38 27.09.10 we AES_GCM
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
interface
const
AES_Err_Invalid_Key_Size = -1; {Key size <> 128, 192, or 256 Bits}
AES_Err_Invalid_Mode = -2; {Encr/Decr with Init for Decr/Encr}
AES_Err_Invalid_Length = -3; {No full block for cipher stealing}
AES_Err_Data_After_Short_Block = -4; {Short block must be last}
AES_Err_MultipleIncProcs = -5; {More than one IncProc Setting }
AES_Err_NIL_Pointer = -6; {nil pointer to block with nonzero length}
AES_Err_EAX_Inv_Text_Length = -7; {More than 64K text length in EAX all-in-one for 16 Bit}
AES_Err_EAX_Inv_TAG_Length = -8; {EAX all-in-one tag length not 0..16}
AES_Err_EAX_Verify_Tag = -9; {EAX all-in-one tag does not compare}
AES_Err_CCM_Hdr_length = -10; {CCM header length >= $FF00}
AES_Err_CCM_Nonce_length = -11; {CCM nonce length < 7 or > 13}
AES_Err_CCM_Tag_length = -12; {CCM tag length not in [4,6,8,19,12,14,16]}
AES_Err_CCM_Verify_Tag = -13; {Computed CCM tag does not compare}
AES_Err_CCM_Text_length = -14; {16 bit plain/cipher text length to large}
AES_Err_CTR_SeekOffset = -15; {Negative offset in AES_CTR_Seek}
AES_Err_GCM_Verify_Tag = -17; {GCM all-in-one tag does not compare}
AES_Err_GCM_Auth_After_Final = -18; {Auth after final or multiple finals}
AES_Err_Invalid_16Bit_Length = -20; {BaseAddr + length > $FFFF for 16 bit code}
const
AESMaxRounds = 14;
type
TAESBlock = packed array[0..15] of byte;
PAESBlock = ^TAESBlock;
TKeyArray = packed array[0..AESMaxRounds] of TAESBlock;
TIncProc = procedure(var CTR: TAESBlock);
{user supplied IncCTR proc}
TAESContext = packed record
RK : TKeyArray; {Key (encr. or decr.) }
IV : TAESBlock; {IV or CTR }
buf : TAESBlock; {Work buffer }
bLen : word; {Bytes used in buf }
Rounds : word; {Number of rounds }
KeyBits : word; {Number of bits in key }
Decrypt : byte; {<>0 if decrypting key }
Flag : byte; {Bit 1: Short block }
IncProc : TIncProc; {Increment proc CTR-Mode}
end;
const
AESBLKSIZE = sizeof(TAESBlock);
type
TAES_EAXContext = packed record
HdrOMAC : TAESContext; {Hdr OMAC1 context}
MsgOMAC : TAESContext; {Msg OMAC1 context}
ctr_ctx : TAESContext; {Msg AESCTR context}
NonceTag: TAESBlock; {nonce tag }
tagsize : word; {tag size (unused) }
flags : word; {ctx flags (unused)}
end;
type
TAES_XTSContext = packed record
main : TAESContext; {Main context}
tweak: TAESContext; {Tweak context}
end;
type
TGCM_Tab4K = array[0..255] of TAESBlock; {64 KB gf_mul_h table }
type
TBit64 = packed array[0..1] of longint; {64 bit counter }
type
TAES_GCMContext = packed record
actx : TAESContext; {Basic AES context }
aad_ghv : TAESBlock; {ghash value AAD }
txt_ghv : TAESBlock; {ghash value ciphertext}
ghash_h : TAESBlock; {ghash H value }
gf_t4k : TGCM_Tab4K; {gf_mul_h table }
aad_cnt : TBit64; {processed AAD bytes }
atx_cnt : TBit64; {authent. text bytes }
y0_val : longint; {initial 32-bit ctr val}
end;
{---------------------------------------------------------------------------}
{---------------------------------------------------------------------------}
function AES_DLL_Version: PAnsiChar;
{-Return DLL version as PAnsiChar}
procedure AES_XorBlock(const B1, B2: TAESBlock; var B3: TAESBlock);
{-xor two blocks, result in third}
function AES_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
function AES_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size}
procedure AES_Encrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
function AES_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, InvMixColumn(Key) for Decypt, error if invalid key size}
procedure AES_Decrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
procedure AES_SetFastInit(value: boolean);
{-set FastInit variable}
function AES_GetFastInit: boolean;
{-Returns FastInit variable}
function AES_ECB_Init_Encr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_ECB_Init_Decr(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_ECB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in ECB mode}
function AES_ECB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in ECB mode}
function AES_CBC_Init_Encr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CBC_Init_Decr(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CBC_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CBC mode}
function AES_CBC_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CBC mode}
function AES_CFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_CFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB128 mode}
function AES_CFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB128 mode}
function AES_CFB8_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, store IV}
function AES_CFB8_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CFB8 mode}
function AES_CFB8_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CFB8 mode}
function AES_OFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
function AES_OFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in OFB mode}
function AES_OFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in OFB mode}
function AES_CTR_Init(const Key; KeyBits: word; const CTR: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if inv. key size, encrypt CTR}
function AES_CTR_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode}
function AES_CTR_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode}
function AES_CTR_Seek(const iCTR: TAESBlock; SOL, SOH: longint; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SOH*2^32+SOL,}
{ SOH >= 0. iCTR is the initial CTR for offset 0, i.e. the same as in AES_CTR_Init.}
function AES_SetIncProc(IncP: TIncProc; var ctx: TAESContext): integer;
{-Set user supplied IncCTR proc}
procedure AES_IncMSBFull(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[0]}
procedure AES_IncLSBFull(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[15]}
procedure AES_IncMSBPart(var CTR: TAESBlock);
{-Increment CTR[15]..CTR[8]}
procedure AES_IncLSBPart(var CTR: TAESBlock);
{-Increment CTR[0]..CTR[7]}
function AES_OMAC_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-OMAC init: AES key expansion, error if inv. key size}
function AES_OMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-OMAC data input, may be called more than once}
procedure AES_OMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC=OMAC1 tag}
procedure AES_OMAC1_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC1 tag}
procedure AES_OMAC2_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC2 tag}
procedure AES_OMACx_Final(OMAC2: boolean; var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC tag}
function AES_CMAC_Init(const Key; KeyBits: word; var ctx: TAESContext): integer;
{-CMAC init: AES key expansion, error if inv. key size}
function AES_CMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-CMAC data input, may be called more than once}
procedure AES_CMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate CMAC=OMAC1 tag}
function AES_EAX_Init(const Key; KBits: word; const nonce; nLen: word; var ctx: TAES_EAXContext): integer;
{-Init hdr and msg OMACs, setp AESCTR with nonce tag}
function AES_EAX_Provide_Header(Hdr: pointer; hLen: word; var ctx: TAES_EAXContext): integer;
{-Supply a message header. The header "grows" with each call}
function AES_EAX_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
function AES_EAX_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_EAXContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update OMACs}
procedure AES_EAX_Final(var tag: TAESBlock; var ctx: TAES_EAXContext);
{-Compute EAX tag from context}
function AES_EAX_Enc_Auth(var tag: TAESBlock; {Tag record}
const Key; KBits: word; {key and bitlength of key}
const nonce; nLen: word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-All-in-one call to encrypt/authenticate}
function AES_EAX_Dec_Veri( ptag: pointer; tLen : word; {Tag: address / length (0..16)}
const Key; KBits: word; {key and bitlength of key}
const nonce; nLen : word; {nonce: address / length}
Hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
function AES_CPRF128(const Key; KeyBytes: word; msg: pointer; msglen: longint; var PRV: TAESBlock): integer;
{Calculate variable-length key AES CMAC Pseudo-Random Function-128 for msg}
{returns AES_OMAC error and 128-bit pseudo-random value PRV}
function AES_CPRF128_selftest: boolean;
{-Selftest with RFC 4615 test vectors}
function AES_XTS_Init_Encr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS encrypt context (key expansion), error if invalid key size}
function AES_XTS_Encrypt(ptp, ctp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Encrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
function AES_XTS_Init_Decr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS decrypt context (key expansion), error if invalid key size}
function AES_XTS_Decrypt(ctp, ptp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Decrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
function AES_CCM_Enc_AuthEx(var ctx: TAESContext;
var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-CCM packet encrypt/authenticate without key setup}
function AES_CCM_Enc_Auth(var tag: TAESBlock; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const Key; KBytes: word; {key and byte length of key}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer {ciphertext: address}
): integer;
{-All-in-one call for CCM packet encrypt/authenticate}
function AES_CCM_Dec_VeriEX(var ctx: TAESContext;
ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-CCM packet decrypt/verify without key setup. If ptag^ verification fails, ptp^ is zero-filled!}
function AES_CCM_Dec_Veri( ptag: pointer; tLen : word; {Tag & length in [4,6,8,19,12,14,16]}
const Key; KBytes: word; {key and byte length of key}
const nonce; nLen: word; {nonce: address / length}
hdr: pointer; hLen: word; {header: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer {plaintext: address}
): integer;
{-All-in-one CCM packet decrypt/verify. If ptag^ verification fails, ptp^ is zero-filled!}
function AES_GCM_Init(const Key; KeyBits: word; var ctx: TAES_GCMContext): integer;
{-Init context, calculate key-dependent GF(2^128) element H=E(K,0) and mul tables}
function AES_GCM_Reset_IV(pIV: pointer; IV_len: word; var ctx: TAES_GCMContext): integer;
{-Reset: keep key but start new encryption with given IV}
function AES_GCM_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAES_GCMContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in CTR mode, update auth data}
function AES_GCM_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAES_GCMContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in CTR mode, update auth data}
function AES_GCM_Add_AAD(pAAD: pointer; aLen: longint; var ctx: TAES_GCMContext): integer;
{-Add additional authenticated data (will not be encrypted)}
function AES_GCM_Final(var tag: TAESBlock; var ctx: TAES_GCMContext): integer;
{-Compute GCM tag from context}
function AES_GCM_Enc_Auth(var tag: TAESBlock; {Tag record}
const Key; KBits: word; {key and bitlength of key}
pIV: pointer; IV_len: word; {IV: address / length}
pAAD: pointer; aLen: word; {AAD: address / length}
ptp: pointer; pLen: longint; {plaintext: address / length}
ctp: pointer; {ciphertext: address}
var ctx: TAES_GCMContext {context, will be cleared}
): integer;
{-All-in-one call to encrypt/authenticate}
function AES_GCM_Dec_Veri( ptag: pointer; tLen: word; {Tag: address / length (0..16)}
const Key; KBits: word; {key and bitlength of key}
pIV: pointer; IV_len: word; {IV: address / length}
pAAD: pointer; aLen: word; {AAD: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer; {plaintext: address}
var ctx: TAES_GCMContext {context, will be cleared}
): integer;
{-All-in-one call to decrypt/verify. Decryption is done only if ptag^ is verified}
implementation
function AES_DLL_Version; external 'AES_DLL' name 'AES_DLL_Version';
procedure AES_XorBlock; external 'AES_DLL' name 'AES_XorBlock';
function AES_Init; external 'AES_DLL' name 'AES_Init';
function AES_Init_Decr; external 'AES_DLL' name 'AES_Init_Decr';
function AES_Init_Encr; external 'AES_DLL' name 'AES_Init_Encr';
procedure AES_Decrypt; external 'AES_DLL' name 'AES_Decrypt';
procedure AES_Encrypt; external 'AES_DLL' name 'AES_Encrypt';
procedure AES_SetFastInit; external 'AES_DLL' name 'AES_SetFastInit';
function AES_GetFastInit; external 'AES_DLL' name 'AES_GetFastInit';
function AES_ECB_Init_Encr; external 'AES_DLL' name 'AES_ECB_Init_Encr';
function AES_ECB_Init_Decr; external 'AES_DLL' name 'AES_ECB_Init_Decr';
function AES_ECB_Encrypt; external 'AES_DLL' name 'AES_ECB_Encrypt';
function AES_ECB_Decrypt; external 'AES_DLL' name 'AES_ECB_Decrypt';
function AES_CBC_Init_Encr; external 'AES_DLL' name 'AES_CBC_Init_Encr';
function AES_CBC_Init_Decr; external 'AES_DLL' name 'AES_CBC_Init_Decr';
function AES_CBC_Encrypt; external 'AES_DLL' name 'AES_CBC_Encrypt';
function AES_CBC_Decrypt; external 'AES_DLL' name 'AES_CBC_Decrypt';
function AES_CFB_Init; external 'AES_DLL' name 'AES_CFB_Init';
function AES_CFB_Encrypt; external 'AES_DLL' name 'AES_CFB_Encrypt';
function AES_CFB_Decrypt; external 'AES_DLL' name 'AES_CFB_Decrypt';
function AES_CFB8_Init; external 'AES_DLL' name 'AES_CFB8_Init';
function AES_CFB8_Encrypt; external 'AES_DLL' name 'AES_CFB8_Encrypt';
function AES_CFB8_Decrypt; external 'AES_DLL' name 'AES_CFB8_Decrypt';
function AES_CTR_Init; external 'AES_DLL' name 'AES_CTR_Init';
function AES_CTR_Encrypt; external 'AES_DLL' name 'AES_CTR_Encrypt';
function AES_CTR_Decrypt; external 'AES_DLL' name 'AES_CTR_Decrypt';
function AES_SetIncProc; external 'AES_DLL' name 'AES_SetIncProc';
procedure AES_IncLSBFull; external 'AES_DLL' name 'AES_IncLSBFull';
procedure AES_IncLSBPart; external 'AES_DLL' name 'AES_IncLSBPart';
procedure AES_IncMSBFull; external 'AES_DLL' name 'AES_IncMSBFull';
procedure AES_IncMSBPart; external 'AES_DLL' name 'AES_IncMSBPart';
function AES_OFB_Init; external 'AES_DLL' name 'AES_OFB_Init';
function AES_OFB_Encrypt; external 'AES_DLL' name 'AES_OFB_Encrypt';
function AES_OFB_Decrypt; external 'AES_DLL' name 'AES_OFB_Decrypt';
function AES_OMAC_Init; external 'AES_DLL' name 'AES_OMAC_Init';
function AES_OMAC_Update; external 'AES_DLL' name 'AES_OMAC_Update';
procedure AES_OMAC_Final; external 'AES_DLL' name 'AES_OMAC_Final';
procedure AES_OMAC1_Final; external 'AES_DLL' name 'AES_OMAC1_Final';
procedure AES_OMAC2_Final; external 'AES_DLL' name 'AES_OMAC2_Final';
procedure AES_OMACx_Final; external 'AES_DLL' name 'AES_OMACx_Final';
function AES_CMAC_Init; external 'AES_DLL' name 'AES_CMAC_Init';
function AES_CMAC_Update; external 'AES_DLL' name 'AES_CMAC_Update';
procedure AES_CMAC_Final; external 'AES_DLL' name 'AES_CMAC_Final';
function AES_EAX_Init; external 'AES_DLL' name 'AES_EAX_Init';
function AES_EAX_Encrypt; external 'AES_DLL' name 'AES_EAX_Encrypt';
function AES_EAX_Decrypt; external 'AES_DLL' name 'AES_EAX_Decrypt';
procedure AES_EAX_Final; external 'AES_DLL' name 'AES_EAX_Final';
function AES_EAX_Provide_Header; external 'AES_DLL' name 'AES_EAX_Provide_Header';
function AES_EAX_Enc_Auth; external 'AES_DLL' name 'AES_EAX_Enc_Auth';
function AES_EAX_Dec_Veri; external 'AES_DLL' name 'AES_EAX_Dec_Veri';
function AES_CPRF128; external 'AES_DLL' name 'AES_CPRF128';
function AES_CPRF128_selftest; external 'AES_DLL' name 'AES_CPRF128_selftest';
function AES_XTS_Init_Encr; external 'AES_DLL' name 'AES_XTS_Init_Encr';
function AES_XTS_Encrypt; external 'AES_DLL' name 'AES_XTS_Encrypt';
function AES_XTS_Init_Decr; external 'AES_DLL' name 'AES_XTS_Init_Decr';
function AES_XTS_Decrypt; external 'AES_DLL' name 'AES_XTS_Decrypt';
function AES_CCM_Dec_Veri; external 'AES_DLL' name 'AES_CCM_Dec_Veri';
function AES_CCM_Dec_VeriEX; external 'AES_DLL' name 'AES_CCM_Dec_VeriEX';
function AES_CCM_Enc_Auth; external 'AES_DLL' name 'AES_CCM_Enc_Auth';
function AES_CCM_Enc_AuthEx; external 'AES_DLL' name 'AES_CCM_Enc_AuthEx';
function AES_GCM_Init; external 'AES_DLL' name 'AES_GCM_Init';
function AES_GCM_Reset_IV; external 'AES_DLL' name 'AES_GCM_Reset_IV';
function AES_GCM_Encrypt; external 'AES_DLL' name 'AES_GCM_Encrypt';
function AES_GCM_Decrypt; external 'AES_DLL' name 'AES_GCM_Decrypt';
function AES_GCM_Add_AAD; external 'AES_DLL' name 'AES_GCM_Add_AAD';
function AES_GCM_Final; external 'AES_DLL' name 'AES_GCM_Final';
function AES_GCM_Enc_Auth; external 'AES_DLL' name 'AES_GCM_Enc_Auth';
function AES_GCM_Dec_Veri; external 'AES_DLL' name 'AES_GCM_Dec_Veri';
{$define CONST}
{$i aes_seek.inc}
end.

170
Tocsg.Lib/VCL/EncLib/AES/aes_ofb.pas Normal file
View File

@ -0,0 +1,170 @@
unit AES_OFB;
(*************************************************************************
DESCRIPTION : AES OFB functions
Because of buffering en/decrypting is associative
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [3] http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf
[1] http://csrc.nist.gov/fips/fips-197.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 16.08.03 we initial version
0.11 21.09.03 we functions, error codes
0.12 27.09.03 we FPC/go32v2
0.13 03.10.03 we 3-para encr/decr
0.14 05.10.03 we STD.INC, TP5-6
0.15 01.01.04 we Encr(IV) in init, handle full blocks first
0.16 12.06.04 we uses BLKSIZE constant
0.17 12.06.04 we check for nil pointers
0.18 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.19 30.11.04 we AES_XorBlock, AESBLKSIZE
0.20 09.07.06 we Checked: D9-D10
0.21 16.11.08 we Use Ptr2Inc, pByte from BTypes
0.22 27.07.10 we Longint ILen in AES_OFB_En/Decrypt
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
{$ifdef CONST}
function AES_OFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
{$else}
function AES_OFB_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{-AES key expansion, error if invalid key size, encrypt IV}
{$ifdef DLL} stdcall; {$endif}
{$endif}
function AES_OFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in OFB mode}
{$ifdef DLL} stdcall; {$endif}
function AES_OFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in OFB mode}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
{$ifdef CONST}
function AES_OFB_Init(const Key; KeyBits: word; const IV: TAESBlock; var ctx: TAESContext): integer;
{$else}
function AES_OFB_Init(var Key; KeyBits: word; var IV: TAESBlock; var ctx: TAESContext): integer;
{$endif}
{-AES key expansion, error if invalid key size}
begin
{-AES key expansion, error if invalid key size}
AES_OFB_Init := AES_Init_Encr(Key, KeyBits, ctx);
AES_Encrypt(ctx, IV, ctx.IV);
end;
{---------------------------------------------------------------------------}
function AES_OFB_Encrypt(ptp, ctp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Encrypt ILen bytes from ptp^ to ctp^ in OFB mode}
begin
AES_OFB_Encrypt := 0;
if ctx.Decrypt<>0 then begin
AES_OFB_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_OFB_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ofs(ptp^)+ILen>$FFFF) or (ofs(ctp^)+ILen>$FFFF) then begin
AES_OFB_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
if ctx.blen=0 then begin
{Handle full blocks first}
while ILen>=AESBLKSIZE do with ctx do begin
{Cipher text = plain text xor repeated encr(IV), cf. [3] 6.4}
AES_XorBlock(PAESBlock(ptp)^, IV, PAESBlock(ctp)^);
AES_Encrypt(ctx, IV, IV);
inc(Ptr2Inc(ptp), AESBLKSIZE);
inc(Ptr2Inc(ctp), AESBLKSIZE);
dec(ILen, AESBLKSIZE);
end;
end;
{Handle remaining bytes}
while ILen>0 do with ctx do begin
{Test buffer empty}
if bLen>=AESBLKSIZE then begin
AES_Encrypt(ctx, IV, IV);
bLen := 0;
end;
pByte(ctp)^ := IV[bLen] xor pByte(ptp)^;
inc(bLen);
inc(Ptr2Inc(ptp));
inc(Ptr2Inc(ctp));
dec(ILen);
end;
end;
{---------------------------------------------------------------------------}
function AES_OFB_Decrypt(ctp, ptp: Pointer; ILen: longint; var ctx: TAESContext): integer;
{-Decrypt ILen bytes from ctp^ to ptp^ in OFB mode}
begin
{Decrypt = encrypt for OFB mode}
AES_OFB_Decrypt := AES_OFB_Encrypt(ctp, ptp, ILen, ctx);
end;
end.

277
Tocsg.Lib/VCL/EncLib/AES/aes_omac.pas Normal file
View File

@ -0,0 +1,277 @@
unit AES_OMAC;
(*************************************************************************
DESCRIPTION : AES OMAC1/2 routines
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : OMAC page: http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/omac.html
T.Iwata and K.Kurosawa. OMAC: One-Key CBC MAC - Addendum
(http://csrc.nist.gov/CryptoToolkit/modes/proposedmodes/omac/omac-ad.pdf)
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 22.05.04 W.Ehrhardt Initial version
0.11 22.05.04 we Update with move and second while loop
0.12 22.05.04 we Update/final as procedures, $R- in mul_u
0.13 23.05.04 we XL version
0.14 23.05.04 we More comments
0.15 30.05.04 we OMAC2
0.16 31.05.04 we Update references, more comments
0.17 12.06.04 we uses BLKSIZE constant
0.18 12.06.04 we check for nil pointers
0.19 02.07.04 we {$ifdef DLL} stdcall; {$endif}
0.20 30.11.04 we AES_XorBlock, AESBLKSIZE
0.21 30.11.04 we Clear IV if FastInit
0.22 24.12.04 we Calls AES_GetFastInit
0.23 09.07.06 we Checked: D9-D10
0.24 09.07.06 we Interfaced AES_OMACx_Final, AES_OMAC_UpdateXL
0.25 15.11.08 we Use Ptr2Inc from BTypes
0.26 28.07.10 we AES_OMAC_Update with ILen: longint, XL Version with $define OLD_XL_Version
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2004-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
function AES_OMAC_Init({$ifdef CONST} const Key {$else} var Key {$endif};
KeyBits: word; var ctx: TAESContext): integer;
{-OMAC init: AES key expansion, error if inv. key size}
{$ifdef DLL} stdcall; {$endif}
function AES_OMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-OMAC data input, may be called more than once}
{$ifdef DLL} stdcall; {$endif}
procedure AES_OMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC=OMAC1 tag}
{$ifdef DLL} stdcall; {$endif}
procedure AES_OMAC1_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC1 tag}
{$ifdef DLL} stdcall; {$endif}
procedure AES_OMAC2_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC2 tag}
{$ifdef DLL} stdcall; {$endif}
{$ifdef OLD_XL_Version}
function AES_OMAC_UpdateXL (data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-OMAC data input, may be called more than once}
{$endif}
procedure AES_OMACx_Final(OMAC2: boolean; var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC tag}
{ interfaced for AES_CMAC, no need for OMAC usage}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------------------------------------------}
function AES_OMAC_Init({$ifdef CONST} const Key {$else} var Key {$endif};
KeyBits: word; var ctx: TAESContext): integer;
{-OMAC init: AES key expansion, error if inv. key size}
begin
{AES key expansion, error if inv. key size}
{IV = Y[0] = [0]}
AES_OMAC_Init := AES_Init_Encr(Key, KeyBits, ctx);
if AES_GetFastInit then fillchar(ctx.IV,sizeof(ctx.IV),0);
end;
{---------------------------------------------------------------------------}
function AES_OMAC_Update(data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-OMAC data input, may be called more than once}
var
n: word;
begin
if (data=nil) and (ILen<>0) then begin
AES_OMAC_Update := AES_Err_NIL_Pointer;
exit;
end;
{$ifdef BIT16}
if (ofs(data^)+ILen>$FFFF) then begin
AES_OMAC_Update := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
AES_OMAC_Update := 0;
while ILen>0 do with ctx do begin
if bLen>=AESBLKSIZE then begin
{process full buffer}
{X[i] := M[i] xor Y[i-1]}
AES_XorBlock(buf, IV, buf);
AES_Encrypt(ctx, buf, IV);
bLen := 0;
while ILen>AESBLKSIZE do with ctx do begin
{continue with full blocks if more }
{than one block remains unprocessed}
{X[i] := M[i] xor Y[i-1]}
AES_XorBlock(PAESBlock(data)^, IV, buf);
{Y[i] := EK[X[i]}
AES_Encrypt(ctx, buf, IV);
inc(Ptr2Inc(data), AESBLKSIZE);
dec(ILen, AESBLKSIZE); {ILen>0!}
end;
end;
n := AESBLKSIZE-bLen; if ILen<n then n:=ILen;
{n>0 because ILen>0 and bLen<AESBLKSIZE}
move(data^, buf[bLen], n);
inc(bLen,n);
inc(Ptr2Inc(data),n);
dec(ILen,n);
end;
end;
{$ifdef OLD_XL_Version}
{---------------------------------------------------------------------------}
function AES_OMAC_UpdateXL (data: pointer; ILen: longint; var ctx: TAESContext): integer;
{-OMAC data input, may be called more than once}
begin
AES_OMAC_UpdateXL := AES_OMAC_Update(data, ILen, ctx);
end;
{$endif}
{---------------------------------------------------------------------------}
procedure AES_OMACx_Final(OMAC2: boolean; var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC tag}
{Turn off range checking for byte shifts}
{$ifopt R+} {$define SetRPlus} {$else} {$undef SetRPlus} {$endif}
{$R-}
{---------------------------------------}
procedure mul_u(var L: TAESBlock);
{-Calculate L.u}
const
masks: array[0..1] of byte = (0,$87);
var
i: integer;
mask: byte;
begin
mask := masks[L[0] shr 7];
for i:=0 to AESBLKSIZE-2 do L[i] := (L[i] shl 1) or (L[i+1] shr 7);
L[AESBLKSIZE-1] := (L[AESBLKSIZE-1] shl 1) xor mask;
end;
{---------------------------------------}
procedure div_u(var L: TAESBlock);
{-Calculate L.u^-1}
const
mask1: array[0..1] of byte = (0, $43);
mask2: array[0..1] of byte = (0, $80);
var
i,j: integer;
begin
j := L[AESBLKSIZE-1] and 1;
for i:=AESBLKSIZE-1 downto 1 do L[i] := (L[i] shr 1) or (L[i-1] shl 7);
L[0] := (L[0] shr 1) xor mask2[j];
L[AESBLKSIZE-1] := L[AESBLKSIZE-1] xor mask1[j];
end;
{$ifdef SetRPlus}
{$R+}
{$endif}
begin
with ctx do begin
fillchar(tag, sizeof(tag), 0);
{L := EK(0)}
AES_Encrypt(ctx, tag, tag);
if blen>=AESBLKSIZE then begin
{Complete last block, no padding and use L.u}
mul_u(tag);
end
else begin
{Incomplete last block, pad buf and use L.u^2 or L.u^-1}
buf[bLen] := $80;
inc(bLen);
while blen<AESBLKSIZE do begin
buf[bLen] := 0;
inc(bLen);
end;
if OMAC2 then begin
{calc L.u^-1}
div_u(tag);
end
else begin
{calc L.u^2}
mul_u(tag);
mul_u(tag);
end;
end;
{X[m] := pad(M[n]) xor Y[m-1]}
AES_XorBlock(buf, IV, buf);
{X[m] := X[m] xor L.u^e, e=-1,1,2}
AES_XorBlock(buf, tag, buf);
{T := EK(X[m])}
AES_Encrypt(ctx, buf, tag);
end;
end;
{---------------------------------------------------------------------------}
procedure AES_OMAC_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC=OMAC1 tag}
begin
AES_OMACx_Final(false, tag, ctx);
end;
{---------------------------------------------------------------------------}
procedure AES_OMAC1_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC1 tag}
begin
AES_OMACx_Final(false, tag, ctx);
end;
{---------------------------------------------------------------------------}
procedure AES_OMAC2_Final(var tag: TAESBlock; var ctx: TAESContext);
{-end data input, calculate OMAC2 tag}
begin
AES_OMACx_Final(true, tag, ctx);
end;
end.

150
Tocsg.Lib/VCL/EncLib/AES/aes_seek.inc Normal file
View File

@ -0,0 +1,150 @@
(*************************************************************************
Include file for AES CTR Seek routines. These routines are in a separate inc
file because they are included in aes_ctr.pas for non-dlls AND in the dll
interface units AES_Intv/AES_Intf. This is done in order to make tests like
@IncProc=@AES_IncMSBPart work without additional overhead in programs using
the dll.
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 31.07.10 W.Ehrhardt Initial version
**************************************************************************)
(****** (C) Copyright 2010 Wolfgang Ehrhardt -- see copying_we.txt ******)
{---------------------------------------------------------------------------}
function AES_CTR_Seek({$ifdef CONST}const{$else}var{$endif} iCTR: TAESBlock;
SOL, SOH: longint; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SOH*2^32+SOL,}
{ SOH >= 0. iCTR is the initial CTR for offset 0, i.e. the same as in AES_CTR_Init.}
var
i,pt: integer;
carry: word;
TC: TAESBlock;
type
TWA4 = packed array[0..3] of longint; {AES block as array of longint}
TBA4 = packed array[0..3] of byte; {AES "word" as array of byte }
begin
{WARNING: CTR mode demands that the same key / iCTR pair is never reused }
{for encryption. This requirement is especially important for the CTR_Seek}
{function. If different data is written to the same position there will be}
{leakage of information about the plaintexts. Therefore CTR_Seek should }
{normally be used for random reads only.}
if SOH < 0 then begin
AES_CTR_Seek := AES_Err_CTR_SeekOffset;
exit;
end
else with ctx do begin
blen := word(SOL) and $0F;
{64 bit shift right (SOH, SOL) 4 bits}
SOL := (SOL shr 4) or ((SOH and $0F) shl 28);
SOH := (SOH shr 4);
{Check if known IncProc}
{$ifdef FPC_ProcVar}
if (IncProc=nil) or (IncProc=@AES_IncMSBFull) then pt := 1
else if IncProc=@AES_IncMSBPart then pt := 2
else if IncProc=@AES_IncLSBFull then pt := 3
else if IncProc=@AES_IncLSBPart then pt := 4
else pt := 0;
{$else}
if (@IncProc=nil) or (@IncProc=@AES_IncMSBFull) then pt := 1
else if @IncProc=@AES_IncMSBPart then pt := 2
else if @IncProc=@AES_IncLSBFull then pt := 3
else if @IncProc=@AES_IncLSBPart then pt := 4
else pt := 0;
{$endif}
IV := iCTR;
if (SOL or SOH) <> 0 then begin
if pt=0 then begin
{No shortcut calculation for user-defined IncProcs. Note: SOH is }
{positive here even if the sign bit of the original SOH was set. }
{The execution of this loop may be very time-consuming because the }
{IncProc is called many times. If the user is able to calculate the}
{value IVo of the iCTR after calling IncProc (offset div 16) times,}
{invoking the function with AES_CTR_Seek(IVo, SOL and 15, 0, ctx) }
{will completely skip the IncProc calculation, but set the correct }
{values for ctx.IV, ctx.buf, and ctx.blen.}
if SOL=0 then dec(SOH);
repeat
repeat
IncProc(IV);
dec(SOL);
until SOL=0;
dec(SOH);
until SOH<=0;
end
else begin
fillchar(TC, sizeof(TC), 0);
carry := 0;
if (pt=1) or (pt=2) then begin
{MSB functions, first fill 128 bit offset vector}
for i:=0 to 3 do begin
TC[15-i] := TBA4(SOL)[i];
TC[11-i] := TBA4(SOH)[i];
end;
{64 bit addition}
for i:=15 downto 8 do begin
carry := carry + TC[i] + IV[i];
IV[i] := carry and $FF;
carry := carry shr 8;
end;
if (pt=1) and (carry<>0) then begin
{"Full" function: propagate carry through remaining bytes}
for i:=7 downto 0 do begin
carry := carry + IV[i];
IV[i] := carry and $FF;
carry := carry shr 8;
{$ifdef CONST}
if carry=0 then break;
{$endif}
end;
end;
end
else begin
{LSB functions, first fill 128 bit offset vector}
TWA4(TC)[0] := SOL;
TWA4(TC)[1] := SOH;
{64 bit addition}
for i:=0 to 7 do begin
carry := carry + TC[i] + IV[i];
IV[i] := carry and $FF;
carry := carry shr 8;
end;
if (pt=3) and (carry<>0) then begin
{"Full" function: propagate carry through remaining bytes}
for i:=8 to 15 do begin
carry := carry + IV[i];
IV[i] := carry and $FF;
carry := carry shr 8;
{$ifdef CONST}
if carry=0 then break;
{$endif}
end;
end;
end;
end;
end;
AES_Encrypt(ctx, IV, buf);
AES_CTR_Seek := 0;
end;
end;
{$ifdef HAS_INT64}
{$ifndef DLL}
{-----------------------------------------------------------------------------}
function AES_CTR_Seek64(const iCTR: TAESBlock; SO: int64; var ctx: TAESContext): integer;
{-Setup ctx for random access crypto stream starting at 64 bit offset SO >= 0;}
{ iCTR is the initial CTR value for offset 0, i.e. the same as in AES_CTR_Init.}
type
LH = packed record L,H: longint; end;
begin
AES_CTR_Seek64 := AES_CTR_Seek(iCTR, LH(SO).L, LH(SO).H, ctx);
end;
{$endif}
{$endif}

119
Tocsg.Lib/VCL/EncLib/AES/aes_type.pas Normal file
View File

@ -0,0 +1,119 @@
unit AES_Type;
(*************************************************************************
DESCRIPTION : AES type definitions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : ---
Version Date Author Modification
------- -------- ------- ------------------------------------------
1.00 16.08.03 we Sepatate unit from AESCrypt
1.10 15.09.03 we with IncProc
1.20 21.09.03 we with Flag, error codes
1.21 05.10.03 we with STD.INC
1.23 05.10.03 we with AES_Err_MultipleIncProcs
1.24 12.06.04 we with AES_Err_NIL_Pointer, const BLKSIZE
1.25 02.07.04 we {$ifdef DLL} stdcall; {$endif}
1.26 29.11.04 we FastInit
1.27 30.11.04 we AES_XorBlock, AESBLKSIZE
1.28 01.12.04 we AES_Err_Data_After_Short_Block
1.29 09.07.06 we Checked: D9-D10
1.30 20.07.08 we Error codes for EAX all-in-one function results
1.31 21.05.09 we CCM error codes
1.32 20.06.10 we CTR_Seek error code
1.33 27.07.10 we AES_Err_Invalid_16Bit_Length
1.34 27.09.10 we GCM error codes
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
interface
const
AESMaxRounds = 14;
const
AES_Err_Invalid_Key_Size = -1; {Key size <> 128, 192, or 256 Bits}
AES_Err_Invalid_Mode = -2; {Encr/Decr with Init for Decr/Encr}
AES_Err_Invalid_Length = -3; {No full block for cipher stealing}
AES_Err_Data_After_Short_Block = -4; {Short block must be last }
AES_Err_MultipleIncProcs = -5; {More than one IncProc Setting }
AES_Err_NIL_Pointer = -6; {nil pointer to block with nonzero length}
AES_Err_EAX_Inv_Text_Length = -7; {More than 64K text length in EAX all-in-one for 16 Bit}
AES_Err_EAX_Inv_TAG_Length = -8; {EAX all-in-one tag length not 0..16}
AES_Err_EAX_Verify_Tag = -9; {EAX all-in-one tag does not compare}
AES_Err_CCM_Hdr_length = -10; {CCM header length >= $FF00}
AES_Err_CCM_Nonce_length = -11; {CCM nonce length < 7 or > 13}
AES_Err_CCM_Tag_length = -12; {CCM tag length not in [4,6,8,19,12,14,16]}
AES_Err_CCM_Verify_Tag = -13; {Computed CCM tag does not compare}
AES_Err_CCM_Text_length = -14; {16 bit plain/cipher text length to large}
AES_Err_CTR_SeekOffset = -15; {Negative offset in AES_CTR_Seek}
AES_Err_GCM_Verify_Tag = -17; {GCM all-in-one tag does not compare}
AES_Err_GCM_Auth_After_Final = -18; {Auth after final or multiple finals}
AES_Err_Invalid_16Bit_Length = -20; {BaseAddr + length > $FFFF for 16 bit code}
type
TAESBlock = packed array[0..15] of byte;
PAESBlock = ^TAESBlock;
TKeyArray = packed array[0..AESMaxRounds] of TAESBlock;
TIncProc = procedure(var CTR: TAESBlock); {user supplied IncCTR proc}
{$ifdef DLL} stdcall; {$endif}
TAESContext = packed record
RK : TKeyArray; {Key (encr. or decr.) }
IV : TAESBlock; {IV or CTR }
buf : TAESBlock; {Work buffer }
bLen : word; {Bytes used in buf }
Rounds : word; {Number of rounds }
KeyBits : word; {Number of bits in key }
Decrypt : byte; {<>0 if decrypting key }
Flag : byte; {Bit 1: Short block }
IncProc : TIncProc; {Increment proc CTR-Mode}
end;
const
AESBLKSIZE = sizeof(TAESBlock);
implementation
end.

302
Tocsg.Lib/VCL/EncLib/AES/aes_xts.pas Normal file
View File

@ -0,0 +1,302 @@
unit AES_XTS;
(*************************************************************************
DESCRIPTION : AES XTS mode functions
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REMARKS : 1. The IV and buf fields of the main contexts are used for
temparary buffers. Tweak context IV holds enc(tweak)*a^j.
2. Quote from the IEEE Draft: "Attention is called to the
possibility that implementation of this standard may
require use of subject matter covered by patent rights."
Before using this source/mode read the patent section
in legal.txt!
REFERENCES : [1] IEEE P1619, Draft Standard for Cryptographic Protection
of Data on Block-Oriented Storage Devices. Available from
http://ieee-p1619.wetpaint.com/page/IEEE+Project+1619+Home
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 23.09.07 we Initial version like ECB (BP7+, encrypt)
0.11 24.09.07 we BP7+ decrypt
0.12 24.09.07 we TP5-TP6
0.13 27.09.07 we ILen now longint
0.14 27.09.07 we Check ILen+ofs if BIT16 and $R+
0.15 16.11.08 we Use Ptr2Inc from BTypes
0.16 27.07.10 we AES_Err_Invalid_16Bit_Length
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2007-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr, AES_Decr;
type
TAES_XTSContext = packed record
main : TAESContext; {Main context}
tweak: TAESContext; {Tweak context}
end;
function AES_XTS_Init_Encr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS encrypt context (key expansion), error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
function AES_XTS_Encrypt(ptp, ctp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Encrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
{$ifdef DLL} stdcall; {$endif}
function AES_XTS_Init_Decr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS decrypt context (key expansion), error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
function AES_XTS_Decrypt(ctp, ptp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Decrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
{$ifdef DLL} stdcall; {$endif}
implementation
{---------------------------------------}
procedure mul_a(var T: TAESBlock);
{-Multiply tweak block by the primitive element a from GF(2^128)}
var
i: integer;
cin,cout: byte;
const
masks: array[0..1] of byte = (0,$87);
begin
cin := 0;
{Turn off range checking for byte shifts}
{$ifopt R+} {$define SetRPlus} {$else} {$undef SetRPlus} {$endif}
{$R-}
for i:=0 to AESBLKSIZE-1 do begin
cout := T[i] shr 7;
T[i] := (T[i] shl 1) or cin;
cin := cout;
end;
T[0] := T[0] xor masks[cin];
{$ifdef SetRPlus}
{$R+}
{$endif}
end;
{---------------------------------------------------------------------------}
function AES_XTS_Init_Encr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS encrypt context (key expansion), error if invalid key size}
var
err: integer;
begin
fillchar(ctx, sizeof(ctx), 0);
err := AES_Init(K1, KBits, ctx.main);
if err=0 then err := AES_Init(K2, KBits, ctx.tweak);
AES_XTS_Init_Encr := err;
end;
{---------------------------------------------------------------------------}
function AES_XTS_Init_Decr({$ifdef CONST}const{$else}var{$endif} K1,K2; KBits: word; var ctx: TAES_XTSContext): integer;
{-Init XTS decrypt context (key expansion), error if invalid key size}
{$ifdef DLL} stdcall; {$endif}
var
err: integer;
begin
fillchar(ctx, sizeof(ctx), 0);
err := AES_Init_Decr(K1, KBits, ctx.main);
if err=0 then err := AES_Init(K2, KBits, ctx.tweak);
AES_XTS_Init_Decr := err;
end;
{---------------------------------------------------------------------------}
function AES_XTS_Encrypt(ptp, ctp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Encrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
var
i,n: longint;
m: word;
begin
AES_XTS_Encrypt := 0;
if ILen<0 then ILen := 0;
if ctx.main.Decrypt<>0 then begin
AES_XTS_Encrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_XTS_Encrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ILen+ofs(ptp^) > $FFFF) or (ILen+ofs(ctp^) > $FFFF) then begin
AES_XTS_Encrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_XTS_Encrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{encrypt the tweak twk, tweak.IV = enc(twk)}
AES_Encrypt(ctx.tweak, twk, ctx.tweak.IV);
with ctx.main do begin
{process full blocks}
for i:=1 to n do begin
AES_XorBlock(PAESBlock(ptp)^, ctx.tweak.IV, buf);
AES_Encrypt(ctx.main, buf, buf);
AES_XorBlock(buf, ctx.tweak.IV, PAESBlock(ctp)^);
mul_a(ctx.tweak.IV);
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing, encrypt last full plaintext block}
AES_XorBlock(PAESBlock(ptp)^, ctx.tweak.IV, buf);
AES_Encrypt(ctx.main, buf, buf);
AES_XorBlock(buf, ctx.tweak.IV, buf);
mul_a(ctx.tweak.IV);
inc(Ptr2Inc(ptp),AESBLKSIZE);
{pad and encrypt final short block}
IV := buf;
move(PAESBlock(ptp)^, IV, m);
AES_XorBlock(IV, ctx.tweak.IV, IV);
AES_Encrypt(ctx.main, IV, IV);
AES_XorBlock(IV, ctx.tweak.IV, PAESBlock(ctp)^);
inc(Ptr2Inc(ctp),AESBLKSIZE);
move(buf,PAESBlock(ctp)^,m);
end;
end;
end;
{---------------------------------------------------------------------------}
function AES_XTS_Decrypt(ctp, ptp: Pointer; ILen: longint;
{$ifdef CONST}const{$else}var{$endif} twk: TAESBlock; var ctx: TAES_XTSContext): integer;
{-Decrypt data unit of ILen bytes from ptp^ to ctp^ in XTS mode, twk: tweak of data unit}
var
i,n: longint;
m: word;
begin
AES_XTS_Decrypt := 0;
if ILen<0 then ILen := 0;
if ctx.main.Decrypt=0 then begin
AES_XTS_Decrypt := AES_Err_Invalid_Mode;
exit;
end;
if (ptp=nil) or (ctp=nil) then begin
if ILen>0 then begin
AES_XTS_Decrypt := AES_Err_NIL_Pointer;
exit;
end;
end;
{$ifdef BIT16}
if (ILen+ofs(ptp^) > $FFFF) or (ILen+ofs(ctp^) > $FFFF) then begin
AES_XTS_Decrypt := AES_Err_Invalid_16Bit_Length;
exit;
end;
{$endif}
n := ILen div AESBLKSIZE; {Full blocks}
m := ILen mod AESBLKSIZE; {Remaining bytes in short block}
if m<>0 then begin
if n=0 then begin
AES_XTS_Decrypt := AES_Err_Invalid_Length;
exit;
end;
dec(n); {CTS: special treatment of last TWO blocks}
end;
{encrypt the tweak twk, tweak.IV = enc(twk)}
AES_Encrypt(ctx.tweak, twk, ctx.tweak.IV);
with ctx.main do begin
for i:=1 to n do begin
AES_XorBlock(PAESBlock(ctp)^, ctx.tweak.IV, buf);
AES_Decrypt(ctx.main, buf, buf);
AES_XorBlock(buf, ctx.tweak.IV, PAESBlock(ptp)^);
mul_a(ctx.tweak.IV);
inc(Ptr2Inc(ptp),AESBLKSIZE);
inc(Ptr2Inc(ctp),AESBLKSIZE);
end;
if m<>0 then begin
{Cipher text stealing, "increment" tweak because}
{final short plaintext is padded in this block}
IV := ctx.tweak.IV;
mul_a(IV);
{Decrypt last full ciphertext block <-> final short plaintext}
AES_XorBlock(PAESBlock(ctp)^, IV, buf);
AES_Decrypt(ctx.main, buf, buf);
AES_XorBlock(buf, IV, buf);
inc(Ptr2Inc(ctp),AESBLKSIZE);
{pad and decrypt short CT block to last full PT block}
IV := buf;
move(PAESBlock(ctp)^, IV, m);
AES_XorBlock(IV, ctx.tweak.IV, IV);
AES_Decrypt(ctx.main, IV, IV);
AES_XorBlock(IV, ctx.tweak.IV, PAESBlock(ptp)^);
inc(Ptr2Inc(ptp),AESBLKSIZE);
move(buf,PAESBlock(ptp)^,m);
end;
end;
end;
end.

199
Tocsg.Lib/VCL/EncLib/AES/btypes.pas Normal file
View File

@ -0,0 +1,199 @@
unit BTypes;
{Common basic type definitions}
interface
{$i STD.INC}
(*************************************************************************
DESCRIPTION : Common basic type definitions
REQUIREMENTS : TP5-7, D1-D7/D9-D12/D17-D22, FPC, VP, WDOSX
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : ---
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 15.04.06 W.Ehrhardt Initial version
0.11 15.04.06 we With $ifdef HAS_XTYPES
0.12 15.04.06 we FPC1_0 and pShortInt
0.13 09.09.08 we UInt32 = cardinal $ifdef HAS_CARD32
0.14 12.11.08 we Str127, Ptr2Inc
0.15 14.11.08 we BString, char8
0.16 21.11.08 we __P2I: type cast pointer to integer for masking etc
0.17 02.12.08 we Use pchar and pAnsiChar for pchar8 if possible
0.18 27.02.09 we pBoolean
0.19 14.02.12 we extended = double $ifdef SIMULATE_EXT64
0.20 06.05.14 we extended = double $ifdef SIMULATE_EXT64 OR EXT64
0.21 25.04.15 we With $ifdef HAS_INTXX, HAS_PINTXX
*************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2006-2015 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$ifdef BIT16}
type
Int8 = ShortInt; { 8 bit signed integer}
Int16 = Integer; {16 bit signed integer}
Int32 = Longint; {32 bit signed integer}
UInt8 = Byte; { 8 bit unsigned integer}
UInt16 = Word; {16 bit unsigned integer}
UInt32 = Longint; {32 bit unsigned integer}
Smallint = Integer;
Shortstring = string;
pByte = ^Byte;
pBoolean = ^Boolean;
pShortInt = ^ShortInt;
pWord = ^Word;
pSmallInt = ^SmallInt;
pLongint = ^Longint;
{$else}
{$ifndef HAS_INTXX}
type
Int8 = ShortInt; { 8 bit signed integer}
Int16 = SmallInt; {16 bit signed integer}
Int32 = Longint; {32 bit signed integer}
UInt8 = Byte; { 8 bit unsigned integer}
UInt16 = Word; {16 bit unsigned integer}
{$ifdef HAS_CARD32}
UInt32 = Cardinal; {32 bit unsigned integer}
{$else}
UInt32 = Longint; {32 bit unsigned integer}
{$endif}
{$endif}
{$ifndef HAS_XTYPES}
type
pByte = ^Byte;
pBoolean = ^Boolean;
pShortInt = ^ShortInt;
pWord = ^Word;
pSmallInt = ^SmallInt;
pLongint = ^Longint;
{$endif}
{$ifdef FPC} {$ifdef VER1_0}
type
pBoolean = ^Boolean;
pShortInt = ^ShortInt;
{$endif} {$endif}
{$endif} {BIT16}
type
Str255 = string[255]; {Handy type to avoid problems with 32 bit and/or unicode}
Str127 = string[127];
type
{$ifndef HAS_PINTXX}
pInt8 = ^Int8;
pInt16 = ^Int16;
pInt32 = ^Int32;
pUInt8 = ^UInt8;
pUInt16 = ^UInt16;
pUInt32 = ^UInt32;
{$endif}
pStr255 = ^Str255;
pStr127 = ^Str127;
{$ifdef BIT16}
{$ifdef V7Plus}
type
BString = string[255]; {String of 8 bit characters}
pBString = ^BString;
char8 = char; {8 bit characters}
pchar8 = pchar;
{$else}
type
BString = string[255]; {String of 8 bit characters}
pBString = ^BString;
char8 = char; {8 bit characters}
pchar8 = ^char;
{$endif}
{$else}
{$ifdef UNICODE}
type
BString = AnsiString; {String of 8 bit characters}
pBString = pAnsiString;
char8 = AnsiChar; {8 bit characters}
pchar8 = pAnsiChar;
{$else}
type
BString = AnsiString; {String of 8 bit characters}
pBString = pAnsiString;
char8 = AnsiChar; {8 bit characters}
pchar8 = pAnsiChar;
{$endif}
{$endif}
{$ifdef V7Plus}
type
Ptr2Inc = pByte; {Type cast to increment untyped pointer}
{$else}
type
Ptr2Inc = Longint; {Type cast to increment untyped pointer}
{$endif}
{$ifdef FPC}
{$ifdef VER1}
type __P2I = longint; {Type cast pointer to integer for masking etc}
{$else}
type __P2I = PtrUInt; {Type cast pointer to integer for masking etc}
{$endif}
{$else}
{$ifdef BIT64}
type __P2I = NativeInt; {Type cast pointer to integer for masking etc}
{$else}
type __P2I = longint; {Type cast pointer to integer for masking etc}
{$endif}
{$endif}
{$ifdef EXT64}
type extended = double; {Force 64-bit 'extended'}
{$else}
{$ifdef SIMULATE_EXT64}
type extended = double; {Debug simulation EXT64}
{$endif}
{$endif}
implementation
end.

25
Tocsg.Lib/VCL/EncLib/AES/comp_speed Normal file
View File

@ -0,0 +1,25 @@
Cycles and MB/s for AES core encryption
Win 98, Pentium 4, 1.8 GHz
[-F for full tables, -C for compressed tables]
Compiler Cyc/Bl-F MB/s-F Cyc/Bl-C MB/s-C
~~~~~~~~~~~ ~~~~~~~~ ~~~~~~ ~~~~~~~~ ~~~~~~
TP5 6302 4.6 5356 5.4
TP55 6321 4.5 6980 4.1
TP6 1436 20.0 1762 16.3
BP7 1493 19.2 1927 14.9
VPC 426 67.3 425 67.3
FPC 1 GoV2 542 53.0 541 53.1
FPC 2.0.2 571 50.2 546 52.5
FPC 2.2 -O3 416 69.0 417 68.8
Delphi2 365 78.6 398 72.1
Delphi3 373 76.9 398 72.1
Delphi4 386 74.3 398 72.1
Delphi5 375 76.5 398 72.1
Delphi6 380 75.5 398 72.1
Delphi7 380 75.5 398 72.1
Delphi9 381 76.3 397 72.3
Delphi10 380 75.0 398 72.1

50
Tocsg.Lib/VCL/EncLib/AES/copying_we.txt Normal file
View File

@ -0,0 +1,50 @@
(C) Copyright 2002-2017 Wolfgang Ehrhardt
Based on "The zlib/libpng License":
http://www.opensource.org/licenses/zlib-license.php
__________________
COPYING CONDITIONS
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
_______________________________________
Bedingungen fuer Nutzung und Weitergabe
Die Software (Quellcodes und Binaerdateien) wird ohne jegliche Zusagen
oder Garantien bezueglich Funktionalitaet oder Funktionsfaehigkeit
abgegeben. Die Autoren uebernehmen keine Verantwortung fuer Schaeden, die
durch die Benutzung der Software verursacht werden.
Die Software darf frei verwendet und weitergegeben werden (kommerzielle
Nutzung/Weitergabe ist erlaubt), vorausgesetzt die folgenden Bedingungen
werden eingehalten:
1. Die Herkunft der Software darf nicht falsch angegeben werden; es ist
nicht erlaubt, die Software als Werk eines anderen auszugeben. Wird die
Software in Teilen oder als Ganzes in einem Produkt benutzt, so ist
Hinweis auf die Herkunft in der Dokumentation erwuenscht, aber nicht
notwendig.
2. Geaenderte Quellcodes muessen deutlich als solche gekennzeichnet werden
und duerfen nicht als die Originalsoftware ausgegeben werden.
3. Die Bedingungen ueber die Nutzung/Weitergabe duerfen nicht entfernt oder
geaendert werden.

397
Tocsg.Lib/VCL/EncLib/AES/dec_ca16.inc Normal file
View File

@ -0,0 +1,397 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for BASM16/Compressed table
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed table
0.11 10.07.06 we Removed bx in TCd[bx+si+?]
0.12 13.07.06 we Uses TCd box byte instead of InvSBox
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{16 bit BASM used for TP6, BP7, Delphi1}
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
s,t: TAESBlock;
r: integer;
pK: pointer;
begin
r := ctx.Rounds-1;
pK := @ctx.RK[ctx.Rounds];
asm
{AES_XorBlock(BI, ctx.RK[ctx.Rounds], s);}
db $66; pusha
les si,[BI]
db $66; mov ax,es:[si]
db $66; mov bx,es:[si+4]
db $66; mov cx,es:[si+8]
db $66; mov dx,es:[si+12]
les di,[pK]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
db $66; mov word ptr [s],ax
db $66; mov word ptr [s+4],bx
db $66; mov word ptr [s+8],cx
db $66; mov word ptr [s+12],dx
sub di,16 {di -> ctx.RK[r]}
mov cx,[r]
{ *Note* in the following round loop }
{ op eax, mem[8*ebx] is calculated as }
{ lea esi, [edx+8*ebx] $66,$67,$8D,$34,$DA }
{ op eax, mem[esi] }
db $66; sub bx,bx {clear ebx}
db $66; sub dx,dx {clear edx}
@@1:
{TWA4(t)[3] := Td0[s[3*4+0]] xor Td1[s[2*4+1]] xor Td2[s[1*4+2]] xor Td3[s[0*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr s[3*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr s[2*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr s[1*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr s[0*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di+12]
db $66; mov word ptr t[12],ax
{TWA4(t)[2] := Td0[s[2*4+0]] xor Td1[s[1*4+1]] xor Td2[s[0*4+2]] xor Td3[s[3*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr s[2*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr s[1*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr s[0*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr s[3*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di+8]
db $66; mov word ptr t[8],ax
{TWA4(t)[1] := Td0[s[1*4+0]] xor Td1[s[0*4+1]] xor Td2[s[3*4+2]] xor Td3[s[2*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr s[1*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr s[0*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr s[3*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr s[2*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di+4]
db $66; mov word ptr t[4],ax
{TWA4(t)[0] := Td0[s[0*4+0]] xor Td1[s[3*4+1]] xor Td2[s[2*4+2]] xor Td3[s[1*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr s[0*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr s[3*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr s[2*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr s[1*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di]
db $66; mov word ptr t[0],ax
{ dec(r); if r<1 then break;}
sub cx,1
jle @@2
{TWA4(s)[3] := Td0[t[3*4+0]] xor Td1[t[2*4+1]] xor Td2[t[1*4+2]] xor Td3[t[0*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr t[3*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr t[2*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr t[1*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr t[0*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di-4]
db $66; mov word ptr s[12],ax
{TWA4(s)[2] := Td0[t[2*4+0]] xor Td1[t[1*4+1]] xor Td2[t[0*4+2]] xor Td3[t[3*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr t[2*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr t[1*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr t[0*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr t[3*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di-8]
db $66; mov word ptr s[8],ax
{TWA4(s)[1] := Td0[t[1*4+0]] xor Td1[t[0*4+1]] xor Td2[t[3*4+2]] xor Td3[t[2*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr t[1*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr t[0*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr t[3*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr t[2*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di-12]
db $66; mov word ptr s[4],ax
{TWA4(s)[0] := Td0[t[0*4+0]] xor Td1[t[3*4+1]] xor Td2[t[2*4+2]] xor Td3[t[1*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr t[0*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCd[si+3]
mov bl,byte ptr t[3*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+2]
mov bl,byte ptr t[2*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si+1]
mov bl,byte ptr t[1*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCd[si]
db $66; xor ax,es:[di-16]
db $66; mov word ptr s[0],ax
sub di,32
dec cx
jmp @@1
@@2: sub di,16 {di -> ctx.RK[0]}
sub bx,bx
mov bl, byte ptr t[0*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[0],al
mov bl, byte ptr t[3*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[1],al
mov bl, byte ptr t[2*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[2],al
mov bl, byte ptr t[1*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[3],al
mov bl, byte ptr t[1*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[4],al
mov bl, byte ptr t[0*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[5],al
mov bl, byte ptr t[3*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[6],al
mov bl, byte ptr t[2*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[7],al
mov bl, byte ptr t[2*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[8],al
mov bl, byte ptr t[1*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[9],al
mov bl, byte ptr t[0*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[10],al
mov bl, byte ptr t[3*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[11],al
mov bl, byte ptr t[3*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[12],al
mov bl, byte ptr t[2*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[13],al
mov bl, byte ptr t[1*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[14],al
mov bl, byte ptr t[0*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr Tcd[bx+7]
mov byte ptr s[15],al
{AES_XorBlock(s, ctx.RK[0], BO);}
db $66; mov ax,word ptr [s]
db $66; mov bx,word ptr [s+4]
db $66; mov cx,word ptr [s+8]
db $66; mov dx,word ptr [s+12]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
les si,[BO]
db $66; mov es:[si],ax
db $66; mov es:[si+4],bx
db $66; mov es:[si+8],cx
db $66; mov es:[si+12],dx
db $66; popa
end;
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
n: integer;
p: PLong;
begin
p := Plong(@ctx.RK[1]);
n := 4*(ctx.Rounds-1);
{BASM version of 16 bit code, no need for local x/t}
{implicit endian conversion compared with [2]}
asm
les si,[p]
mov cx,[n]
@@1: mov dx,es:[si]
sub bh,bh
mov bl,dl
mov bl,byte ptr SBox[bx]
shl bx,3
db $66; mov ax,word ptr TCd[bx+3]
sub bh,bh
mov bl,dh
mov bl,byte ptr SBox[bx]
shl bx,3
db $66; xor ax,word ptr TCd[bx+2]
mov dx,es:[si+2]
sub bh,bh
mov bl,dl
mov bl,byte ptr SBox[bx]
shl bx,3
db $66; xor ax,word ptr TCd[bx+1]
sub bh,bh
mov bl,dh
mov bl,byte ptr SBox[bx]
shl bx,3
db $66; xor ax,word ptr TCd[bx]
db $66; mov es:[si],ax
add si,4
dec cx
jnz @@1
end;
end;

197
Tocsg.Lib/VCL/EncLib/AES/dec_cdat.inc Normal file
View File

@ -0,0 +1,197 @@
(*************************************************************************
Include file for AES_DECR.PAS - Compressed tables/Helper types
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 13.07.06 we Removed InvSBox, b3 gets box byte
0.12 19.07.06 we TCdDummy
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
type
TH3 = packed record
L: longint;
b0,b1,b2,box: byte;
end;
TH2 = packed record
b0: byte;
L: longint;
b1,b2,box: byte;
end;
TH1 = packed record
b0,b1: byte;
L: longint;
b2,box: byte;
end;
TH0 = packed record
b0,b1,b2: byte;
L: longint;
box: byte;
end;
TDU = record
case integer of
0: (D0: TH0);
1: (D1: TH1);
2: (D2: TH2);
3: (D3: TH3);
end;
{$ifdef StrictLong}
{$warnings off}
{$R-} {avoid D9+ errors!}
{$endif}
const
{$ifdef AES_Decr_DummyAlign}
TCdDummy : longint = 0; {Use to align TCd to 8 byte boundary}
{$endif}
TCd: packed array[0..2047] of byte = (
$f4,$a7,$50,$51,$f4,$a7,$50,$52,$41,$65,$53,$7e,$41,$65,$53,$09,
$17,$a4,$c3,$1a,$17,$a4,$c3,$6a,$27,$5e,$96,$3a,$27,$5e,$96,$d5,
$ab,$6b,$cb,$3b,$ab,$6b,$cb,$30,$9d,$45,$f1,$1f,$9d,$45,$f1,$36,
$fa,$58,$ab,$ac,$fa,$58,$ab,$a5,$e3,$03,$93,$4b,$e3,$03,$93,$38,
$30,$fa,$55,$20,$30,$fa,$55,$bf,$76,$6d,$f6,$ad,$76,$6d,$f6,$40,
$cc,$76,$91,$88,$cc,$76,$91,$a3,$02,$4c,$25,$f5,$02,$4c,$25,$9e,
$e5,$d7,$fc,$4f,$e5,$d7,$fc,$81,$2a,$cb,$d7,$c5,$2a,$cb,$d7,$f3,
$35,$44,$80,$26,$35,$44,$80,$d7,$62,$a3,$8f,$b5,$62,$a3,$8f,$fb,
$b1,$5a,$49,$de,$b1,$5a,$49,$7c,$ba,$1b,$67,$25,$ba,$1b,$67,$e3,
$ea,$0e,$98,$45,$ea,$0e,$98,$39,$fe,$c0,$e1,$5d,$fe,$c0,$e1,$82,
$2f,$75,$02,$c3,$2f,$75,$02,$9b,$4c,$f0,$12,$81,$4c,$f0,$12,$2f,
$46,$97,$a3,$8d,$46,$97,$a3,$ff,$d3,$f9,$c6,$6b,$d3,$f9,$c6,$87,
$8f,$5f,$e7,$03,$8f,$5f,$e7,$34,$92,$9c,$95,$15,$92,$9c,$95,$8e,
$6d,$7a,$eb,$bf,$6d,$7a,$eb,$43,$52,$59,$da,$95,$52,$59,$da,$44,
$be,$83,$2d,$d4,$be,$83,$2d,$c4,$74,$21,$d3,$58,$74,$21,$d3,$de,
$e0,$69,$29,$49,$e0,$69,$29,$e9,$c9,$c8,$44,$8e,$c9,$c8,$44,$cb,
$c2,$89,$6a,$75,$c2,$89,$6a,$54,$8e,$79,$78,$f4,$8e,$79,$78,$7b,
$58,$3e,$6b,$99,$58,$3e,$6b,$94,$b9,$71,$dd,$27,$b9,$71,$dd,$32,
$e1,$4f,$b6,$be,$e1,$4f,$b6,$a6,$88,$ad,$17,$f0,$88,$ad,$17,$c2,
$20,$ac,$66,$c9,$20,$ac,$66,$23,$ce,$3a,$b4,$7d,$ce,$3a,$b4,$3d,
$df,$4a,$18,$63,$df,$4a,$18,$ee,$1a,$31,$82,$e5,$1a,$31,$82,$4c,
$51,$33,$60,$97,$51,$33,$60,$95,$53,$7f,$45,$62,$53,$7f,$45,$0b,
$64,$77,$e0,$b1,$64,$77,$e0,$42,$6b,$ae,$84,$bb,$6b,$ae,$84,$fa,
$81,$a0,$1c,$fe,$81,$a0,$1c,$c3,$08,$2b,$94,$f9,$08,$2b,$94,$4e,
$48,$68,$58,$70,$48,$68,$58,$08,$45,$fd,$19,$8f,$45,$fd,$19,$2e,
$de,$6c,$87,$94,$de,$6c,$87,$a1,$7b,$f8,$b7,$52,$7b,$f8,$b7,$66,
$73,$d3,$23,$ab,$73,$d3,$23,$28,$4b,$02,$e2,$72,$4b,$02,$e2,$d9,
$1f,$8f,$57,$e3,$1f,$8f,$57,$24,$55,$ab,$2a,$66,$55,$ab,$2a,$b2,
$eb,$28,$07,$b2,$eb,$28,$07,$76,$b5,$c2,$03,$2f,$b5,$c2,$03,$5b,
$c5,$7b,$9a,$86,$c5,$7b,$9a,$a2,$37,$08,$a5,$d3,$37,$08,$a5,$49,
$28,$87,$f2,$30,$28,$87,$f2,$6d,$bf,$a5,$b2,$23,$bf,$a5,$b2,$8b,
$03,$6a,$ba,$02,$03,$6a,$ba,$d1,$16,$82,$5c,$ed,$16,$82,$5c,$25,
$cf,$1c,$2b,$8a,$cf,$1c,$2b,$72,$79,$b4,$92,$a7,$79,$b4,$92,$f8,
$07,$f2,$f0,$f3,$07,$f2,$f0,$f6,$69,$e2,$a1,$4e,$69,$e2,$a1,$64,
$da,$f4,$cd,$65,$da,$f4,$cd,$86,$05,$be,$d5,$06,$05,$be,$d5,$68,
$34,$62,$1f,$d1,$34,$62,$1f,$98,$a6,$fe,$8a,$c4,$a6,$fe,$8a,$16,
$2e,$53,$9d,$34,$2e,$53,$9d,$d4,$f3,$55,$a0,$a2,$f3,$55,$a0,$a4,
$8a,$e1,$32,$05,$8a,$e1,$32,$5c,$f6,$eb,$75,$a4,$f6,$eb,$75,$cc,
$83,$ec,$39,$0b,$83,$ec,$39,$5d,$60,$ef,$aa,$40,$60,$ef,$aa,$65,
$71,$9f,$06,$5e,$71,$9f,$06,$b6,$6e,$10,$51,$bd,$6e,$10,$51,$92,
$21,$8a,$f9,$3e,$21,$8a,$f9,$6c,$dd,$06,$3d,$96,$dd,$06,$3d,$70,
$3e,$05,$ae,$dd,$3e,$05,$ae,$48,$e6,$bd,$46,$4d,$e6,$bd,$46,$50,
$54,$8d,$b5,$91,$54,$8d,$b5,$fd,$c4,$5d,$05,$71,$c4,$5d,$05,$ed,
$06,$d4,$6f,$04,$06,$d4,$6f,$b9,$50,$15,$ff,$60,$50,$15,$ff,$da,
$98,$fb,$24,$19,$98,$fb,$24,$5e,$bd,$e9,$97,$d6,$bd,$e9,$97,$15,
$40,$43,$cc,$89,$40,$43,$cc,$46,$d9,$9e,$77,$67,$d9,$9e,$77,$57,
$e8,$42,$bd,$b0,$e8,$42,$bd,$a7,$89,$8b,$88,$07,$89,$8b,$88,$8d,
$19,$5b,$38,$e7,$19,$5b,$38,$9d,$c8,$ee,$db,$79,$c8,$ee,$db,$84,
$7c,$0a,$47,$a1,$7c,$0a,$47,$90,$42,$0f,$e9,$7c,$42,$0f,$e9,$d8,
$84,$1e,$c9,$f8,$84,$1e,$c9,$ab,$00,$00,$00,$00,$00,$00,$00,$00,
$80,$86,$83,$09,$80,$86,$83,$8c,$2b,$ed,$48,$32,$2b,$ed,$48,$bc,
$11,$70,$ac,$1e,$11,$70,$ac,$d3,$5a,$72,$4e,$6c,$5a,$72,$4e,$0a,
$0e,$ff,$fb,$fd,$0e,$ff,$fb,$f7,$85,$38,$56,$0f,$85,$38,$56,$e4,
$ae,$d5,$1e,$3d,$ae,$d5,$1e,$58,$2d,$39,$27,$36,$2d,$39,$27,$05,
$0f,$d9,$64,$0a,$0f,$d9,$64,$b8,$5c,$a6,$21,$68,$5c,$a6,$21,$b3,
$5b,$54,$d1,$9b,$5b,$54,$d1,$45,$36,$2e,$3a,$24,$36,$2e,$3a,$06,
$0a,$67,$b1,$0c,$0a,$67,$b1,$d0,$57,$e7,$0f,$93,$57,$e7,$0f,$2c,
$ee,$96,$d2,$b4,$ee,$96,$d2,$1e,$9b,$91,$9e,$1b,$9b,$91,$9e,$8f,
$c0,$c5,$4f,$80,$c0,$c5,$4f,$ca,$dc,$20,$a2,$61,$dc,$20,$a2,$3f,
$77,$4b,$69,$5a,$77,$4b,$69,$0f,$12,$1a,$16,$1c,$12,$1a,$16,$02,
$93,$ba,$0a,$e2,$93,$ba,$0a,$c1,$a0,$2a,$e5,$c0,$a0,$2a,$e5,$af,
$22,$e0,$43,$3c,$22,$e0,$43,$bd,$1b,$17,$1d,$12,$1b,$17,$1d,$03,
$09,$0d,$0b,$0e,$09,$0d,$0b,$01,$8b,$c7,$ad,$f2,$8b,$c7,$ad,$13,
$b6,$a8,$b9,$2d,$b6,$a8,$b9,$8a,$1e,$a9,$c8,$14,$1e,$a9,$c8,$6b,
$f1,$19,$85,$57,$f1,$19,$85,$3a,$75,$07,$4c,$af,$75,$07,$4c,$91,
$99,$dd,$bb,$ee,$99,$dd,$bb,$11,$7f,$60,$fd,$a3,$7f,$60,$fd,$41,
$01,$26,$9f,$f7,$01,$26,$9f,$4f,$72,$f5,$bc,$5c,$72,$f5,$bc,$67,
$66,$3b,$c5,$44,$66,$3b,$c5,$dc,$fb,$7e,$34,$5b,$fb,$7e,$34,$ea,
$43,$29,$76,$8b,$43,$29,$76,$97,$23,$c6,$dc,$cb,$23,$c6,$dc,$f2,
$ed,$fc,$68,$b6,$ed,$fc,$68,$cf,$e4,$f1,$63,$b8,$e4,$f1,$63,$ce,
$31,$dc,$ca,$d7,$31,$dc,$ca,$f0,$63,$85,$10,$42,$63,$85,$10,$b4,
$97,$22,$40,$13,$97,$22,$40,$e6,$c6,$11,$20,$84,$c6,$11,$20,$73,
$4a,$24,$7d,$85,$4a,$24,$7d,$96,$bb,$3d,$f8,$d2,$bb,$3d,$f8,$ac,
$f9,$32,$11,$ae,$f9,$32,$11,$74,$29,$a1,$6d,$c7,$29,$a1,$6d,$22,
$9e,$2f,$4b,$1d,$9e,$2f,$4b,$e7,$b2,$30,$f3,$dc,$b2,$30,$f3,$ad,
$86,$52,$ec,$0d,$86,$52,$ec,$35,$c1,$e3,$d0,$77,$c1,$e3,$d0,$85,
$b3,$16,$6c,$2b,$b3,$16,$6c,$e2,$70,$b9,$99,$a9,$70,$b9,$99,$f9,
$94,$48,$fa,$11,$94,$48,$fa,$37,$e9,$64,$22,$47,$e9,$64,$22,$e8,
$fc,$8c,$c4,$a8,$fc,$8c,$c4,$1c,$f0,$3f,$1a,$a0,$f0,$3f,$1a,$75,
$7d,$2c,$d8,$56,$7d,$2c,$d8,$df,$33,$90,$ef,$22,$33,$90,$ef,$6e,
$49,$4e,$c7,$87,$49,$4e,$c7,$47,$38,$d1,$c1,$d9,$38,$d1,$c1,$f1,
$ca,$a2,$fe,$8c,$ca,$a2,$fe,$1a,$d4,$0b,$36,$98,$d4,$0b,$36,$71,
$f5,$81,$cf,$a6,$f5,$81,$cf,$1d,$7a,$de,$28,$a5,$7a,$de,$28,$29,
$b7,$8e,$26,$da,$b7,$8e,$26,$c5,$ad,$bf,$a4,$3f,$ad,$bf,$a4,$89,
$3a,$9d,$e4,$2c,$3a,$9d,$e4,$6f,$78,$92,$0d,$50,$78,$92,$0d,$b7,
$5f,$cc,$9b,$6a,$5f,$cc,$9b,$62,$7e,$46,$62,$54,$7e,$46,$62,$0e,
$8d,$13,$c2,$f6,$8d,$13,$c2,$aa,$d8,$b8,$e8,$90,$d8,$b8,$e8,$18,
$39,$f7,$5e,$2e,$39,$f7,$5e,$be,$c3,$af,$f5,$82,$c3,$af,$f5,$1b,
$5d,$80,$be,$9f,$5d,$80,$be,$fc,$d0,$93,$7c,$69,$d0,$93,$7c,$56,
$d5,$2d,$a9,$6f,$d5,$2d,$a9,$3e,$25,$12,$b3,$cf,$25,$12,$b3,$4b,
$ac,$99,$3b,$c8,$ac,$99,$3b,$c6,$18,$7d,$a7,$10,$18,$7d,$a7,$d2,
$9c,$63,$6e,$e8,$9c,$63,$6e,$79,$3b,$bb,$7b,$db,$3b,$bb,$7b,$20,
$26,$78,$09,$cd,$26,$78,$09,$9a,$59,$18,$f4,$6e,$59,$18,$f4,$db,
$9a,$b7,$01,$ec,$9a,$b7,$01,$c0,$4f,$9a,$a8,$83,$4f,$9a,$a8,$fe,
$95,$6e,$65,$e6,$95,$6e,$65,$78,$ff,$e6,$7e,$aa,$ff,$e6,$7e,$cd,
$bc,$cf,$08,$21,$bc,$cf,$08,$5a,$15,$e8,$e6,$ef,$15,$e8,$e6,$f4,
$e7,$9b,$d9,$ba,$e7,$9b,$d9,$1f,$6f,$36,$ce,$4a,$6f,$36,$ce,$dd,
$9f,$09,$d4,$ea,$9f,$09,$d4,$a8,$b0,$7c,$d6,$29,$b0,$7c,$d6,$33,
$a4,$b2,$af,$31,$a4,$b2,$af,$88,$3f,$23,$31,$2a,$3f,$23,$31,$07,
$a5,$94,$30,$c6,$a5,$94,$30,$c7,$a2,$66,$c0,$35,$a2,$66,$c0,$31,
$4e,$bc,$37,$74,$4e,$bc,$37,$b1,$82,$ca,$a6,$fc,$82,$ca,$a6,$12,
$90,$d0,$b0,$e0,$90,$d0,$b0,$10,$a7,$d8,$15,$33,$a7,$d8,$15,$59,
$04,$98,$4a,$f1,$04,$98,$4a,$27,$ec,$da,$f7,$41,$ec,$da,$f7,$80,
$cd,$50,$0e,$7f,$cd,$50,$0e,$ec,$91,$f6,$2f,$17,$91,$f6,$2f,$5f,
$4d,$d6,$8d,$76,$4d,$d6,$8d,$60,$ef,$b0,$4d,$43,$ef,$b0,$4d,$51,
$aa,$4d,$54,$cc,$aa,$4d,$54,$7f,$96,$04,$df,$e4,$96,$04,$df,$a9,
$d1,$b5,$e3,$9e,$d1,$b5,$e3,$19,$6a,$88,$1b,$4c,$6a,$88,$1b,$b5,
$2c,$1f,$b8,$c1,$2c,$1f,$b8,$4a,$65,$51,$7f,$46,$65,$51,$7f,$0d,
$5e,$ea,$04,$9d,$5e,$ea,$04,$2d,$8c,$35,$5d,$01,$8c,$35,$5d,$e5,
$87,$74,$73,$fa,$87,$74,$73,$7a,$0b,$41,$2e,$fb,$0b,$41,$2e,$9f,
$67,$1d,$5a,$b3,$67,$1d,$5a,$93,$db,$d2,$52,$92,$db,$d2,$52,$c9,
$10,$56,$33,$e9,$10,$56,$33,$9c,$d6,$47,$13,$6d,$d6,$47,$13,$ef,
$d7,$61,$8c,$9a,$d7,$61,$8c,$a0,$a1,$0c,$7a,$37,$a1,$0c,$7a,$e0,
$f8,$14,$8e,$59,$f8,$14,$8e,$3b,$13,$3c,$89,$eb,$13,$3c,$89,$4d,
$a9,$27,$ee,$ce,$a9,$27,$ee,$ae,$61,$c9,$35,$b7,$61,$c9,$35,$2a,
$1c,$e5,$ed,$e1,$1c,$e5,$ed,$f5,$47,$b1,$3c,$7a,$47,$b1,$3c,$b0,
$d2,$df,$59,$9c,$d2,$df,$59,$c8,$f2,$73,$3f,$55,$f2,$73,$3f,$eb,
$14,$ce,$79,$18,$14,$ce,$79,$bb,$c7,$37,$bf,$73,$c7,$37,$bf,$3c,
$f7,$cd,$ea,$53,$f7,$cd,$ea,$83,$fd,$aa,$5b,$5f,$fd,$aa,$5b,$53,
$3d,$6f,$14,$df,$3d,$6f,$14,$99,$44,$db,$86,$78,$44,$db,$86,$61,
$af,$f3,$81,$ca,$af,$f3,$81,$17,$68,$c4,$3e,$b9,$68,$c4,$3e,$2b,
$24,$34,$2c,$38,$24,$34,$2c,$04,$a3,$40,$5f,$c2,$a3,$40,$5f,$7e,
$1d,$c3,$72,$16,$1d,$c3,$72,$ba,$e2,$25,$0c,$bc,$e2,$25,$0c,$77,
$3c,$49,$8b,$28,$3c,$49,$8b,$d6,$0d,$95,$41,$ff,$0d,$95,$41,$26,
$a8,$01,$71,$39,$a8,$01,$71,$e1,$0c,$b3,$de,$08,$0c,$b3,$de,$69,
$b4,$e4,$9c,$d8,$b4,$e4,$9c,$14,$56,$c1,$90,$64,$56,$c1,$90,$63,
$cb,$84,$61,$7b,$cb,$84,$61,$55,$32,$b6,$70,$d5,$32,$b6,$70,$21,
$6c,$5c,$74,$48,$6c,$5c,$74,$0c,$b8,$57,$42,$d0,$b8,$57,$42,$7d);
var
Td: packed array[byte] of TDU absolute TCd;
{$ifdef StrictLong}
{$warnings on}
{$ifdef RangeChecks_on}
{$R+}
{$endif}
{$endif}

94
Tocsg.Lib/VCL/EncLib/AES/dec_cp16.inc Normal file
View File

@ -0,0 +1,94 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for Pascal16/Compressed tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 13.07.06 we Uses TDe box byte instead of InvSBox
0.12 15.11.08 we Use Ptr2Inc from BTypes
**************************************************************************)
(**** (C) Copyright 2002-2008 Wolfgang Ehrhardt -- see copying_we.txt ****)
{Normally used for TP5/5.5 (and during development BP7)}
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
label done;
var
r: integer;
pK: PWA4; {pointer to loop rount key }
s,t: TAESBlock;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK[ctx.Rounds]);
{Initialize with input block}
TWA4(s)[0] := TWA4(BI)[0] xor pK^[0];
TWA4(s)[1] := TWA4(BI)[1] xor pK^[1];
TWA4(s)[2] := TWA4(BI)[2] xor pK^[2];
TWA4(s)[3] := TWA4(BI)[3] xor pK^[3];
dec(Ptr2Inc(pK), 4*sizeof(longint));
r := ctx.Rounds-1;
while true do begin
TWA4(t)[3] := Td[s[3*4+0]].D0.L xor Td[s[2*4+1]].D1.L xor Td[s[1*4+2]].D2.L xor Td[s[0*4+3]].D3.L xor pK^[3];
TWA4(t)[2] := Td[s[2*4+0]].D0.L xor Td[s[1*4+1]].D1.L xor Td[s[0*4+2]].D2.L xor Td[s[3*4+3]].D3.L xor pK^[2];
TWA4(t)[1] := Td[s[1*4+0]].D0.L xor Td[s[0*4+1]].D1.L xor Td[s[3*4+2]].D2.L xor Td[s[2*4+3]].D3.L xor pK^[1];
TWA4(t)[0] := Td[s[0*4+0]].D0.L xor Td[s[3*4+1]].D1.L xor Td[s[2*4+2]].D2.L xor Td[s[1*4+3]].D3.L xor pK^[0];
dec(Ptr2Inc(pK), 4*sizeof(longint));
dec(r);
if r<1 then goto done;
TWA4(s)[3] := Td[t[3*4+0]].D0.L xor Td[t[2*4+1]].D1.L xor Td[t[1*4+2]].D2.L xor Td[t[0*4+3]].D3.L xor pK^[3];
TWA4(s)[2] := Td[t[2*4+0]].D0.L xor Td[t[1*4+1]].D1.L xor Td[t[0*4+2]].D2.L xor Td[t[3*4+3]].D3.L xor pK^[2];
TWA4(s)[1] := Td[t[1*4+0]].D0.L xor Td[t[0*4+1]].D1.L xor Td[t[3*4+2]].D2.L xor Td[t[2*4+3]].D3.L xor pK^[1];
TWA4(s)[0] := Td[t[0*4+0]].D0.L xor Td[t[3*4+1]].D1.L xor Td[t[2*4+2]].D2.L xor Td[t[1*4+3]].D3.L xor pK^[0];
dec(Ptr2Inc(pK), 4*sizeof(longint));
dec(r);
end;
done:
s[00] := Td[t[0*4+0]].D0.box;
s[01] := Td[t[3*4+1]].D0.box;
s[02] := Td[t[2*4+2]].D0.box;
s[03] := Td[t[1*4+3]].D0.box;
s[04] := Td[t[1*4+0]].D0.box;
s[05] := Td[t[0*4+1]].D0.box;
s[06] := Td[t[3*4+2]].D0.box;
s[07] := Td[t[2*4+3]].D0.box;
s[08] := Td[t[2*4+0]].D0.box;
s[09] := Td[t[1*4+1]].D0.box;
s[10] := Td[t[0*4+2]].D0.box;
s[11] := Td[t[3*4+3]].D0.box;
s[12] := Td[t[3*4+0]].D0.box;
s[13] := Td[t[2*4+1]].D0.box;
s[14] := Td[t[1*4+2]].D0.box;
s[15] := Td[t[0*4+3]].D0.box;
TWA4(BO)[0] := TWA4(s)[0] xor pK^[0];
TWA4(BO)[1] := TWA4(s)[1] xor pK^[1];
TWA4(BO)[2] := TWA4(s)[2] xor pK^[2];
TWA4(BO)[3] := TWA4(s)[3] xor pK^[3];
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
i: integer;
x: longint;
t: TBA4 absolute x;
begin
with ctx do begin
for i:=4 to 4*Rounds-1 do begin
{Inverse MixColumns transformation: use Sbox and}
{implicit endian conversion compared with [2] }
x := TAWK(RK)[i];
TAWK(RK)[i] := Td[SBox[t[3]]].D3.L xor Td[SBox[t[2]]].D2.L xor Td[SBox[t[1]]].D1.L xor Td[SBox[t[0]]].D0.L;
end;
end;
end;

83
Tocsg.Lib/VCL/EncLib/AES/dec_cp32.inc Normal file
View File

@ -0,0 +1,83 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for BIT32/Compressed tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 09.07.06 we Removed AES_LONGBOX code
0.12 13.07.06 we Uses TCd box byte instead of InvSBox
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
var
r: integer; {round loop countdown counter}
pK: PWA4; {pointer to loop rount key }
s0,s1,s2,s3: longint; {TAESBlock s as separate variables}
t: TWA4;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK[ctx.Rounds]);
{Initialize with input block}
s0 := TWA4(BI)[0] xor pK^[0];
s1 := TWA4(BI)[1] xor pK^[1];
s2 := TWA4(BI)[2] xor pK^[2];
s3 := TWA4(BI)[3] xor pK^[3];
dec(pK);
{perform encryption rounds}
for r:=1 to ctx.Rounds-1 do begin
t[3] := Td[s3 and $ff].D0.L xor Td[s2 shr 8 and $ff].D1.L xor Td[s1 shr 16 and $ff].D2.L xor Td[s0 shr 24].D3.L xor pK^[3];
t[2] := Td[s2 and $ff].D0.L xor Td[s1 shr 8 and $ff].D1.L xor Td[s0 shr 16 and $ff].D2.L xor Td[s3 shr 24].D3.L xor pK^[2];
t[1] := Td[s1 and $ff].D0.L xor Td[s0 shr 8 and $ff].D1.L xor Td[s3 shr 16 and $ff].D2.L xor Td[s2 shr 24].D3.L xor pK^[1];
s0 := Td[s0 and $ff].D0.L xor Td[s3 shr 8 and $ff].D1.L xor Td[s2 shr 16 and $ff].D2.L xor Td[s1 shr 24].D3.L xor pK^[0];
s1 := t[1];
s2 := t[2];
s3 := t[3];
dec(pK);
end;
{Uses InvSbox byte from Td and shl, needs type cast longint() for 16 bit compilers}
TWA4(BO)[0] := (longint(Td[s0 and $ff].D0.box) xor
longint(Td[s3 shr 8 and $ff].D0.box) shl 8 xor
longint(Td[s2 shr 16 and $ff].D0.box) shl 16 xor
longint(Td[s1 shr 24 ].D0.box) shl 24 ) xor pK^[0];
TWA4(BO)[1] := (longint(Td[s1 and $ff].D0.box) xor
longint(Td[s0 shr 8 and $ff].D0.box) shl 8 xor
longint(Td[s3 shr 16 and $ff].D0.box) shl 16 xor
longint(Td[s2 shr 24 ].D0.box) shl 24 ) xor pK^[1];
TWA4(BO)[2] := (longint(Td[s2 and $ff ].D0.box) xor
longint(Td[s1 shr 8 and $ff].D0.box) shl 8 xor
longint(Td[s0 shr 16 and $ff].D0.box) shl 16 xor
longint(Td[s3 shr 24 ].D0.box) shl 24 ) xor pK^[2];
TWA4(BO)[3] := (longint(Td[s3 and $ff ].D0.box) xor
longint(Td[s2 shr 8 and $ff].D0.box) shl 8 xor
longint(Td[s1 shr 16 and $ff].D0.box) shl 16 xor
longint(Td[s0 shr 24 ].D0.box) shl 24 ) xor pK^[3];
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
i: integer;
p: PLong;
x: longint;
begin
p := PLong(@ctx.RK[1]);
for i:=1 to 4*(ctx.Rounds-1) do begin
x := p^;
p^ := Td[SBox[x shr 24]].D3.L xor Td[SBox[x shr 16 and $ff]].D2.L xor
Td[SBox[x shr 8 and $ff]].D1.L xor Td[SBox[x and $ff]].D0.L;
inc(p);
end;
end;

358
Tocsg.Lib/VCL/EncLib/AES/dec_fa16.inc Normal file
View File

@ -0,0 +1,358 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for BASM16/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_DECR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{16 bit BASM used for TP6, BP7, Delphi1}
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
s,t: TAESBlock;
r: integer;
pK: pointer;
begin
r := ctx.Rounds-1;
pK := @ctx.RK[ctx.Rounds];
asm
{AES_XorBlock(BI, ctx.RK[ctx.Rounds], s);}
db $66; pusha
les si,[BI]
db $66; mov ax,es:[si]
db $66; mov bx,es:[si+4]
db $66; mov cx,es:[si+8]
db $66; mov dx,es:[si+12]
les di,[pK]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
db $66; mov word ptr [s],ax
db $66; mov word ptr [s+4],bx
db $66; mov word ptr [s+8],cx
db $66; mov word ptr [s+12],dx
sub di,16 {di -> ctx.RK[r]}
mov cx,[r]
{ op eax, mem[4*bx] is calculated as }
{ lea esi, [ebx + 2*ebx] }
{ op eax, mem[ebx+esi] }
{ lea esi,[ebx+2*ebx] = db $66,$67,$8D,$34,$5B; }
db $66; sub bx,bx
@@1:
{TWA4(t)[3] := Td0[s[3*4+0]] xor Td1[s[2*4+1]] xor Td2[s[1*4+2]] xor Td3[s[0*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr s[3*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr s[2*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr s[1*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr s[0*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di+12]
db $66; mov word ptr t[12],ax
{TWA4(t)[2] := Td0[s[2*4+0]] xor Td1[s[1*4+1]] xor Td2[s[0*4+2]] xor Td3[s[3*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr s[2*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr s[1*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr s[0*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr s[3*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di+8]
db $66; mov word ptr t[8],ax
{TWA4(t)[1] := Td0[s[1*4+0]] xor Td1[s[0*4+1]] xor Td2[s[3*4+2]] xor Td3[s[2*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr s[1*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr s[0*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr s[3*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr s[2*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di+4]
db $66; mov word ptr t[4],ax
{TWA4(t)[0] := Td0[s[0*4+0]] xor Td1[s[3*4+1]] xor Td2[s[2*4+2]] xor Td3[s[1*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr s[0*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr s[3*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr s[2*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr s[1*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di]
db $66; mov word ptr t[0],ax
{ dec(r); if r<1 then break;}
sub cx,1
jle @@2
{TWA4(s)[3] := Td0[t[3*4+0]] xor Td1[t[2*4+1]] xor Td2[t[1*4+2]] xor Td3[t[0*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr t[3*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr t[2*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr t[1*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr t[0*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di-4]
db $66; mov word ptr s[12],ax
{TWA4(s)[2] := Td0[t[2*4+0]] xor Td1[t[1*4+1]] xor Td2[t[0*4+2]] xor Td3[t[3*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr t[2*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr t[1*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr t[0*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr t[3*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di-8]
db $66; mov word ptr s[8],ax
{TWA4(s)[1] := Td0[t[1*4+0]] xor Td1[t[0*4+1]] xor Td2[t[3*4+2]] xor Td3[t[2*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr t[1*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr t[0*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr t[3*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr t[2*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di-12]
db $66; mov word ptr s[4],ax
{TWA4(s)[0] := Td0[t[0*4+0]] xor Td1[t[3*4+1]] xor Td2[t[2*4+2]] xor Td3[t[1*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr t[0*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Td0[bx+si]
mov bl,byte ptr t[3*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td1[bx+si]
mov bl,byte ptr t[2*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td2[bx+si]
mov bl,byte ptr t[1*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Td3[bx+si]
db $66; xor ax,es:[di-16]
db $66; mov word ptr s[0],ax
sub di,32
dec cx
jmp @@1
@@2: sub di,16 {di -> ctx.RK[0]}
sub bx,bx
mov bl, byte ptr t[0*4+0]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[0],al
mov bl, byte ptr t[3*4+1]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[1],al
mov bl, byte ptr t[2*4+2]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[2],al
mov bl, byte ptr t[1*4+3]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[3],al
mov bl, byte ptr t[1*4+0]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[4],al
mov bl, byte ptr t[0*4+1]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[5],al
mov bl, byte ptr t[3*4+2]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[6],al
mov bl, byte ptr t[2*4+3]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[7],al
mov bl, byte ptr t[2*4+0]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[8],al
mov bl, byte ptr t[1*4+1]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[9],al
mov bl, byte ptr t[0*4+2]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[10],al
mov bl, byte ptr t[3*4+3]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[11],al
mov bl, byte ptr t[3*4+0]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[12],al
mov bl, byte ptr t[2*4+1]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[13],al
mov bl, byte ptr t[1*4+2]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[14],al
mov bl, byte ptr t[0*4+3]
mov al, byte ptr InvSBox[bx]
mov byte ptr s[15],al
{AES_XorBlock(s, ctx.RK[0], BO);}
db $66; mov ax,word ptr [s]
db $66; mov bx,word ptr [s+4]
db $66; mov cx,word ptr [s+8]
db $66; mov dx,word ptr [s+12]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
les si,[BO]
db $66; mov es:[si],ax
db $66; mov es:[si+4],bx
db $66; mov es:[si+8],cx
db $66; mov es:[si+12],dx
db $66; popa
end;
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
n: integer;
p: PLong;
begin
p := Plong(@ctx.RK[1]);
n := 4*(ctx.Rounds-1);
{BASM version of 16 bit code, no need for local x/t}
{implicit endian conversion compared with [2]}
asm
les si,[p]
mov cx,[n]
@@1: mov dx,es:[si]
sub bh,bh
mov bl,dl
mov bl,byte ptr SBox[bx]
shl bx,2
db $66; mov ax,word ptr Td0[bx]
sub bh,bh
mov bl,dh
mov bl,byte ptr SBox[bx]
shl bx,2
db $66; xor ax,word ptr Td1[bx]
mov dx,es:[si+2]
sub bh,bh
mov bl,dl
mov bl,byte ptr SBox[bx]
shl bx,2
db $66; xor ax,word ptr Td2[bx]
sub bh,bh
mov bl,dh
mov bl,byte ptr SBox[bx]
shl bx,2
db $66; xor ax,word ptr Td3[bx]
db $66; mov es:[si],ax
add si,4
dec cx
jnz @@1
end;
end;

224
Tocsg.Lib/VCL/EncLib/AES/dec_fdat.inc Normal file
View File

@ -0,0 +1,224 @@
(*************************************************************************
Include file for AES_DECR.PAS - Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_DECR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{$ifdef StrictLong}
{$warnings off}
{$R-} {avoid D9+ errors!}
{$endif}
const
InvSBox: array[byte] of byte =
($52, $09, $6a, $d5, $30, $36, $a5, $38, $bf, $40, $a3, $9e, $81, $f3, $d7, $fb,
$7c, $e3, $39, $82, $9b, $2f, $ff, $87, $34, $8e, $43, $44, $c4, $de, $e9, $cb,
$54, $7b, $94, $32, $a6, $c2, $23, $3d, $ee, $4c, $95, $0b, $42, $fa, $c3, $4e,
$08, $2e, $a1, $66, $28, $d9, $24, $b2, $76, $5b, $a2, $49, $6d, $8b, $d1, $25,
$72, $f8, $f6, $64, $86, $68, $98, $16, $d4, $a4, $5c, $cc, $5d, $65, $b6, $92,
$6c, $70, $48, $50, $fd, $ed, $b9, $da, $5e, $15, $46, $57, $a7, $8d, $9d, $84,
$90, $d8, $ab, $00, $8c, $bc, $d3, $0a, $f7, $e4, $58, $05, $b8, $b3, $45, $06,
$d0, $2c, $1e, $8f, $ca, $3f, $0f, $02, $c1, $af, $bd, $03, $01, $13, $8a, $6b,
$3a, $91, $11, $41, $4f, $67, $dc, $ea, $97, $f2, $cf, $ce, $f0, $b4, $e6, $73,
$96, $ac, $74, $22, $e7, $ad, $35, $85, $e2, $f9, $37, $e8, $1c, $75, $df, $6e,
$47, $f1, $1a, $71, $1d, $29, $c5, $89, $6f, $b7, $62, $0e, $aa, $18, $be, $1b,
$fc, $56, $3e, $4b, $c6, $d2, $79, $20, $9a, $db, $c0, $fe, $78, $cd, $5a, $f4,
$1f, $dd, $a8, $33, $88, $07, $c7, $31, $b1, $12, $10, $59, $27, $80, $ec, $5f,
$60, $51, $7f, $a9, $19, $b5, $4a, $0d, $2d, $e5, $7a, $9f, $93, $c9, $9c, $ef,
$a0, $e0, $3b, $4d, $ae, $2a, $f5, $b0, $c8, $eb, $bb, $3c, $83, $53, $99, $61,
$17, $2b, $04, $7e, $ba, $77, $d6, $26, $e1, $69, $14, $63, $55, $21, $0c, $7d);
const
Td0: array[byte] of longint =
($50a7f451, $5365417e, $c3a4171a, $965e273a, $cb6bab3b, $f1459d1f, $ab58faac, $9303e34b,
$55fa3020, $f66d76ad, $9176cc88, $254c02f5, $fcd7e54f, $d7cb2ac5, $80443526, $8fa362b5,
$495ab1de, $671bba25, $980eea45, $e1c0fe5d, $02752fc3, $12f04c81, $a397468d, $c6f9d36b,
$e75f8f03, $959c9215, $eb7a6dbf, $da595295, $2d83bed4, $d3217458, $2969e049, $44c8c98e,
$6a89c275, $78798ef4, $6b3e5899, $dd71b927, $b64fe1be, $17ad88f0, $66ac20c9, $b43ace7d,
$184adf63, $82311ae5, $60335197, $457f5362, $e07764b1, $84ae6bbb, $1ca081fe, $942b08f9,
$58684870, $19fd458f, $876cde94, $b7f87b52, $23d373ab, $e2024b72, $578f1fe3, $2aab5566,
$0728ebb2, $03c2b52f, $9a7bc586, $a50837d3, $f2872830, $b2a5bf23, $ba6a0302, $5c8216ed,
$2b1ccf8a, $92b479a7, $f0f207f3, $a1e2694e, $cdf4da65, $d5be0506, $1f6234d1, $8afea6c4,
$9d532e34, $a055f3a2, $32e18a05, $75ebf6a4, $39ec830b, $aaef6040, $069f715e, $51106ebd,
$f98a213e, $3d06dd96, $ae053edd, $46bde64d, $b58d5491, $055dc471, $6fd40604, $ff155060,
$24fb9819, $97e9bdd6, $cc434089, $779ed967, $bd42e8b0, $888b8907, $385b19e7, $dbeec879,
$470a7ca1, $e90f427c, $c91e84f8, $00000000, $83868009, $48ed2b32, $ac70111e, $4e725a6c,
$fbff0efd, $5638850f, $1ed5ae3d, $27392d36, $64d90f0a, $21a65c68, $d1545b9b, $3a2e3624,
$b1670a0c, $0fe75793, $d296eeb4, $9e919b1b, $4fc5c080, $a220dc61, $694b775a, $161a121c,
$0aba93e2, $e52aa0c0, $43e0223c, $1d171b12, $0b0d090e, $adc78bf2, $b9a8b62d, $c8a91e14,
$8519f157, $4c0775af, $bbdd99ee, $fd607fa3, $9f2601f7, $bcf5725c, $c53b6644, $347efb5b,
$7629438b, $dcc623cb, $68fcedb6, $63f1e4b8, $cadc31d7, $10856342, $40229713, $2011c684,
$7d244a85, $f83dbbd2, $1132f9ae, $6da129c7, $4b2f9e1d, $f330b2dc, $ec52860d, $d0e3c177,
$6c16b32b, $99b970a9, $fa489411, $2264e947, $c48cfca8, $1a3ff0a0, $d82c7d56, $ef903322,
$c74e4987, $c1d138d9, $fea2ca8c, $360bd498, $cf81f5a6, $28de7aa5, $268eb7da, $a4bfad3f,
$e49d3a2c, $0d927850, $9bcc5f6a, $62467e54, $c2138df6, $e8b8d890, $5ef7392e, $f5afc382,
$be805d9f, $7c93d069, $a92dd56f, $b31225cf, $3b99acc8, $a77d1810, $6e639ce8, $7bbb3bdb,
$097826cd, $f418596e, $01b79aec, $a89a4f83, $656e95e6, $7ee6ffaa, $08cfbc21, $e6e815ef,
$d99be7ba, $ce366f4a, $d4099fea, $d67cb029, $afb2a431, $31233f2a, $3094a5c6, $c066a235,
$37bc4e74, $a6ca82fc, $b0d090e0, $15d8a733, $4a9804f1, $f7daec41, $0e50cd7f, $2ff69117,
$8dd64d76, $4db0ef43, $544daacc, $df0496e4, $e3b5d19e, $1b886a4c, $b81f2cc1, $7f516546,
$04ea5e9d, $5d358c01, $737487fa, $2e410bfb, $5a1d67b3, $52d2db92, $335610e9, $1347d66d,
$8c61d79a, $7a0ca137, $8e14f859, $893c13eb, $ee27a9ce, $35c961b7, $ede51ce1, $3cb1477a,
$59dfd29c, $3f73f255, $79ce1418, $bf37c773, $eacdf753, $5baafd5f, $146f3ddf, $86db4478,
$81f3afca, $3ec468b9, $2c342438, $5f40a3c2, $72c31d16, $0c25e2bc, $8b493c28, $41950dff,
$7101a839, $deb30c08, $9ce4b4d8, $90c15664, $6184cb7b, $70b632d5, $745c6c48, $4257b8d0);
Td1: array[byte] of longint =
($a7f45150, $65417e53, $a4171ac3, $5e273a96, $6bab3bcb, $459d1ff1, $58faacab, $03e34b93,
$fa302055, $6d76adf6, $76cc8891, $4c02f525, $d7e54ffc, $cb2ac5d7, $44352680, $a362b58f,
$5ab1de49, $1bba2567, $0eea4598, $c0fe5de1, $752fc302, $f04c8112, $97468da3, $f9d36bc6,
$5f8f03e7, $9c921595, $7a6dbfeb, $595295da, $83bed42d, $217458d3, $69e04929, $c8c98e44,
$89c2756a, $798ef478, $3e58996b, $71b927dd, $4fe1beb6, $ad88f017, $ac20c966, $3ace7db4,
$4adf6318, $311ae582, $33519760, $7f536245, $7764b1e0, $ae6bbb84, $a081fe1c, $2b08f994,
$68487058, $fd458f19, $6cde9487, $f87b52b7, $d373ab23, $024b72e2, $8f1fe357, $ab55662a,
$28ebb207, $c2b52f03, $7bc5869a, $0837d3a5, $872830f2, $a5bf23b2, $6a0302ba, $8216ed5c,
$1ccf8a2b, $b479a792, $f207f3f0, $e2694ea1, $f4da65cd, $be0506d5, $6234d11f, $fea6c48a,
$532e349d, $55f3a2a0, $e18a0532, $ebf6a475, $ec830b39, $ef6040aa, $9f715e06, $106ebd51,
$8a213ef9, $06dd963d, $053eddae, $bde64d46, $8d5491b5, $5dc47105, $d406046f, $155060ff,
$fb981924, $e9bdd697, $434089cc, $9ed96777, $42e8b0bd, $8b890788, $5b19e738, $eec879db,
$0a7ca147, $0f427ce9, $1e84f8c9, $00000000, $86800983, $ed2b3248, $70111eac, $725a6c4e,
$ff0efdfb, $38850f56, $d5ae3d1e, $392d3627, $d90f0a64, $a65c6821, $545b9bd1, $2e36243a,
$670a0cb1, $e757930f, $96eeb4d2, $919b1b9e, $c5c0804f, $20dc61a2, $4b775a69, $1a121c16,
$ba93e20a, $2aa0c0e5, $e0223c43, $171b121d, $0d090e0b, $c78bf2ad, $a8b62db9, $a91e14c8,
$19f15785, $0775af4c, $dd99eebb, $607fa3fd, $2601f79f, $f5725cbc, $3b6644c5, $7efb5b34,
$29438b76, $c623cbdc, $fcedb668, $f1e4b863, $dc31d7ca, $85634210, $22971340, $11c68420,
$244a857d, $3dbbd2f8, $32f9ae11, $a129c76d, $2f9e1d4b, $30b2dcf3, $52860dec, $e3c177d0,
$16b32b6c, $b970a999, $489411fa, $64e94722, $8cfca8c4, $3ff0a01a, $2c7d56d8, $903322ef,
$4e4987c7, $d138d9c1, $a2ca8cfe, $0bd49836, $81f5a6cf, $de7aa528, $8eb7da26, $bfad3fa4,
$9d3a2ce4, $9278500d, $cc5f6a9b, $467e5462, $138df6c2, $b8d890e8, $f7392e5e, $afc382f5,
$805d9fbe, $93d0697c, $2dd56fa9, $1225cfb3, $99acc83b, $7d1810a7, $639ce86e, $bb3bdb7b,
$7826cd09, $18596ef4, $b79aec01, $9a4f83a8, $6e95e665, $e6ffaa7e, $cfbc2108, $e815efe6,
$9be7bad9, $366f4ace, $099fead4, $7cb029d6, $b2a431af, $233f2a31, $94a5c630, $66a235c0,
$bc4e7437, $ca82fca6, $d090e0b0, $d8a73315, $9804f14a, $daec41f7, $50cd7f0e, $f691172f,
$d64d768d, $b0ef434d, $4daacc54, $0496e4df, $b5d19ee3, $886a4c1b, $1f2cc1b8, $5165467f,
$ea5e9d04, $358c015d, $7487fa73, $410bfb2e, $1d67b35a, $d2db9252, $5610e933, $47d66d13,
$61d79a8c, $0ca1377a, $14f8598e, $3c13eb89, $27a9ceee, $c961b735, $e51ce1ed, $b1477a3c,
$dfd29c59, $73f2553f, $ce141879, $37c773bf, $cdf753ea, $aafd5f5b, $6f3ddf14, $db447886,
$f3afca81, $c468b93e, $3424382c, $40a3c25f, $c31d1672, $25e2bc0c, $493c288b, $950dff41,
$01a83971, $b30c08de, $e4b4d89c, $c1566490, $84cb7b61, $b632d570, $5c6c4874, $57b8d042);
Td2: array[byte] of longint =
($f45150a7, $417e5365, $171ac3a4, $273a965e, $ab3bcb6b, $9d1ff145, $faacab58, $e34b9303,
$302055fa, $76adf66d, $cc889176, $02f5254c, $e54ffcd7, $2ac5d7cb, $35268044, $62b58fa3,
$b1de495a, $ba25671b, $ea45980e, $fe5de1c0, $2fc30275, $4c8112f0, $468da397, $d36bc6f9,
$8f03e75f, $9215959c, $6dbfeb7a, $5295da59, $bed42d83, $7458d321, $e0492969, $c98e44c8,
$c2756a89, $8ef47879, $58996b3e, $b927dd71, $e1beb64f, $88f017ad, $20c966ac, $ce7db43a,
$df63184a, $1ae58231, $51976033, $5362457f, $64b1e077, $6bbb84ae, $81fe1ca0, $08f9942b,
$48705868, $458f19fd, $de94876c, $7b52b7f8, $73ab23d3, $4b72e202, $1fe3578f, $55662aab,
$ebb20728, $b52f03c2, $c5869a7b, $37d3a508, $2830f287, $bf23b2a5, $0302ba6a, $16ed5c82,
$cf8a2b1c, $79a792b4, $07f3f0f2, $694ea1e2, $da65cdf4, $0506d5be, $34d11f62, $a6c48afe,
$2e349d53, $f3a2a055, $8a0532e1, $f6a475eb, $830b39ec, $6040aaef, $715e069f, $6ebd5110,
$213ef98a, $dd963d06, $3eddae05, $e64d46bd, $5491b58d, $c471055d, $06046fd4, $5060ff15,
$981924fb, $bdd697e9, $4089cc43, $d967779e, $e8b0bd42, $8907888b, $19e7385b, $c879dbee,
$7ca1470a, $427ce90f, $84f8c91e, $00000000, $80098386, $2b3248ed, $111eac70, $5a6c4e72,
$0efdfbff, $850f5638, $ae3d1ed5, $2d362739, $0f0a64d9, $5c6821a6, $5b9bd154, $36243a2e,
$0a0cb167, $57930fe7, $eeb4d296, $9b1b9e91, $c0804fc5, $dc61a220, $775a694b, $121c161a,
$93e20aba, $a0c0e52a, $223c43e0, $1b121d17, $090e0b0d, $8bf2adc7, $b62db9a8, $1e14c8a9,
$f1578519, $75af4c07, $99eebbdd, $7fa3fd60, $01f79f26, $725cbcf5, $6644c53b, $fb5b347e,
$438b7629, $23cbdcc6, $edb668fc, $e4b863f1, $31d7cadc, $63421085, $97134022, $c6842011,
$4a857d24, $bbd2f83d, $f9ae1132, $29c76da1, $9e1d4b2f, $b2dcf330, $860dec52, $c177d0e3,
$b32b6c16, $70a999b9, $9411fa48, $e9472264, $fca8c48c, $f0a01a3f, $7d56d82c, $3322ef90,
$4987c74e, $38d9c1d1, $ca8cfea2, $d498360b, $f5a6cf81, $7aa528de, $b7da268e, $ad3fa4bf,
$3a2ce49d, $78500d92, $5f6a9bcc, $7e546246, $8df6c213, $d890e8b8, $392e5ef7, $c382f5af,
$5d9fbe80, $d0697c93, $d56fa92d, $25cfb312, $acc83b99, $1810a77d, $9ce86e63, $3bdb7bbb,
$26cd0978, $596ef418, $9aec01b7, $4f83a89a, $95e6656e, $ffaa7ee6, $bc2108cf, $15efe6e8,
$e7bad99b, $6f4ace36, $9fead409, $b029d67c, $a431afb2, $3f2a3123, $a5c63094, $a235c066,
$4e7437bc, $82fca6ca, $90e0b0d0, $a73315d8, $04f14a98, $ec41f7da, $cd7f0e50, $91172ff6,
$4d768dd6, $ef434db0, $aacc544d, $96e4df04, $d19ee3b5, $6a4c1b88, $2cc1b81f, $65467f51,
$5e9d04ea, $8c015d35, $87fa7374, $0bfb2e41, $67b35a1d, $db9252d2, $10e93356, $d66d1347,
$d79a8c61, $a1377a0c, $f8598e14, $13eb893c, $a9ceee27, $61b735c9, $1ce1ede5, $477a3cb1,
$d29c59df, $f2553f73, $141879ce, $c773bf37, $f753eacd, $fd5f5baa, $3ddf146f, $447886db,
$afca81f3, $68b93ec4, $24382c34, $a3c25f40, $1d1672c3, $e2bc0c25, $3c288b49, $0dff4195,
$a8397101, $0c08deb3, $b4d89ce4, $566490c1, $cb7b6184, $32d570b6, $6c48745c, $b8d04257);
Td3: array[byte] of longint =
($5150a7f4, $7e536541, $1ac3a417, $3a965e27, $3bcb6bab, $1ff1459d, $acab58fa, $4b9303e3,
$2055fa30, $adf66d76, $889176cc, $f5254c02, $4ffcd7e5, $c5d7cb2a, $26804435, $b58fa362,
$de495ab1, $25671bba, $45980eea, $5de1c0fe, $c302752f, $8112f04c, $8da39746, $6bc6f9d3,
$03e75f8f, $15959c92, $bfeb7a6d, $95da5952, $d42d83be, $58d32174, $492969e0, $8e44c8c9,
$756a89c2, $f478798e, $996b3e58, $27dd71b9, $beb64fe1, $f017ad88, $c966ac20, $7db43ace,
$63184adf, $e582311a, $97603351, $62457f53, $b1e07764, $bb84ae6b, $fe1ca081, $f9942b08,
$70586848, $8f19fd45, $94876cde, $52b7f87b, $ab23d373, $72e2024b, $e3578f1f, $662aab55,
$b20728eb, $2f03c2b5, $869a7bc5, $d3a50837, $30f28728, $23b2a5bf, $02ba6a03, $ed5c8216,
$8a2b1ccf, $a792b479, $f3f0f207, $4ea1e269, $65cdf4da, $06d5be05, $d11f6234, $c48afea6,
$349d532e, $a2a055f3, $0532e18a, $a475ebf6, $0b39ec83, $40aaef60, $5e069f71, $bd51106e,
$3ef98a21, $963d06dd, $ddae053e, $4d46bde6, $91b58d54, $71055dc4, $046fd406, $60ff1550,
$1924fb98, $d697e9bd, $89cc4340, $67779ed9, $b0bd42e8, $07888b89, $e7385b19, $79dbeec8,
$a1470a7c, $7ce90f42, $f8c91e84, $00000000, $09838680, $3248ed2b, $1eac7011, $6c4e725a,
$fdfbff0e, $0f563885, $3d1ed5ae, $3627392d, $0a64d90f, $6821a65c, $9bd1545b, $243a2e36,
$0cb1670a, $930fe757, $b4d296ee, $1b9e919b, $804fc5c0, $61a220dc, $5a694b77, $1c161a12,
$e20aba93, $c0e52aa0, $3c43e022, $121d171b, $0e0b0d09, $f2adc78b, $2db9a8b6, $14c8a91e,
$578519f1, $af4c0775, $eebbdd99, $a3fd607f, $f79f2601, $5cbcf572, $44c53b66, $5b347efb,
$8b762943, $cbdcc623, $b668fced, $b863f1e4, $d7cadc31, $42108563, $13402297, $842011c6,
$857d244a, $d2f83dbb, $ae1132f9, $c76da129, $1d4b2f9e, $dcf330b2, $0dec5286, $77d0e3c1,
$2b6c16b3, $a999b970, $11fa4894, $472264e9, $a8c48cfc, $a01a3ff0, $56d82c7d, $22ef9033,
$87c74e49, $d9c1d138, $8cfea2ca, $98360bd4, $a6cf81f5, $a528de7a, $da268eb7, $3fa4bfad,
$2ce49d3a, $500d9278, $6a9bcc5f, $5462467e, $f6c2138d, $90e8b8d8, $2e5ef739, $82f5afc3,
$9fbe805d, $697c93d0, $6fa92dd5, $cfb31225, $c83b99ac, $10a77d18, $e86e639c, $db7bbb3b,
$cd097826, $6ef41859, $ec01b79a, $83a89a4f, $e6656e95, $aa7ee6ff, $2108cfbc, $efe6e815,
$bad99be7, $4ace366f, $ead4099f, $29d67cb0, $31afb2a4, $2a31233f, $c63094a5, $35c066a2,
$7437bc4e, $fca6ca82, $e0b0d090, $3315d8a7, $f14a9804, $41f7daec, $7f0e50cd, $172ff691,
$768dd64d, $434db0ef, $cc544daa, $e4df0496, $9ee3b5d1, $4c1b886a, $c1b81f2c, $467f5165,
$9d04ea5e, $015d358c, $fa737487, $fb2e410b, $b35a1d67, $9252d2db, $e9335610, $6d1347d6,
$9a8c61d7, $377a0ca1, $598e14f8, $eb893c13, $ceee27a9, $b735c961, $e1ede51c, $7a3cb147,
$9c59dfd2, $553f73f2, $1879ce14, $73bf37c7, $53eacdf7, $5f5baafd, $df146f3d, $7886db44,
$ca81f3af, $b93ec468, $382c3424, $c25f40a3, $1672c31d, $bc0c25e2, $288b493c, $ff41950d,
$397101a8, $08deb30c, $d89ce4b4, $6490c156, $7b6184cb, $d570b632, $48745c6c, $d04257b8);
{$ifdef AES_LONGBOX}
Td4: array[byte] of longint =
($52525252, $09090909, $6a6a6a6a, $d5d5d5d5, $30303030, $36363636, $a5a5a5a5, $38383838,
$bfbfbfbf, $40404040, $a3a3a3a3, $9e9e9e9e, $81818181, $f3f3f3f3, $d7d7d7d7, $fbfbfbfb,
$7c7c7c7c, $e3e3e3e3, $39393939, $82828282, $9b9b9b9b, $2f2f2f2f, $ffffffff, $87878787,
$34343434, $8e8e8e8e, $43434343, $44444444, $c4c4c4c4, $dededede, $e9e9e9e9, $cbcbcbcb,
$54545454, $7b7b7b7b, $94949494, $32323232, $a6a6a6a6, $c2c2c2c2, $23232323, $3d3d3d3d,
$eeeeeeee, $4c4c4c4c, $95959595, $0b0b0b0b, $42424242, $fafafafa, $c3c3c3c3, $4e4e4e4e,
$08080808, $2e2e2e2e, $a1a1a1a1, $66666666, $28282828, $d9d9d9d9, $24242424, $b2b2b2b2,
$76767676, $5b5b5b5b, $a2a2a2a2, $49494949, $6d6d6d6d, $8b8b8b8b, $d1d1d1d1, $25252525,
$72727272, $f8f8f8f8, $f6f6f6f6, $64646464, $86868686, $68686868, $98989898, $16161616,
$d4d4d4d4, $a4a4a4a4, $5c5c5c5c, $cccccccc, $5d5d5d5d, $65656565, $b6b6b6b6, $92929292,
$6c6c6c6c, $70707070, $48484848, $50505050, $fdfdfdfd, $edededed, $b9b9b9b9, $dadadada,
$5e5e5e5e, $15151515, $46464646, $57575757, $a7a7a7a7, $8d8d8d8d, $9d9d9d9d, $84848484,
$90909090, $d8d8d8d8, $abababab, $00000000, $8c8c8c8c, $bcbcbcbc, $d3d3d3d3, $0a0a0a0a,
$f7f7f7f7, $e4e4e4e4, $58585858, $05050505, $b8b8b8b8, $b3b3b3b3, $45454545, $06060606,
$d0d0d0d0, $2c2c2c2c, $1e1e1e1e, $8f8f8f8f, $cacacaca, $3f3f3f3f, $0f0f0f0f, $02020202,
$c1c1c1c1, $afafafaf, $bdbdbdbd, $03030303, $01010101, $13131313, $8a8a8a8a, $6b6b6b6b,
$3a3a3a3a, $91919191, $11111111, $41414141, $4f4f4f4f, $67676767, $dcdcdcdc, $eaeaeaea,
$97979797, $f2f2f2f2, $cfcfcfcf, $cececece, $f0f0f0f0, $b4b4b4b4, $e6e6e6e6, $73737373,
$96969696, $acacacac, $74747474, $22222222, $e7e7e7e7, $adadadad, $35353535, $85858585,
$e2e2e2e2, $f9f9f9f9, $37373737, $e8e8e8e8, $1c1c1c1c, $75757575, $dfdfdfdf, $6e6e6e6e,
$47474747, $f1f1f1f1, $1a1a1a1a, $71717171, $1d1d1d1d, $29292929, $c5c5c5c5, $89898989,
$6f6f6f6f, $b7b7b7b7, $62626262, $0e0e0e0e, $aaaaaaaa, $18181818, $bebebebe, $1b1b1b1b,
$fcfcfcfc, $56565656, $3e3e3e3e, $4b4b4b4b, $c6c6c6c6, $d2d2d2d2, $79797979, $20202020,
$9a9a9a9a, $dbdbdbdb, $c0c0c0c0, $fefefefe, $78787878, $cdcdcdcd, $5a5a5a5a, $f4f4f4f4,
$1f1f1f1f, $dddddddd, $a8a8a8a8, $33333333, $88888888, $07070707, $c7c7c7c7, $31313131,
$b1b1b1b1, $12121212, $10101010, $59595959, $27272727, $80808080, $ecececec, $5f5f5f5f,
$60606060, $51515151, $7f7f7f7f, $a9a9a9a9, $19191919, $b5b5b5b5, $4a4a4a4a, $0d0d0d0d,
$2d2d2d2d, $e5e5e5e5, $7a7a7a7a, $9f9f9f9f, $93939393, $c9c9c9c9, $9c9c9c9c, $efefefef,
$a0a0a0a0, $e0e0e0e0, $3b3b3b3b, $4d4d4d4d, $aeaeaeae, $2a2a2a2a, $f5f5f5f5, $b0b0b0b0,
$c8c8c8c8, $ebebebeb, $bbbbbbbb, $3c3c3c3c, $83838383, $53535353, $99999999, $61616161,
$17171717, $2b2b2b2b, $04040404, $7e7e7e7e, $babababa, $77777777, $d6d6d6d6, $26262626,
$e1e1e1e1, $69696969, $14141414, $63636363, $55555555, $21212121, $0c0c0c0c, $7d7d7d7d);
{$endif}
{$ifdef StrictLong}
{$warnings on}
{$ifdef RangeChecks_on}
{$R+}
{$endif}
{$endif}
{$ifdef AES_LONGBOX}
const
X000000ff = longint($000000ff); {Avoid D4+ warnings}
X0000ff00 = longint($0000ff00);
X00ff0000 = longint($00ff0000);
Xff000000 = longint($ff000000);
{$endif}

92
Tocsg.Lib/VCL/EncLib/AES/dec_fp16.inc Normal file
View File

@ -0,0 +1,92 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for Pascal16/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_DECR.PAS
0.11 15.11.08 we Use Ptr2Inc from BTypes
**************************************************************************)
(**** (C) Copyright 2002-2008 Wolfgang Ehrhardt -- see copying_we.txt ****)
{Normally used for TP5/5.5 (and during development BP7)}
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
label done;
var
r: integer;
pK: PWA4; {pointer to loop rount key }
s,t: TAESBlock;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK[ctx.Rounds]);
{Initialize with input block}
TWA4(s)[0] := TWA4(BI)[0] xor pK^[0];
TWA4(s)[1] := TWA4(BI)[1] xor pK^[1];
TWA4(s)[2] := TWA4(BI)[2] xor pK^[2];
TWA4(s)[3] := TWA4(BI)[3] xor pK^[3];
dec(Ptr2Inc(pK), 4*sizeof(longint));
r := ctx.Rounds-1;
while true do begin
TWA4(t)[3] := Td0[s[3*4+0]] xor Td1[s[2*4+1]] xor Td2[s[1*4+2]] xor Td3[s[0*4+3]] xor pK^[3];
TWA4(t)[2] := Td0[s[2*4+0]] xor Td1[s[1*4+1]] xor Td2[s[0*4+2]] xor Td3[s[3*4+3]] xor pK^[2];
TWA4(t)[1] := Td0[s[1*4+0]] xor Td1[s[0*4+1]] xor Td2[s[3*4+2]] xor Td3[s[2*4+3]] xor pK^[1];
TWA4(t)[0] := Td0[s[0*4+0]] xor Td1[s[3*4+1]] xor Td2[s[2*4+2]] xor Td3[s[1*4+3]] xor pK^[0];
dec(Ptr2Inc(pK), 4*sizeof(longint));
dec(r);
if r<1 then goto done;
TWA4(s)[3] := Td0[t[3*4+0]] xor Td1[t[2*4+1]] xor Td2[t[1*4+2]] xor Td3[t[0*4+3]] xor pK^[3];
TWA4(s)[2] := Td0[t[2*4+0]] xor Td1[t[1*4+1]] xor Td2[t[0*4+2]] xor Td3[t[3*4+3]] xor pK^[2];
TWA4(s)[1] := Td0[t[1*4+0]] xor Td1[t[0*4+1]] xor Td2[t[3*4+2]] xor Td3[t[2*4+3]] xor pK^[1];
TWA4(s)[0] := Td0[t[0*4+0]] xor Td1[t[3*4+1]] xor Td2[t[2*4+2]] xor Td3[t[1*4+3]] xor pK^[0];
dec(Ptr2Inc(pK), 4*sizeof(longint));
dec(r);
end;
done:
s[00] := InvSBox[t[0*4+0]];
s[01] := InvSBox[t[3*4+1]];
s[02] := InvSBox[t[2*4+2]];
s[03] := InvSBox[t[1*4+3]];
s[04] := InvSBox[t[1*4+0]];
s[05] := InvSBox[t[0*4+1]];
s[06] := InvSBox[t[3*4+2]];
s[07] := InvSBox[t[2*4+3]];
s[08] := InvSBox[t[2*4+0]];
s[09] := InvSBox[t[1*4+1]];
s[10] := InvSBox[t[0*4+2]];
s[11] := InvSBox[t[3*4+3]];
s[12] := InvSBox[t[3*4+0]];
s[13] := InvSBox[t[2*4+1]];
s[14] := InvSBox[t[1*4+2]];
s[15] := InvSBox[t[0*4+3]];
TWA4(BO)[0] := TWA4(s)[0] xor pK^[0];
TWA4(BO)[1] := TWA4(s)[1] xor pK^[1];
TWA4(BO)[2] := TWA4(s)[2] xor pK^[2];
TWA4(BO)[3] := TWA4(s)[3] xor pK^[3];
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
i: integer;
x: longint;
t: TBA4 absolute x;
begin
with ctx do begin
for i:=4 to 4*Rounds-1 do begin
{Inverse MixColumns transformation: use Sbox and}
{implicit endian conversion compared with [2] }
x := TAWK(RK)[i];
TAWK(RK)[i] := Td3[SBox[t[3]]] xor Td2[SBox[t[2]]] xor Td1[SBox[t[1]]] xor Td0[SBox[t[0]]];
end;
end;
end;

106
Tocsg.Lib/VCL/EncLib/AES/dec_fp32.inc Normal file
View File

@ -0,0 +1,106 @@
(*************************************************************************
Include file for AES_DECR.PAS - AES_Decrypt for BIT32/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_DECR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{ 32 Bit code: Alternative versions can be found in options.zip
dec_full.inc - fully unrolled version for highest speed
dec_ptr.inc - pointer version (may be faster on some systems)
}
{---------------------------------------------------------------------------}
procedure AES_Decrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-decrypt one block (in ECB mode)}
var
r: integer; {round loop countdown counter}
pK: PWA4; {pointer to loop rount key }
s0,s1,s2,s3: longint; {TAESBlock s as separate variables}
t: TWA4;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK[ctx.Rounds]);
{Initialize with input block}
s0 := TWA4(BI)[0] xor pK^[0];
s1 := TWA4(BI)[1] xor pK^[1];
s2 := TWA4(BI)[2] xor pK^[2];
s3 := TWA4(BI)[3] xor pK^[3];
dec(pK);
{perform encryption rounds}
for r:=1 to ctx.Rounds-1 do begin
t[3] := Td0[s3 and $ff] xor Td1[s2 shr 8 and $ff] xor Td2[s1 shr 16 and $ff] xor Td3[s0 shr 24] xor pK^[3];
t[2] := Td0[s2 and $ff] xor Td1[s1 shr 8 and $ff] xor Td2[s0 shr 16 and $ff] xor Td3[s3 shr 24] xor pK^[2];
t[1] := Td0[s1 and $ff] xor Td1[s0 shr 8 and $ff] xor Td2[s3 shr 16 and $ff] xor Td3[s2 shr 24] xor pK^[1];
s0 := Td0[s0 and $ff] xor Td1[s3 shr 8 and $ff] xor Td2[s2 shr 16 and $ff] xor Td3[s1 shr 24] xor pK^[0];
s1 := t[1];
s2 := t[2];
s3 := t[3];
dec(pK);
end;
{$ifdef AES_LONGBOX}
{Use expanded longint InvSBox table Td4 from [2]}
TWA4(BO)[0] := (Td4[s0 and $ff] and X000000ff) xor
(Td4[s3 shr 8 and $ff] and X0000ff00) xor
(Td4[s2 shr 16 and $ff] and X00ff0000) xor
(Td4[s1 shr 24 ] and Xff000000) xor pK^[0];
TWA4(BO)[1] := (Td4[s1 and $ff] and X000000ff) xor
(Td4[s0 shr 8 and $ff] and X0000ff00) xor
(Td4[s3 shr 16 and $ff] and X00ff0000) xor
(Td4[s2 shr 24 ] and Xff000000) xor pK^[1];
TWA4(BO)[2] := (Td4[s2 and $ff ] and X000000ff) xor
(Td4[s1 shr 8 and $ff] and X0000ff00) xor
(Td4[s0 shr 16 and $ff] and X00ff0000) xor
(Td4[s3 shr 24 ] and Xff000000) xor pK^[2];
TWA4(BO)[3] := (Td4[s3 and $ff ] and X000000ff) xor
(Td4[s2 shr 8 and $ff] and X0000ff00) xor
(Td4[s1 shr 16 and $ff] and X00ff0000) xor
(Td4[s0 shr 24 ] and Xff000000) xor pK^[3];
{$else}
{Uses InvSbox and shl, needs type cast longint() for }
{16 bit compilers: here InvSbox is byte, Td4 is longint}
TWA4(BO)[0] := (longint(InvSBox[s0 and $ff]) xor
longint(InvSBox[s3 shr 8 and $ff]) shl 8 xor
longint(InvSBox[s2 shr 16 and $ff]) shl 16 xor
longint(InvSBox[s1 shr 24 ]) shl 24 ) xor pK^[0];
TWA4(BO)[1] := (longint(InvSBox[s1 and $ff]) xor
longint(InvSBox[s0 shr 8 and $ff]) shl 8 xor
longint(InvSBox[s3 shr 16 and $ff]) shl 16 xor
longint(InvSBox[s2 shr 24 ]) shl 24 ) xor pK^[1];
TWA4(BO)[2] := (longint(InvSBox[s2 and $ff ]) xor
longint(InvSBox[s1 shr 8 and $ff]) shl 8 xor
longint(InvSBox[s0 shr 16 and $ff]) shl 16 xor
longint(InvSBox[s3 shr 24 ]) shl 24 ) xor pK^[2];
TWA4(BO)[3] := (longint(InvSBox[s3 and $ff ]) xor
longint(InvSBox[s2 shr 8 and $ff]) shl 8 xor
longint(InvSBox[s1 shr 16 and $ff]) shl 16 xor
longint(InvSBox[s0 shr 24 ]) shl 24 ) xor pK^[3];
{$endif}
end;
{---------------------------------------------------------------------------}
procedure MakeDecrKey(var ctx: TAESContext);
{-Calculate decryption key from encryption key}
var
i: integer;
p: PLong;
x: longint;
begin
p := PLong(@ctx.RK[1]);
for i:=1 to 4*(ctx.Rounds-1) do begin
x := p^;
p^ := Td3[SBox[x shr 24]] xor Td2[SBox[x shr 16 and $ff]] xor Td1[SBox[x shr 8 and $ff]] xor Td0[SBox[x and $ff]];
inc(p);
end;
end;

350
Tocsg.Lib/VCL/EncLib/AES/enc_ca16.inc Normal file
View File

@ -0,0 +1,350 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for BASM16/Compressed table
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed table
0.11 10.07.06 we Removed bx in TCe[bx+si+?]
0.13 13.07.06 we Uses TCe box byte instead of SBox
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{16 bit BASM used for TP6, BP7, Delphi1}
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
s,t: TAESBlock;
rnd: integer;
pK: pointer;
begin
rnd := ctx.rounds;
pK := @ctx.RK;
asm
db $66; pusha
{AES_XorBlock(BI, ctx.RK[0], s);}
les si,[BI]
db $66; mov ax,es:[si]
db $66; mov bx,es:[si+4]
db $66; mov cx,es:[si+8]
db $66; mov dx,es:[si+12]
les di,[pK]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
db $66; mov word ptr [s],ax
db $66; mov word ptr [s+4],bx
db $66; mov word ptr [s+8],cx
db $66; mov word ptr [s+12],dx
add di,16 {di->ctx.RK[1]}
mov cx,[rnd]
dec cx
{ *Note* in the following round loop }
{ op eax, mem[8*ebx] is calculated as }
{ lea esi, [edx+8*ebx] $66,$67,$8D,$34,$DA }
{ op eax, mem[esi] }
db $66; sub bx,bx {clear ebx}
db $66; sub dx,dx {clear edx}
@@1:
{TWA4(t)[0] := Te0[s[0*4+0]] xor Te1[s[1*4+1]] xor Te2[s[2*4+2]] xor Te3[s[3*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr s[0*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr s[1*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr s[2*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr s[3*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di]
db $66; mov word ptr t[0],ax
{TWA4(t)[1] := Te0[s[1*4+0]] xor Te1[s[2*4+1]] xor Te2[s[3*4+2]] xor Te3[s[0*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr s[1*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr s[2*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr s[3*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr s[0*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+4]
db $66; mov word ptr t[4],ax
{TWA4(t)[2] := Te0[s[2*4+0]] xor Te1[s[3*4+1]] xor Te2[s[0*4+2]] xor Te3[s[1*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr s[2*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr s[3*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr s[0*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr s[1*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+8]
db $66; mov word ptr t[8],ax
{TWA4(t)[3] := Te0[s[3*4+0]] xor Te1[s[0*4+1]] xor Te2[s[1*4+2]] xor Te3[s[2*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr s[3*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr s[0*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr s[1*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr s[2*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+12]
db $66; mov word ptr t[12],ax
{if r>=ctx.rounds then break;}
dec cx
jbe @@2
{TWA4(s)[0] := Te0[t[0*4+0]] xor Te1[t[1*4+1]] xor Te2[t[2*4+2]] xor Te3[t[3*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr t[0*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr t[1*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr t[2*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr t[3*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+16]
db $66; mov word ptr s[0],ax
{TWA4(s)[1] := Te0[t[1*4+0]] xor Te1[t[2*4+1]] xor Te2[t[3*4+2]] xor Te3[t[0*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr t[1*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr t[2*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr t[3*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr t[0*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+20]
db $66; mov word ptr s[4],ax
{TWA4(s)[2] := Te0[t[2*4+0]] xor Te1[t[3*4+1]] xor Te2[t[0*4+2]] xor Te3[t[1*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr t[2*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr t[3*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr t[0*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr t[1*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+24]
db $66; mov word ptr s[8],ax
{TWA4(s)[3] := Te0[t[3*4+0]] xor Te1[t[0*4+1]] xor Te2[t[1*4+2]] xor Te3[t[2*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr t[3*4+0]
db $66,$67,$8D,$34,$DA;
db $66; mov ax,word ptr TCe[si+3]
mov bl,byte ptr t[0*4+1]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+2]
mov bl,byte ptr t[1*4+2]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si+1]
mov bl,byte ptr t[2*4+3]
db $66,$67,$8D,$34,$DA;
db $66; xor ax,word ptr TCe[si]
db $66; xor ax,es:[di+28]
add di,32
db $66; mov word ptr s[12],ax
dec cx
jmp @@1
@@2: add di,16 {di -> ctx.RK[ctx.rounds]}
{Last round uses SBox}
mov bl, byte ptr t[0*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[0],al
mov bl, byte ptr t[1*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[1],al
mov bl, byte ptr t[2*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[2],al
mov bl, byte ptr t[3*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[3],al
mov bl, byte ptr t[1*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[4],al
mov bl, byte ptr t[2*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[5],al
mov bl, byte ptr t[3*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[6],al
mov bl, byte ptr t[0*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[7],al
mov bl, byte ptr t[2*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[8],al
mov bl, byte ptr t[3*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[9],al
mov bl, byte ptr t[0*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[10],al
mov bl, byte ptr t[1*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[11],al
mov bl, byte ptr t[3*4+0]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[12],al
mov bl, byte ptr t[0*4+1]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[13],al
mov bl, byte ptr t[1*4+2]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[14],al
mov bl, byte ptr t[2*4+3]
sub bh,bh
shl bx,3
mov al, byte ptr TCe[bx+7]
mov byte ptr s[15],al
{AES_XorBlock(s, ctx.RK[rnd], BO)}
db $66; mov ax,word ptr [s]
db $66; mov bx,word ptr [s+4]
db $66; mov cx,word ptr [s+8]
db $66; mov dx,word ptr [s+12]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
les si,[BO]
db $66; mov es:[si],ax
db $66; mov es:[si+4],bx
db $66; mov es:[si+8],cx
db $66; mov es:[si+12],dx
db $66; popa
end;
end;

196
Tocsg.Lib/VCL/EncLib/AES/enc_cdat.inc Normal file
View File

@ -0,0 +1,196 @@
(*************************************************************************
Include file for AES_ENCR.PAS - Compressed tables/Helper types
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 13.07.06 we Removed AES_LONGBOX consts, b3 gets box byte
0.12 19.07.06 we TCeDummy
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
type
TH3 = packed record
L: longint;
b0,b1,b2,box: byte;
end;
TH2 = packed record
b0: byte;
L: longint;
b1,b2,box: byte;
end;
TH1 = packed record
b0,b1: byte;
L: longint;
b2,box: byte;
end;
TH0 = packed record
b0,b1,b2: byte;
L: longint;
box: byte;
end;
TEU = record
case integer of
0: (E0: TH0);
1: (E1: TH1);
2: (E2: TH2);
3: (E3: TH3);
end;
{$ifdef StrictLong}
{$warnings off}
{$R-} {avoid D9+ errors!}
{$endif}
const
{$ifdef AES_Encr_DummyAlign}
TCeDummy : longint = 0; {Use to align TCe to 8 byte boundary}
{$endif}
TCe: packed array[0..2047] of byte = (
$63,$63,$a5,$c6,$63,$63,$a5,$63,$7c,$7c,$84,$f8,$7c,$7c,$84,$7c,
$77,$77,$99,$ee,$77,$77,$99,$77,$7b,$7b,$8d,$f6,$7b,$7b,$8d,$7b,
$f2,$f2,$0d,$ff,$f2,$f2,$0d,$f2,$6b,$6b,$bd,$d6,$6b,$6b,$bd,$6b,
$6f,$6f,$b1,$de,$6f,$6f,$b1,$6f,$c5,$c5,$54,$91,$c5,$c5,$54,$c5,
$30,$30,$50,$60,$30,$30,$50,$30,$01,$01,$03,$02,$01,$01,$03,$01,
$67,$67,$a9,$ce,$67,$67,$a9,$67,$2b,$2b,$7d,$56,$2b,$2b,$7d,$2b,
$fe,$fe,$19,$e7,$fe,$fe,$19,$fe,$d7,$d7,$62,$b5,$d7,$d7,$62,$d7,
$ab,$ab,$e6,$4d,$ab,$ab,$e6,$ab,$76,$76,$9a,$ec,$76,$76,$9a,$76,
$ca,$ca,$45,$8f,$ca,$ca,$45,$ca,$82,$82,$9d,$1f,$82,$82,$9d,$82,
$c9,$c9,$40,$89,$c9,$c9,$40,$c9,$7d,$7d,$87,$fa,$7d,$7d,$87,$7d,
$fa,$fa,$15,$ef,$fa,$fa,$15,$fa,$59,$59,$eb,$b2,$59,$59,$eb,$59,
$47,$47,$c9,$8e,$47,$47,$c9,$47,$f0,$f0,$0b,$fb,$f0,$f0,$0b,$f0,
$ad,$ad,$ec,$41,$ad,$ad,$ec,$ad,$d4,$d4,$67,$b3,$d4,$d4,$67,$d4,
$a2,$a2,$fd,$5f,$a2,$a2,$fd,$a2,$af,$af,$ea,$45,$af,$af,$ea,$af,
$9c,$9c,$bf,$23,$9c,$9c,$bf,$9c,$a4,$a4,$f7,$53,$a4,$a4,$f7,$a4,
$72,$72,$96,$e4,$72,$72,$96,$72,$c0,$c0,$5b,$9b,$c0,$c0,$5b,$c0,
$b7,$b7,$c2,$75,$b7,$b7,$c2,$b7,$fd,$fd,$1c,$e1,$fd,$fd,$1c,$fd,
$93,$93,$ae,$3d,$93,$93,$ae,$93,$26,$26,$6a,$4c,$26,$26,$6a,$26,
$36,$36,$5a,$6c,$36,$36,$5a,$36,$3f,$3f,$41,$7e,$3f,$3f,$41,$3f,
$f7,$f7,$02,$f5,$f7,$f7,$02,$f7,$cc,$cc,$4f,$83,$cc,$cc,$4f,$cc,
$34,$34,$5c,$68,$34,$34,$5c,$34,$a5,$a5,$f4,$51,$a5,$a5,$f4,$a5,
$e5,$e5,$34,$d1,$e5,$e5,$34,$e5,$f1,$f1,$08,$f9,$f1,$f1,$08,$f1,
$71,$71,$93,$e2,$71,$71,$93,$71,$d8,$d8,$73,$ab,$d8,$d8,$73,$d8,
$31,$31,$53,$62,$31,$31,$53,$31,$15,$15,$3f,$2a,$15,$15,$3f,$15,
$04,$04,$0c,$08,$04,$04,$0c,$04,$c7,$c7,$52,$95,$c7,$c7,$52,$c7,
$23,$23,$65,$46,$23,$23,$65,$23,$c3,$c3,$5e,$9d,$c3,$c3,$5e,$c3,
$18,$18,$28,$30,$18,$18,$28,$18,$96,$96,$a1,$37,$96,$96,$a1,$96,
$05,$05,$0f,$0a,$05,$05,$0f,$05,$9a,$9a,$b5,$2f,$9a,$9a,$b5,$9a,
$07,$07,$09,$0e,$07,$07,$09,$07,$12,$12,$36,$24,$12,$12,$36,$12,
$80,$80,$9b,$1b,$80,$80,$9b,$80,$e2,$e2,$3d,$df,$e2,$e2,$3d,$e2,
$eb,$eb,$26,$cd,$eb,$eb,$26,$eb,$27,$27,$69,$4e,$27,$27,$69,$27,
$b2,$b2,$cd,$7f,$b2,$b2,$cd,$b2,$75,$75,$9f,$ea,$75,$75,$9f,$75,
$09,$09,$1b,$12,$09,$09,$1b,$09,$83,$83,$9e,$1d,$83,$83,$9e,$83,
$2c,$2c,$74,$58,$2c,$2c,$74,$2c,$1a,$1a,$2e,$34,$1a,$1a,$2e,$1a,
$1b,$1b,$2d,$36,$1b,$1b,$2d,$1b,$6e,$6e,$b2,$dc,$6e,$6e,$b2,$6e,
$5a,$5a,$ee,$b4,$5a,$5a,$ee,$5a,$a0,$a0,$fb,$5b,$a0,$a0,$fb,$a0,
$52,$52,$f6,$a4,$52,$52,$f6,$52,$3b,$3b,$4d,$76,$3b,$3b,$4d,$3b,
$d6,$d6,$61,$b7,$d6,$d6,$61,$d6,$b3,$b3,$ce,$7d,$b3,$b3,$ce,$b3,
$29,$29,$7b,$52,$29,$29,$7b,$29,$e3,$e3,$3e,$dd,$e3,$e3,$3e,$e3,
$2f,$2f,$71,$5e,$2f,$2f,$71,$2f,$84,$84,$97,$13,$84,$84,$97,$84,
$53,$53,$f5,$a6,$53,$53,$f5,$53,$d1,$d1,$68,$b9,$d1,$d1,$68,$d1,
$00,$00,$00,$00,$00,$00,$00,$00,$ed,$ed,$2c,$c1,$ed,$ed,$2c,$ed,
$20,$20,$60,$40,$20,$20,$60,$20,$fc,$fc,$1f,$e3,$fc,$fc,$1f,$fc,
$b1,$b1,$c8,$79,$b1,$b1,$c8,$b1,$5b,$5b,$ed,$b6,$5b,$5b,$ed,$5b,
$6a,$6a,$be,$d4,$6a,$6a,$be,$6a,$cb,$cb,$46,$8d,$cb,$cb,$46,$cb,
$be,$be,$d9,$67,$be,$be,$d9,$be,$39,$39,$4b,$72,$39,$39,$4b,$39,
$4a,$4a,$de,$94,$4a,$4a,$de,$4a,$4c,$4c,$d4,$98,$4c,$4c,$d4,$4c,
$58,$58,$e8,$b0,$58,$58,$e8,$58,$cf,$cf,$4a,$85,$cf,$cf,$4a,$cf,
$d0,$d0,$6b,$bb,$d0,$d0,$6b,$d0,$ef,$ef,$2a,$c5,$ef,$ef,$2a,$ef,
$aa,$aa,$e5,$4f,$aa,$aa,$e5,$aa,$fb,$fb,$16,$ed,$fb,$fb,$16,$fb,
$43,$43,$c5,$86,$43,$43,$c5,$43,$4d,$4d,$d7,$9a,$4d,$4d,$d7,$4d,
$33,$33,$55,$66,$33,$33,$55,$33,$85,$85,$94,$11,$85,$85,$94,$85,
$45,$45,$cf,$8a,$45,$45,$cf,$45,$f9,$f9,$10,$e9,$f9,$f9,$10,$f9,
$02,$02,$06,$04,$02,$02,$06,$02,$7f,$7f,$81,$fe,$7f,$7f,$81,$7f,
$50,$50,$f0,$a0,$50,$50,$f0,$50,$3c,$3c,$44,$78,$3c,$3c,$44,$3c,
$9f,$9f,$ba,$25,$9f,$9f,$ba,$9f,$a8,$a8,$e3,$4b,$a8,$a8,$e3,$a8,
$51,$51,$f3,$a2,$51,$51,$f3,$51,$a3,$a3,$fe,$5d,$a3,$a3,$fe,$a3,
$40,$40,$c0,$80,$40,$40,$c0,$40,$8f,$8f,$8a,$05,$8f,$8f,$8a,$8f,
$92,$92,$ad,$3f,$92,$92,$ad,$92,$9d,$9d,$bc,$21,$9d,$9d,$bc,$9d,
$38,$38,$48,$70,$38,$38,$48,$38,$f5,$f5,$04,$f1,$f5,$f5,$04,$f5,
$bc,$bc,$df,$63,$bc,$bc,$df,$bc,$b6,$b6,$c1,$77,$b6,$b6,$c1,$b6,
$da,$da,$75,$af,$da,$da,$75,$da,$21,$21,$63,$42,$21,$21,$63,$21,
$10,$10,$30,$20,$10,$10,$30,$10,$ff,$ff,$1a,$e5,$ff,$ff,$1a,$ff,
$f3,$f3,$0e,$fd,$f3,$f3,$0e,$f3,$d2,$d2,$6d,$bf,$d2,$d2,$6d,$d2,
$cd,$cd,$4c,$81,$cd,$cd,$4c,$cd,$0c,$0c,$14,$18,$0c,$0c,$14,$0c,
$13,$13,$35,$26,$13,$13,$35,$13,$ec,$ec,$2f,$c3,$ec,$ec,$2f,$ec,
$5f,$5f,$e1,$be,$5f,$5f,$e1,$5f,$97,$97,$a2,$35,$97,$97,$a2,$97,
$44,$44,$cc,$88,$44,$44,$cc,$44,$17,$17,$39,$2e,$17,$17,$39,$17,
$c4,$c4,$57,$93,$c4,$c4,$57,$c4,$a7,$a7,$f2,$55,$a7,$a7,$f2,$a7,
$7e,$7e,$82,$fc,$7e,$7e,$82,$7e,$3d,$3d,$47,$7a,$3d,$3d,$47,$3d,
$64,$64,$ac,$c8,$64,$64,$ac,$64,$5d,$5d,$e7,$ba,$5d,$5d,$e7,$5d,
$19,$19,$2b,$32,$19,$19,$2b,$19,$73,$73,$95,$e6,$73,$73,$95,$73,
$60,$60,$a0,$c0,$60,$60,$a0,$60,$81,$81,$98,$19,$81,$81,$98,$81,
$4f,$4f,$d1,$9e,$4f,$4f,$d1,$4f,$dc,$dc,$7f,$a3,$dc,$dc,$7f,$dc,
$22,$22,$66,$44,$22,$22,$66,$22,$2a,$2a,$7e,$54,$2a,$2a,$7e,$2a,
$90,$90,$ab,$3b,$90,$90,$ab,$90,$88,$88,$83,$0b,$88,$88,$83,$88,
$46,$46,$ca,$8c,$46,$46,$ca,$46,$ee,$ee,$29,$c7,$ee,$ee,$29,$ee,
$b8,$b8,$d3,$6b,$b8,$b8,$d3,$b8,$14,$14,$3c,$28,$14,$14,$3c,$14,
$de,$de,$79,$a7,$de,$de,$79,$de,$5e,$5e,$e2,$bc,$5e,$5e,$e2,$5e,
$0b,$0b,$1d,$16,$0b,$0b,$1d,$0b,$db,$db,$76,$ad,$db,$db,$76,$db,
$e0,$e0,$3b,$db,$e0,$e0,$3b,$e0,$32,$32,$56,$64,$32,$32,$56,$32,
$3a,$3a,$4e,$74,$3a,$3a,$4e,$3a,$0a,$0a,$1e,$14,$0a,$0a,$1e,$0a,
$49,$49,$db,$92,$49,$49,$db,$49,$06,$06,$0a,$0c,$06,$06,$0a,$06,
$24,$24,$6c,$48,$24,$24,$6c,$24,$5c,$5c,$e4,$b8,$5c,$5c,$e4,$5c,
$c2,$c2,$5d,$9f,$c2,$c2,$5d,$c2,$d3,$d3,$6e,$bd,$d3,$d3,$6e,$d3,
$ac,$ac,$ef,$43,$ac,$ac,$ef,$ac,$62,$62,$a6,$c4,$62,$62,$a6,$62,
$91,$91,$a8,$39,$91,$91,$a8,$91,$95,$95,$a4,$31,$95,$95,$a4,$95,
$e4,$e4,$37,$d3,$e4,$e4,$37,$e4,$79,$79,$8b,$f2,$79,$79,$8b,$79,
$e7,$e7,$32,$d5,$e7,$e7,$32,$e7,$c8,$c8,$43,$8b,$c8,$c8,$43,$c8,
$37,$37,$59,$6e,$37,$37,$59,$37,$6d,$6d,$b7,$da,$6d,$6d,$b7,$6d,
$8d,$8d,$8c,$01,$8d,$8d,$8c,$8d,$d5,$d5,$64,$b1,$d5,$d5,$64,$d5,
$4e,$4e,$d2,$9c,$4e,$4e,$d2,$4e,$a9,$a9,$e0,$49,$a9,$a9,$e0,$a9,
$6c,$6c,$b4,$d8,$6c,$6c,$b4,$6c,$56,$56,$fa,$ac,$56,$56,$fa,$56,
$f4,$f4,$07,$f3,$f4,$f4,$07,$f4,$ea,$ea,$25,$cf,$ea,$ea,$25,$ea,
$65,$65,$af,$ca,$65,$65,$af,$65,$7a,$7a,$8e,$f4,$7a,$7a,$8e,$7a,
$ae,$ae,$e9,$47,$ae,$ae,$e9,$ae,$08,$08,$18,$10,$08,$08,$18,$08,
$ba,$ba,$d5,$6f,$ba,$ba,$d5,$ba,$78,$78,$88,$f0,$78,$78,$88,$78,
$25,$25,$6f,$4a,$25,$25,$6f,$25,$2e,$2e,$72,$5c,$2e,$2e,$72,$2e,
$1c,$1c,$24,$38,$1c,$1c,$24,$1c,$a6,$a6,$f1,$57,$a6,$a6,$f1,$a6,
$b4,$b4,$c7,$73,$b4,$b4,$c7,$b4,$c6,$c6,$51,$97,$c6,$c6,$51,$c6,
$e8,$e8,$23,$cb,$e8,$e8,$23,$e8,$dd,$dd,$7c,$a1,$dd,$dd,$7c,$dd,
$74,$74,$9c,$e8,$74,$74,$9c,$74,$1f,$1f,$21,$3e,$1f,$1f,$21,$1f,
$4b,$4b,$dd,$96,$4b,$4b,$dd,$4b,$bd,$bd,$dc,$61,$bd,$bd,$dc,$bd,
$8b,$8b,$86,$0d,$8b,$8b,$86,$8b,$8a,$8a,$85,$0f,$8a,$8a,$85,$8a,
$70,$70,$90,$e0,$70,$70,$90,$70,$3e,$3e,$42,$7c,$3e,$3e,$42,$3e,
$b5,$b5,$c4,$71,$b5,$b5,$c4,$b5,$66,$66,$aa,$cc,$66,$66,$aa,$66,
$48,$48,$d8,$90,$48,$48,$d8,$48,$03,$03,$05,$06,$03,$03,$05,$03,
$f6,$f6,$01,$f7,$f6,$f6,$01,$f6,$0e,$0e,$12,$1c,$0e,$0e,$12,$0e,
$61,$61,$a3,$c2,$61,$61,$a3,$61,$35,$35,$5f,$6a,$35,$35,$5f,$35,
$57,$57,$f9,$ae,$57,$57,$f9,$57,$b9,$b9,$d0,$69,$b9,$b9,$d0,$b9,
$86,$86,$91,$17,$86,$86,$91,$86,$c1,$c1,$58,$99,$c1,$c1,$58,$c1,
$1d,$1d,$27,$3a,$1d,$1d,$27,$1d,$9e,$9e,$b9,$27,$9e,$9e,$b9,$9e,
$e1,$e1,$38,$d9,$e1,$e1,$38,$e1,$f8,$f8,$13,$eb,$f8,$f8,$13,$f8,
$98,$98,$b3,$2b,$98,$98,$b3,$98,$11,$11,$33,$22,$11,$11,$33,$11,
$69,$69,$bb,$d2,$69,$69,$bb,$69,$d9,$d9,$70,$a9,$d9,$d9,$70,$d9,
$8e,$8e,$89,$07,$8e,$8e,$89,$8e,$94,$94,$a7,$33,$94,$94,$a7,$94,
$9b,$9b,$b6,$2d,$9b,$9b,$b6,$9b,$1e,$1e,$22,$3c,$1e,$1e,$22,$1e,
$87,$87,$92,$15,$87,$87,$92,$87,$e9,$e9,$20,$c9,$e9,$e9,$20,$e9,
$ce,$ce,$49,$87,$ce,$ce,$49,$ce,$55,$55,$ff,$aa,$55,$55,$ff,$55,
$28,$28,$78,$50,$28,$28,$78,$28,$df,$df,$7a,$a5,$df,$df,$7a,$df,
$8c,$8c,$8f,$03,$8c,$8c,$8f,$8c,$a1,$a1,$f8,$59,$a1,$a1,$f8,$a1,
$89,$89,$80,$09,$89,$89,$80,$89,$0d,$0d,$17,$1a,$0d,$0d,$17,$0d,
$bf,$bf,$da,$65,$bf,$bf,$da,$bf,$e6,$e6,$31,$d7,$e6,$e6,$31,$e6,
$42,$42,$c6,$84,$42,$42,$c6,$42,$68,$68,$b8,$d0,$68,$68,$b8,$68,
$41,$41,$c3,$82,$41,$41,$c3,$41,$99,$99,$b0,$29,$99,$99,$b0,$99,
$2d,$2d,$77,$5a,$2d,$2d,$77,$2d,$0f,$0f,$11,$1e,$0f,$0f,$11,$0f,
$b0,$b0,$cb,$7b,$b0,$b0,$cb,$b0,$54,$54,$fc,$a8,$54,$54,$fc,$54,
$bb,$bb,$d6,$6d,$bb,$bb,$d6,$bb,$16,$16,$3a,$2c,$16,$16,$3a,$16);
var
Te: array[byte] of TEU absolute TCe;
{$ifdef StrictLong}
{$warnings on}
{$ifdef RangeChecks_on}
{$R+}
{$endif}
{$endif}

73
Tocsg.Lib/VCL/EncLib/AES/enc_cp16.inc Normal file
View File

@ -0,0 +1,73 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for Pascal16/Compressed tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 13.07.06 we Uses TCe box byte instead of SBox
0.12 15.11.08 we Use Ptr2Inc from BTypes
**************************************************************************)
(**** (C) Copyright 2002-2008 Wolfgang Ehrhardt -- see copying_we.txt ****)
{Normally used for TP5/5.5 (and during development BP7)}
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
label done;
var
pK: PWA4; {pointer to loop round key}
r: integer; {round loop counter}
t,s: TAESBlock;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK);
{Initialize with input block}
TWA4(s)[0] := TWA4(BI)[0] xor pK^[0];
TWA4(s)[1] := TWA4(BI)[1] xor pK^[1];
TWA4(s)[2] := TWA4(BI)[2] xor pK^[2];
TWA4(s)[3] := TWA4(BI)[3] xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
r := 1;
while true do begin
TWA4(t)[0] := Te[s[0*4+0]].E0.L xor Te[s[1*4+1]].E1.L xor Te[s[2*4+2]].E2.L xor Te[s[3*4+3]].E3.L xor pK^[0];
TWA4(t)[1] := Te[s[1*4+0]].E0.L xor Te[s[2*4+1]].E1.L xor Te[s[3*4+2]].E2.L xor Te[s[0*4+3]].E3.L xor pK^[1];
TWA4(t)[2] := Te[s[2*4+0]].E0.L xor Te[s[3*4+1]].E1.L xor Te[s[0*4+2]].E2.L xor Te[s[1*4+3]].E3.L xor pK^[2];
TWA4(t)[3] := Te[s[3*4+0]].E0.L xor Te[s[0*4+1]].E1.L xor Te[s[1*4+2]].E2.L xor Te[s[2*4+3]].E3.L xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
inc(r);
if r>=ctx.rounds then goto done;
TWA4(s)[0] := Te[t[0*4+0]].E0.L xor Te[t[1*4+1]].E1.L xor Te[t[2*4+2]].E2.L xor Te[t[3*4+3]].E3.L xor pK^[0];
TWA4(s)[1] := Te[t[1*4+0]].E0.L xor Te[t[2*4+1]].E1.L xor Te[t[3*4+2]].E2.L xor Te[t[0*4+3]].E3.L xor pK^[1];
TWA4(s)[2] := Te[t[2*4+0]].E0.L xor Te[t[3*4+1]].E1.L xor Te[t[0*4+2]].E2.L xor Te[t[1*4+3]].E3.L xor pK^[2];
TWA4(s)[3] := Te[t[3*4+0]].E0.L xor Te[t[0*4+1]].E1.L xor Te[t[1*4+2]].E2.L xor Te[t[2*4+3]].E3.L xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
inc(r);
end;
done:
s[00] := Te[t[0*4+0]].E0.box;
s[01] := Te[t[1*4+1]].E0.box;
s[02] := Te[t[2*4+2]].E0.box;
s[03] := Te[t[3*4+3]].E0.box;
s[04] := Te[t[1*4+0]].E0.box;
s[05] := Te[t[2*4+1]].E0.box;
s[06] := Te[t[3*4+2]].E0.box;
s[07] := Te[t[0*4+3]].E0.box;
s[08] := Te[t[2*4+0]].E0.box;
s[09] := Te[t[3*4+1]].E0.box;
s[10] := Te[t[0*4+2]].E0.box;
s[11] := Te[t[1*4+3]].E0.box;
s[12] := Te[t[3*4+0]].E0.box;
s[13] := Te[t[0*4+1]].E0.box;
s[14] := Te[t[1*4+2]].E0.box;
s[15] := Te[t[2*4+3]].E0.box;
TWA4(BO)[0] := TWA4(s)[0] xor pK^[0];
TWA4(BO)[1] := TWA4(s)[1] xor pK^[1];
TWA4(BO)[2] := TWA4(s)[2] xor pK^[2];
TWA4(BO)[3] := TWA4(s)[3] xor pK^[3];
end;

62
Tocsg.Lib/VCL/EncLib/AES/enc_cp32.inc Normal file
View File

@ -0,0 +1,62 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for BIT32/Compressed tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version for compressed tables
0.11 09.07.06 we Removed AES_LONGBOX code
0.12 13.07.06 we Uses TCe box byte instead of SBox
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
r: integer; {round loop countdown counter}
pK: PWA4; {pointer to loop round key }
s3,s0,s1,s2: longint; {TAESBlock s as separate variables}
t: TWA4;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK);
{Initialize with input block}
s0 := TWA4(BI)[0] xor pK^[0];
s1 := TWA4(BI)[1] xor pK^[1];
s2 := TWA4(BI)[2] xor pK^[2];
s3 := TWA4(BI)[3] xor pK^[3];
inc(pK);
{perform encryption rounds}
for r:=1 to ctx.Rounds-1 do begin
t[0] := Te[s0 and $ff].E0.L xor Te[s1 shr 8 and $ff].E1.L xor Te[s2 shr 16 and $ff].E2.L xor Te[s3 shr 24].E3.L xor pK^[0];
t[1] := Te[s1 and $ff].E0.L xor Te[s2 shr 8 and $ff].E1.L xor Te[s3 shr 16 and $ff].E2.L xor Te[s0 shr 24].E3.L xor pK^[1];
t[2] := Te[s2 and $ff].E0.L xor Te[s3 shr 8 and $ff].E1.L xor Te[s0 shr 16 and $ff].E2.L xor Te[s1 shr 24].E3.L xor pK^[2];
s3 := Te[s3 and $ff].E0.L xor Te[s0 shr 8 and $ff].E1.L xor Te[s1 shr 16 and $ff].E2.L xor Te[s2 shr 24].E3.L xor pK^[3];
s0 := t[0];
s1 := t[1];
s2 := t[2];
inc(pK);
end;
{Uses Sbox byte from Te and shl, needs type cast longint() for 16 bit compilers}
TWA4(BO)[0] := (longint(Te[s0 and $ff].E0.box) xor
longint(Te[s1 shr 8 and $ff].E0.box) shl 8 xor
longint(Te[s2 shr 16 and $ff].E0.box) shl 16 xor
longint(Te[s3 shr 24 ].E0.box) shl 24 ) xor pK^[0];
TWA4(BO)[1] := (longint(Te[s1 and $ff].E0.box) xor
longint(Te[s2 shr 8 and $ff].E0.box) shl 8 xor
longint(Te[s3 shr 16 and $ff].E0.box) shl 16 xor
longint(Te[s0 shr 24 ].E0.box) shl 24 ) xor pK^[1];
TWA4(BO)[2] := (longint(Te[s2 and $ff].E0.box) xor
longint(Te[s3 shr 8 and $ff].E0.box) shl 8 xor
longint(Te[s0 shr 16 and $ff].E0.box) shl 16 xor
longint(Te[s1 shr 24 ].E0.box) shl 24 ) xor pK^[2];
TWA4(BO)[3] := (longint(Te[s3 and $ff].E0.box) xor
longint(Te[s0 shr 8 and $ff].E0.box) shl 8 xor
longint(Te[s1 shr 16 and $ff].E0.box) shl 16 xor
longint(Te[s2 shr 24 ].E0.box) shl 24 ) xor pK^[3];
end;

318
Tocsg.Lib/VCL/EncLib/AES/enc_fa16.inc Normal file
View File

@ -0,0 +1,318 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for BASM16/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_ENCR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{16 bit BASM used for TP6, BP7, Delphi1}
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
s,t: TAESBlock;
rnd: integer;
pK: pointer;
begin
rnd := ctx.rounds;
pK := @ctx.RK;
asm
db $66; pusha
{AES_XorBlock(BI, ctx.RK[0], s);}
les si,[BI]
db $66; mov ax,es:[si]
db $66; mov bx,es:[si+4]
db $66; mov cx,es:[si+8]
db $66; mov dx,es:[si+12]
les di,[pK]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
db $66; mov word ptr [s],ax
db $66; mov word ptr [s+4],bx
db $66; mov word ptr [s+8],cx
db $66; mov word ptr [s+12],dx
add di,16 {di->ctx.RK[1]}
mov dx,[rnd]
mov cx,1
{ *Note* in the following round loop }
{ op eax, mem[4*bx] is calculated as }
{ lea esi, [ebx + 2*ebx] }
{ op eax, mem[ebx+esi] }
{ lea esi,[ebx+2*ebx] = db $66,$67,$8D,$34,$5B; }
db $66; sub bx,bx {clear ebx}
@@1:
{TWA4(t)[0] := Te0[s[0*4+0]] xor Te1[s[1*4+1]] xor Te2[s[2*4+2]] xor Te3[s[3*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr s[0*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr s[1*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr s[2*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr s[3*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di]
db $66; mov word ptr t[0],ax
{TWA4(t)[1] := Te0[s[1*4+0]] xor Te1[s[2*4+1]] xor Te2[s[3*4+2]] xor Te3[s[0*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr s[1*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr s[2*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr s[3*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr s[0*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+4]
db $66; mov word ptr t[4],ax
{TWA4(t)[2] := Te0[s[2*4+0]] xor Te1[s[3*4+1]] xor Te2[s[0*4+2]] xor Te3[s[1*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr s[2*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr s[3*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr s[0*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr s[1*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+8]
db $66; mov word ptr t[8],ax
{TWA4(t)[3] := Te0[s[3*4+0]] xor Te1[s[0*4+1]] xor Te2[s[1*4+2]] xor Te3[s[2*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr s[3*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr s[0*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr s[1*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr s[2*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+12]
db $66; mov word ptr t[12],ax
{if r>=ctx.rounds then break;}
inc cx
cmp cx,dx
jae @@2
{TWA4(s)[0] := Te0[t[0*4+0]] xor Te1[t[1*4+1]] xor Te2[t[2*4+2]] xor Te3[t[3*4+3]] xor TWA4(ctx.RK[r])[0];}
mov bl,byte ptr t[0*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr t[1*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr t[2*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr t[3*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+16]
db $66; mov word ptr s[0],ax
{TWA4(s)[1] := Te0[t[1*4+0]] xor Te1[t[2*4+1]] xor Te2[t[3*4+2]] xor Te3[t[0*4+3]] xor TWA4(ctx.RK[r])[1];}
mov bl,byte ptr t[1*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr t[2*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr t[3*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr t[0*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+20]
db $66; mov word ptr s[4],ax
{TWA4(s)[2] := Te0[t[2*4+0]] xor Te1[t[3*4+1]] xor Te2[t[0*4+2]] xor Te3[t[1*4+3]] xor TWA4(ctx.RK[r])[2];}
mov bl,byte ptr t[2*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr t[3*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr t[0*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr t[1*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+24]
db $66; mov word ptr s[8],ax
{TWA4(s)[3] := Te0[t[3*4+0]] xor Te1[t[0*4+1]] xor Te2[t[1*4+2]] xor Te3[t[2*4+3]] xor TWA4(ctx.RK[r])[3];}
mov bl,byte ptr t[3*4+0]
db $66,$67,$8D,$34,$5B;
db $66; mov ax,word ptr Te0[bx+si]
mov bl,byte ptr t[0*4+1]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te1[bx+si]
mov bl,byte ptr t[1*4+2]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te2[bx+si]
mov bl,byte ptr t[2*4+3]
db $66,$67,$8D,$34,$5B;
db $66; xor ax,word ptr Te3[bx+si]
db $66; xor ax,es:[di+28]
add di,32
db $66; mov word ptr s[12],ax
inc cx
jmp @@1
@@2: add di,16 {di -> ctx.RK[ctx.rounds]}
{Last round uses SBox}
sub bx,bx
mov bl, byte ptr t[0*4+0]
mov al, byte ptr SBox[bx]
mov byte ptr s[0],al
mov bl, byte ptr t[1*4+1]
mov al, byte ptr SBox[bx]
mov byte ptr s[1],al
mov bl, byte ptr t[2*4+2]
mov al, byte ptr SBox[bx]
mov byte ptr s[2],al
mov bl, byte ptr t[3*4+3]
mov al, byte ptr SBox[bx]
mov byte ptr s[3],al
mov bl, byte ptr t[1*4+0]
mov al, byte ptr SBox[bx]
mov byte ptr s[4],al
mov bl, byte ptr t[2*4+1]
mov al, byte ptr SBox[bx]
mov byte ptr s[5],al
mov bl, byte ptr t[3*4+2]
mov al, byte ptr SBox[bx]
mov byte ptr s[6],al
mov bl, byte ptr t[0*4+3]
mov al, byte ptr SBox[bx]
mov byte ptr s[7],al
mov bl, byte ptr t[2*4+0]
mov al, byte ptr SBox[bx]
mov byte ptr s[8],al
mov bl, byte ptr t[3*4+1]
mov al, byte ptr SBox[bx]
mov byte ptr s[9],al
mov bl, byte ptr t[0*4+2]
mov al, byte ptr SBox[bx]
mov byte ptr s[10],al
mov bl, byte ptr t[1*4+3]
mov al, byte ptr SBox[bx]
mov byte ptr s[11],al
mov bl, byte ptr t[3*4+0]
mov al, byte ptr SBox[bx]
mov byte ptr s[12],al
mov bl, byte ptr t[0*4+1]
mov al, byte ptr SBox[bx]
mov byte ptr s[13],al
mov bl, byte ptr t[1*4+2]
mov al, byte ptr SBox[bx]
mov byte ptr s[14],al
mov bl, byte ptr t[2*4+3]
mov al, byte ptr SBox[bx]
mov byte ptr s[15],al
{AES_XorBlock(s, ctx.RK[rnd], BO)}
db $66; mov ax,word ptr [s]
db $66; mov bx,word ptr [s+4]
db $66; mov cx,word ptr [s+8]
db $66; mov dx,word ptr [s+12]
db $66; xor ax,es:[di]
db $66; xor bx,es:[di+4]
db $66; xor cx,es:[di+8]
db $66; xor dx,es:[di+12]
les si,[BO]
db $66; mov es:[si],ax
db $66; mov es:[si+4],bx
db $66; mov es:[si+8],cx
db $66; mov es:[si+12],dx
db $66; popa
end;
end;

207
Tocsg.Lib/VCL/EncLib/AES/enc_fdat.inc Normal file
View File

@ -0,0 +1,207 @@
(*************************************************************************
Include file for AES_ENCR.PAS - Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_ENCR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{$ifdef StrictLong}
{$warnings off}
{$R-} {avoid D9+ errors!}
{$endif}
const
Te0: array[byte] of longint =
($a56363c6, $847c7cf8, $997777ee, $8d7b7bf6, $0df2f2ff, $bd6b6bd6, $b16f6fde, $54c5c591,
$50303060, $03010102, $a96767ce, $7d2b2b56, $19fefee7, $62d7d7b5, $e6abab4d, $9a7676ec,
$45caca8f, $9d82821f, $40c9c989, $877d7dfa, $15fafaef, $eb5959b2, $c947478e, $0bf0f0fb,
$ecadad41, $67d4d4b3, $fda2a25f, $eaafaf45, $bf9c9c23, $f7a4a453, $967272e4, $5bc0c09b,
$c2b7b775, $1cfdfde1, $ae93933d, $6a26264c, $5a36366c, $413f3f7e, $02f7f7f5, $4fcccc83,
$5c343468, $f4a5a551, $34e5e5d1, $08f1f1f9, $937171e2, $73d8d8ab, $53313162, $3f15152a,
$0c040408, $52c7c795, $65232346, $5ec3c39d, $28181830, $a1969637, $0f05050a, $b59a9a2f,
$0907070e, $36121224, $9b80801b, $3de2e2df, $26ebebcd, $6927274e, $cdb2b27f, $9f7575ea,
$1b090912, $9e83831d, $742c2c58, $2e1a1a34, $2d1b1b36, $b26e6edc, $ee5a5ab4, $fba0a05b,
$f65252a4, $4d3b3b76, $61d6d6b7, $ceb3b37d, $7b292952, $3ee3e3dd, $712f2f5e, $97848413,
$f55353a6, $68d1d1b9, $00000000, $2cededc1, $60202040, $1ffcfce3, $c8b1b179, $ed5b5bb6,
$be6a6ad4, $46cbcb8d, $d9bebe67, $4b393972, $de4a4a94, $d44c4c98, $e85858b0, $4acfcf85,
$6bd0d0bb, $2aefefc5, $e5aaaa4f, $16fbfbed, $c5434386, $d74d4d9a, $55333366, $94858511,
$cf45458a, $10f9f9e9, $06020204, $817f7ffe, $f05050a0, $443c3c78, $ba9f9f25, $e3a8a84b,
$f35151a2, $fea3a35d, $c0404080, $8a8f8f05, $ad92923f, $bc9d9d21, $48383870, $04f5f5f1,
$dfbcbc63, $c1b6b677, $75dadaaf, $63212142, $30101020, $1affffe5, $0ef3f3fd, $6dd2d2bf,
$4ccdcd81, $140c0c18, $35131326, $2fececc3, $e15f5fbe, $a2979735, $cc444488, $3917172e,
$57c4c493, $f2a7a755, $827e7efc, $473d3d7a, $ac6464c8, $e75d5dba, $2b191932, $957373e6,
$a06060c0, $98818119, $d14f4f9e, $7fdcdca3, $66222244, $7e2a2a54, $ab90903b, $8388880b,
$ca46468c, $29eeeec7, $d3b8b86b, $3c141428, $79dedea7, $e25e5ebc, $1d0b0b16, $76dbdbad,
$3be0e0db, $56323264, $4e3a3a74, $1e0a0a14, $db494992, $0a06060c, $6c242448, $e45c5cb8,
$5dc2c29f, $6ed3d3bd, $efacac43, $a66262c4, $a8919139, $a4959531, $37e4e4d3, $8b7979f2,
$32e7e7d5, $43c8c88b, $5937376e, $b76d6dda, $8c8d8d01, $64d5d5b1, $d24e4e9c, $e0a9a949,
$b46c6cd8, $fa5656ac, $07f4f4f3, $25eaeacf, $af6565ca, $8e7a7af4, $e9aeae47, $18080810,
$d5baba6f, $887878f0, $6f25254a, $722e2e5c, $241c1c38, $f1a6a657, $c7b4b473, $51c6c697,
$23e8e8cb, $7cdddda1, $9c7474e8, $211f1f3e, $dd4b4b96, $dcbdbd61, $868b8b0d, $858a8a0f,
$907070e0, $423e3e7c, $c4b5b571, $aa6666cc, $d8484890, $05030306, $01f6f6f7, $120e0e1c,
$a36161c2, $5f35356a, $f95757ae, $d0b9b969, $91868617, $58c1c199, $271d1d3a, $b99e9e27,
$38e1e1d9, $13f8f8eb, $b398982b, $33111122, $bb6969d2, $70d9d9a9, $898e8e07, $a7949433,
$b69b9b2d, $221e1e3c, $92878715, $20e9e9c9, $49cece87, $ff5555aa, $78282850, $7adfdfa5,
$8f8c8c03, $f8a1a159, $80898909, $170d0d1a, $dabfbf65, $31e6e6d7, $c6424284, $b86868d0,
$c3414182, $b0999929, $772d2d5a, $110f0f1e, $cbb0b07b, $fc5454a8, $d6bbbb6d, $3a16162c);
Te1: array[byte] of longint =
($6363c6a5, $7c7cf884, $7777ee99, $7b7bf68d, $f2f2ff0d, $6b6bd6bd, $6f6fdeb1, $c5c59154,
$30306050, $01010203, $6767cea9, $2b2b567d, $fefee719, $d7d7b562, $abab4de6, $7676ec9a,
$caca8f45, $82821f9d, $c9c98940, $7d7dfa87, $fafaef15, $5959b2eb, $47478ec9, $f0f0fb0b,
$adad41ec, $d4d4b367, $a2a25ffd, $afaf45ea, $9c9c23bf, $a4a453f7, $7272e496, $c0c09b5b,
$b7b775c2, $fdfde11c, $93933dae, $26264c6a, $36366c5a, $3f3f7e41, $f7f7f502, $cccc834f,
$3434685c, $a5a551f4, $e5e5d134, $f1f1f908, $7171e293, $d8d8ab73, $31316253, $15152a3f,
$0404080c, $c7c79552, $23234665, $c3c39d5e, $18183028, $969637a1, $05050a0f, $9a9a2fb5,
$07070e09, $12122436, $80801b9b, $e2e2df3d, $ebebcd26, $27274e69, $b2b27fcd, $7575ea9f,
$0909121b, $83831d9e, $2c2c5874, $1a1a342e, $1b1b362d, $6e6edcb2, $5a5ab4ee, $a0a05bfb,
$5252a4f6, $3b3b764d, $d6d6b761, $b3b37dce, $2929527b, $e3e3dd3e, $2f2f5e71, $84841397,
$5353a6f5, $d1d1b968, $00000000, $ededc12c, $20204060, $fcfce31f, $b1b179c8, $5b5bb6ed,
$6a6ad4be, $cbcb8d46, $bebe67d9, $3939724b, $4a4a94de, $4c4c98d4, $5858b0e8, $cfcf854a,
$d0d0bb6b, $efefc52a, $aaaa4fe5, $fbfbed16, $434386c5, $4d4d9ad7, $33336655, $85851194,
$45458acf, $f9f9e910, $02020406, $7f7ffe81, $5050a0f0, $3c3c7844, $9f9f25ba, $a8a84be3,
$5151a2f3, $a3a35dfe, $404080c0, $8f8f058a, $92923fad, $9d9d21bc, $38387048, $f5f5f104,
$bcbc63df, $b6b677c1, $dadaaf75, $21214263, $10102030, $ffffe51a, $f3f3fd0e, $d2d2bf6d,
$cdcd814c, $0c0c1814, $13132635, $ececc32f, $5f5fbee1, $979735a2, $444488cc, $17172e39,
$c4c49357, $a7a755f2, $7e7efc82, $3d3d7a47, $6464c8ac, $5d5dbae7, $1919322b, $7373e695,
$6060c0a0, $81811998, $4f4f9ed1, $dcdca37f, $22224466, $2a2a547e, $90903bab, $88880b83,
$46468cca, $eeeec729, $b8b86bd3, $1414283c, $dedea779, $5e5ebce2, $0b0b161d, $dbdbad76,
$e0e0db3b, $32326456, $3a3a744e, $0a0a141e, $494992db, $06060c0a, $2424486c, $5c5cb8e4,
$c2c29f5d, $d3d3bd6e, $acac43ef, $6262c4a6, $919139a8, $959531a4, $e4e4d337, $7979f28b,
$e7e7d532, $c8c88b43, $37376e59, $6d6ddab7, $8d8d018c, $d5d5b164, $4e4e9cd2, $a9a949e0,
$6c6cd8b4, $5656acfa, $f4f4f307, $eaeacf25, $6565caaf, $7a7af48e, $aeae47e9, $08081018,
$baba6fd5, $7878f088, $25254a6f, $2e2e5c72, $1c1c3824, $a6a657f1, $b4b473c7, $c6c69751,
$e8e8cb23, $dddda17c, $7474e89c, $1f1f3e21, $4b4b96dd, $bdbd61dc, $8b8b0d86, $8a8a0f85,
$7070e090, $3e3e7c42, $b5b571c4, $6666ccaa, $484890d8, $03030605, $f6f6f701, $0e0e1c12,
$6161c2a3, $35356a5f, $5757aef9, $b9b969d0, $86861791, $c1c19958, $1d1d3a27, $9e9e27b9,
$e1e1d938, $f8f8eb13, $98982bb3, $11112233, $6969d2bb, $d9d9a970, $8e8e0789, $949433a7,
$9b9b2db6, $1e1e3c22, $87871592, $e9e9c920, $cece8749, $5555aaff, $28285078, $dfdfa57a,
$8c8c038f, $a1a159f8, $89890980, $0d0d1a17, $bfbf65da, $e6e6d731, $424284c6, $6868d0b8,
$414182c3, $999929b0, $2d2d5a77, $0f0f1e11, $b0b07bcb, $5454a8fc, $bbbb6dd6, $16162c3a);
Te2: array[byte] of longint =
($63c6a563, $7cf8847c, $77ee9977, $7bf68d7b, $f2ff0df2, $6bd6bd6b, $6fdeb16f, $c59154c5,
$30605030, $01020301, $67cea967, $2b567d2b, $fee719fe, $d7b562d7, $ab4de6ab, $76ec9a76,
$ca8f45ca, $821f9d82, $c98940c9, $7dfa877d, $faef15fa, $59b2eb59, $478ec947, $f0fb0bf0,
$ad41ecad, $d4b367d4, $a25ffda2, $af45eaaf, $9c23bf9c, $a453f7a4, $72e49672, $c09b5bc0,
$b775c2b7, $fde11cfd, $933dae93, $264c6a26, $366c5a36, $3f7e413f, $f7f502f7, $cc834fcc,
$34685c34, $a551f4a5, $e5d134e5, $f1f908f1, $71e29371, $d8ab73d8, $31625331, $152a3f15,
$04080c04, $c79552c7, $23466523, $c39d5ec3, $18302818, $9637a196, $050a0f05, $9a2fb59a,
$070e0907, $12243612, $801b9b80, $e2df3de2, $ebcd26eb, $274e6927, $b27fcdb2, $75ea9f75,
$09121b09, $831d9e83, $2c58742c, $1a342e1a, $1b362d1b, $6edcb26e, $5ab4ee5a, $a05bfba0,
$52a4f652, $3b764d3b, $d6b761d6, $b37dceb3, $29527b29, $e3dd3ee3, $2f5e712f, $84139784,
$53a6f553, $d1b968d1, $00000000, $edc12ced, $20406020, $fce31ffc, $b179c8b1, $5bb6ed5b,
$6ad4be6a, $cb8d46cb, $be67d9be, $39724b39, $4a94de4a, $4c98d44c, $58b0e858, $cf854acf,
$d0bb6bd0, $efc52aef, $aa4fe5aa, $fbed16fb, $4386c543, $4d9ad74d, $33665533, $85119485,
$458acf45, $f9e910f9, $02040602, $7ffe817f, $50a0f050, $3c78443c, $9f25ba9f, $a84be3a8,
$51a2f351, $a35dfea3, $4080c040, $8f058a8f, $923fad92, $9d21bc9d, $38704838, $f5f104f5,
$bc63dfbc, $b677c1b6, $daaf75da, $21426321, $10203010, $ffe51aff, $f3fd0ef3, $d2bf6dd2,
$cd814ccd, $0c18140c, $13263513, $ecc32fec, $5fbee15f, $9735a297, $4488cc44, $172e3917,
$c49357c4, $a755f2a7, $7efc827e, $3d7a473d, $64c8ac64, $5dbae75d, $19322b19, $73e69573,
$60c0a060, $81199881, $4f9ed14f, $dca37fdc, $22446622, $2a547e2a, $903bab90, $880b8388,
$468cca46, $eec729ee, $b86bd3b8, $14283c14, $dea779de, $5ebce25e, $0b161d0b, $dbad76db,
$e0db3be0, $32645632, $3a744e3a, $0a141e0a, $4992db49, $060c0a06, $24486c24, $5cb8e45c,
$c29f5dc2, $d3bd6ed3, $ac43efac, $62c4a662, $9139a891, $9531a495, $e4d337e4, $79f28b79,
$e7d532e7, $c88b43c8, $376e5937, $6ddab76d, $8d018c8d, $d5b164d5, $4e9cd24e, $a949e0a9,
$6cd8b46c, $56acfa56, $f4f307f4, $eacf25ea, $65caaf65, $7af48e7a, $ae47e9ae, $08101808,
$ba6fd5ba, $78f08878, $254a6f25, $2e5c722e, $1c38241c, $a657f1a6, $b473c7b4, $c69751c6,
$e8cb23e8, $dda17cdd, $74e89c74, $1f3e211f, $4b96dd4b, $bd61dcbd, $8b0d868b, $8a0f858a,
$70e09070, $3e7c423e, $b571c4b5, $66ccaa66, $4890d848, $03060503, $f6f701f6, $0e1c120e,
$61c2a361, $356a5f35, $57aef957, $b969d0b9, $86179186, $c19958c1, $1d3a271d, $9e27b99e,
$e1d938e1, $f8eb13f8, $982bb398, $11223311, $69d2bb69, $d9a970d9, $8e07898e, $9433a794,
$9b2db69b, $1e3c221e, $87159287, $e9c920e9, $ce8749ce, $55aaff55, $28507828, $dfa57adf,
$8c038f8c, $a159f8a1, $89098089, $0d1a170d, $bf65dabf, $e6d731e6, $4284c642, $68d0b868,
$4182c341, $9929b099, $2d5a772d, $0f1e110f, $b07bcbb0, $54a8fc54, $bb6dd6bb, $162c3a16);
Te3: array[byte] of longint =
($c6a56363, $f8847c7c, $ee997777, $f68d7b7b, $ff0df2f2, $d6bd6b6b, $deb16f6f, $9154c5c5,
$60503030, $02030101, $cea96767, $567d2b2b, $e719fefe, $b562d7d7, $4de6abab, $ec9a7676,
$8f45caca, $1f9d8282, $8940c9c9, $fa877d7d, $ef15fafa, $b2eb5959, $8ec94747, $fb0bf0f0,
$41ecadad, $b367d4d4, $5ffda2a2, $45eaafaf, $23bf9c9c, $53f7a4a4, $e4967272, $9b5bc0c0,
$75c2b7b7, $e11cfdfd, $3dae9393, $4c6a2626, $6c5a3636, $7e413f3f, $f502f7f7, $834fcccc,
$685c3434, $51f4a5a5, $d134e5e5, $f908f1f1, $e2937171, $ab73d8d8, $62533131, $2a3f1515,
$080c0404, $9552c7c7, $46652323, $9d5ec3c3, $30281818, $37a19696, $0a0f0505, $2fb59a9a,
$0e090707, $24361212, $1b9b8080, $df3de2e2, $cd26ebeb, $4e692727, $7fcdb2b2, $ea9f7575,
$121b0909, $1d9e8383, $58742c2c, $342e1a1a, $362d1b1b, $dcb26e6e, $b4ee5a5a, $5bfba0a0,
$a4f65252, $764d3b3b, $b761d6d6, $7dceb3b3, $527b2929, $dd3ee3e3, $5e712f2f, $13978484,
$a6f55353, $b968d1d1, $00000000, $c12ceded, $40602020, $e31ffcfc, $79c8b1b1, $b6ed5b5b,
$d4be6a6a, $8d46cbcb, $67d9bebe, $724b3939, $94de4a4a, $98d44c4c, $b0e85858, $854acfcf,
$bb6bd0d0, $c52aefef, $4fe5aaaa, $ed16fbfb, $86c54343, $9ad74d4d, $66553333, $11948585,
$8acf4545, $e910f9f9, $04060202, $fe817f7f, $a0f05050, $78443c3c, $25ba9f9f, $4be3a8a8,
$a2f35151, $5dfea3a3, $80c04040, $058a8f8f, $3fad9292, $21bc9d9d, $70483838, $f104f5f5,
$63dfbcbc, $77c1b6b6, $af75dada, $42632121, $20301010, $e51affff, $fd0ef3f3, $bf6dd2d2,
$814ccdcd, $18140c0c, $26351313, $c32fecec, $bee15f5f, $35a29797, $88cc4444, $2e391717,
$9357c4c4, $55f2a7a7, $fc827e7e, $7a473d3d, $c8ac6464, $bae75d5d, $322b1919, $e6957373,
$c0a06060, $19988181, $9ed14f4f, $a37fdcdc, $44662222, $547e2a2a, $3bab9090, $0b838888,
$8cca4646, $c729eeee, $6bd3b8b8, $283c1414, $a779dede, $bce25e5e, $161d0b0b, $ad76dbdb,
$db3be0e0, $64563232, $744e3a3a, $141e0a0a, $92db4949, $0c0a0606, $486c2424, $b8e45c5c,
$9f5dc2c2, $bd6ed3d3, $43efacac, $c4a66262, $39a89191, $31a49595, $d337e4e4, $f28b7979,
$d532e7e7, $8b43c8c8, $6e593737, $dab76d6d, $018c8d8d, $b164d5d5, $9cd24e4e, $49e0a9a9,
$d8b46c6c, $acfa5656, $f307f4f4, $cf25eaea, $caaf6565, $f48e7a7a, $47e9aeae, $10180808,
$6fd5baba, $f0887878, $4a6f2525, $5c722e2e, $38241c1c, $57f1a6a6, $73c7b4b4, $9751c6c6,
$cb23e8e8, $a17cdddd, $e89c7474, $3e211f1f, $96dd4b4b, $61dcbdbd, $0d868b8b, $0f858a8a,
$e0907070, $7c423e3e, $71c4b5b5, $ccaa6666, $90d84848, $06050303, $f701f6f6, $1c120e0e,
$c2a36161, $6a5f3535, $aef95757, $69d0b9b9, $17918686, $9958c1c1, $3a271d1d, $27b99e9e,
$d938e1e1, $eb13f8f8, $2bb39898, $22331111, $d2bb6969, $a970d9d9, $07898e8e, $33a79494,
$2db69b9b, $3c221e1e, $15928787, $c920e9e9, $8749cece, $aaff5555, $50782828, $a57adfdf,
$038f8c8c, $59f8a1a1, $09808989, $1a170d0d, $65dabfbf, $d731e6e6, $84c64242, $d0b86868,
$82c34141, $29b09999, $5a772d2d, $1e110f0f, $7bcbb0b0, $a8fc5454, $6dd6bbbb, $2c3a1616);
{$ifdef AES_LONGBOX}
Te4: array[byte] of longint =
($63636363, $7c7c7c7c, $77777777, $7b7b7b7b, $f2f2f2f2, $6b6b6b6b, $6f6f6f6f, $c5c5c5c5,
$30303030, $01010101, $67676767, $2b2b2b2b, $fefefefe, $d7d7d7d7, $abababab, $76767676,
$cacacaca, $82828282, $c9c9c9c9, $7d7d7d7d, $fafafafa, $59595959, $47474747, $f0f0f0f0,
$adadadad, $d4d4d4d4, $a2a2a2a2, $afafafaf, $9c9c9c9c, $a4a4a4a4, $72727272, $c0c0c0c0,
$b7b7b7b7, $fdfdfdfd, $93939393, $26262626, $36363636, $3f3f3f3f, $f7f7f7f7, $cccccccc,
$34343434, $a5a5a5a5, $e5e5e5e5, $f1f1f1f1, $71717171, $d8d8d8d8, $31313131, $15151515,
$04040404, $c7c7c7c7, $23232323, $c3c3c3c3, $18181818, $96969696, $05050505, $9a9a9a9a,
$07070707, $12121212, $80808080, $e2e2e2e2, $ebebebeb, $27272727, $b2b2b2b2, $75757575,
$09090909, $83838383, $2c2c2c2c, $1a1a1a1a, $1b1b1b1b, $6e6e6e6e, $5a5a5a5a, $a0a0a0a0,
$52525252, $3b3b3b3b, $d6d6d6d6, $b3b3b3b3, $29292929, $e3e3e3e3, $2f2f2f2f, $84848484,
$53535353, $d1d1d1d1, $00000000, $edededed, $20202020, $fcfcfcfc, $b1b1b1b1, $5b5b5b5b,
$6a6a6a6a, $cbcbcbcb, $bebebebe, $39393939, $4a4a4a4a, $4c4c4c4c, $58585858, $cfcfcfcf,
$d0d0d0d0, $efefefef, $aaaaaaaa, $fbfbfbfb, $43434343, $4d4d4d4d, $33333333, $85858585,
$45454545, $f9f9f9f9, $02020202, $7f7f7f7f, $50505050, $3c3c3c3c, $9f9f9f9f, $a8a8a8a8,
$51515151, $a3a3a3a3, $40404040, $8f8f8f8f, $92929292, $9d9d9d9d, $38383838, $f5f5f5f5,
$bcbcbcbc, $b6b6b6b6, $dadadada, $21212121, $10101010, $ffffffff, $f3f3f3f3, $d2d2d2d2,
$cdcdcdcd, $0c0c0c0c, $13131313, $ecececec, $5f5f5f5f, $97979797, $44444444, $17171717,
$c4c4c4c4, $a7a7a7a7, $7e7e7e7e, $3d3d3d3d, $64646464, $5d5d5d5d, $19191919, $73737373,
$60606060, $81818181, $4f4f4f4f, $dcdcdcdc, $22222222, $2a2a2a2a, $90909090, $88888888,
$46464646, $eeeeeeee, $b8b8b8b8, $14141414, $dededede, $5e5e5e5e, $0b0b0b0b, $dbdbdbdb,
$e0e0e0e0, $32323232, $3a3a3a3a, $0a0a0a0a, $49494949, $06060606, $24242424, $5c5c5c5c,
$c2c2c2c2, $d3d3d3d3, $acacacac, $62626262, $91919191, $95959595, $e4e4e4e4, $79797979,
$e7e7e7e7, $c8c8c8c8, $37373737, $6d6d6d6d, $8d8d8d8d, $d5d5d5d5, $4e4e4e4e, $a9a9a9a9,
$6c6c6c6c, $56565656, $f4f4f4f4, $eaeaeaea, $65656565, $7a7a7a7a, $aeaeaeae, $08080808,
$babababa, $78787878, $25252525, $2e2e2e2e, $1c1c1c1c, $a6a6a6a6, $b4b4b4b4, $c6c6c6c6,
$e8e8e8e8, $dddddddd, $74747474, $1f1f1f1f, $4b4b4b4b, $bdbdbdbd, $8b8b8b8b, $8a8a8a8a,
$70707070, $3e3e3e3e, $b5b5b5b5, $66666666, $48484848, $03030303, $f6f6f6f6, $0e0e0e0e,
$61616161, $35353535, $57575757, $b9b9b9b9, $86868686, $c1c1c1c1, $1d1d1d1d, $9e9e9e9e,
$e1e1e1e1, $f8f8f8f8, $98989898, $11111111, $69696969, $d9d9d9d9, $8e8e8e8e, $94949494,
$9b9b9b9b, $1e1e1e1e, $87878787, $e9e9e9e9, $cececece, $55555555, $28282828, $dfdfdfdf,
$8c8c8c8c, $a1a1a1a1, $89898989, $0d0d0d0d, $bfbfbfbf, $e6e6e6e6, $42424242, $68686868,
$41414141, $99999999, $2d2d2d2d, $0f0f0f0f, $b0b0b0b0, $54545454, $bbbbbbbb, $16161616);
{$endif}
{$ifdef StrictLong}
{$warnings on}
{$ifdef RangeChecks_on}
{$R+}
{$endif}
{$endif}
{$ifdef AES_LONGBOX}
const
X000000ff = longint($000000ff); {Avoid D4+ warnings}
X0000ff00 = longint($0000ff00);
X00ff0000 = longint($00ff0000);
Xff000000 = longint($ff000000);
{$endif}

72
Tocsg.Lib/VCL/EncLib/AES/enc_fp16.inc Normal file
View File

@ -0,0 +1,72 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for Pascal16/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_ENCR.PAS
0.11 16.11.08 we Use Ptr2Inc from BTypes
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{Normally used for TP5/5.5 (and during development BP7)}
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; {$ifdef CONST} const {$else} var {$endif} BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
label done;
var
pK: PWA4; {pointer to loop rount key}
r: integer;
t,s: TAESBlock;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK);
{Initialize with input block}
TWA4(s)[0] := TWA4(BI)[0] xor pK^[0];
TWA4(s)[1] := TWA4(BI)[1] xor pK^[1];
TWA4(s)[2] := TWA4(BI)[2] xor pK^[2];
TWA4(s)[3] := TWA4(BI)[3] xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
r := 1;
while true do begin
TWA4(t)[0] := Te0[s[0*4+0]] xor Te1[s[1*4+1]] xor Te2[s[2*4+2]] xor Te3[s[3*4+3]] xor pK^[0];
TWA4(t)[1] := Te0[s[1*4+0]] xor Te1[s[2*4+1]] xor Te2[s[3*4+2]] xor Te3[s[0*4+3]] xor pK^[1];
TWA4(t)[2] := Te0[s[2*4+0]] xor Te1[s[3*4+1]] xor Te2[s[0*4+2]] xor Te3[s[1*4+3]] xor pK^[2];
TWA4(t)[3] := Te0[s[3*4+0]] xor Te1[s[0*4+1]] xor Te2[s[1*4+2]] xor Te3[s[2*4+3]] xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
inc(r);
if r>=ctx.rounds then goto done;
TWA4(s)[0] := Te0[t[0*4+0]] xor Te1[t[1*4+1]] xor Te2[t[2*4+2]] xor Te3[t[3*4+3]] xor pK^[0];
TWA4(s)[1] := Te0[t[1*4+0]] xor Te1[t[2*4+1]] xor Te2[t[3*4+2]] xor Te3[t[0*4+3]] xor pK^[1];
TWA4(s)[2] := Te0[t[2*4+0]] xor Te1[t[3*4+1]] xor Te2[t[0*4+2]] xor Te3[t[1*4+3]] xor pK^[2];
TWA4(s)[3] := Te0[t[3*4+0]] xor Te1[t[0*4+1]] xor Te2[t[1*4+2]] xor Te3[t[2*4+3]] xor pK^[3];
inc(Ptr2Inc(pK), 4*sizeof(longint));
inc(r);
end;
done:
s[00] := SBox[t[0*4+0]];
s[01] := SBox[t[1*4+1]];
s[02] := SBox[t[2*4+2]];
s[03] := SBox[t[3*4+3]];
s[04] := SBox[t[1*4+0]];
s[05] := SBox[t[2*4+1]];
s[06] := SBox[t[3*4+2]];
s[07] := SBox[t[0*4+3]];
s[08] := SBox[t[2*4+0]];
s[09] := SBox[t[3*4+1]];
s[10] := SBox[t[0*4+2]];
s[11] := SBox[t[1*4+3]];
s[12] := SBox[t[3*4+0]];
s[13] := SBox[t[0*4+1]];
s[14] := SBox[t[1*4+2]];
s[15] := SBox[t[2*4+3]];
TWA4(BO)[0] := TWA4(s)[0] xor pK^[0];
TWA4(BO)[1] := TWA4(s)[1] xor pK^[1];
TWA4(BO)[2] := TWA4(s)[2] xor pK^[2];
TWA4(BO)[3] := TWA4(s)[3] xor pK^[3];
end;

88
Tocsg.Lib/VCL/EncLib/AES/enc_fp32.inc Normal file
View File

@ -0,0 +1,88 @@
(*************************************************************************
Include file for AES_ENCR.PAS - AES_Encrypt for BIT32/Full tables
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 09.07.06 W.Ehrhardt Initial version from AES_ENCR.PAS
**************************************************************************)
(**** (C) Copyright 2002-2006 Wolfgang Ehrhardt -- see copying_we.txt ****)
{ 32 Bit code: Alternative versions can be found in options.zip
enc_full.inc - fully unrolled version for highest speed
enc_ptr.inc - pointer version (may be faster on some systems)
}
{---------------------------------------------------------------------------}
procedure AES_Encrypt(var ctx: TAESContext; const BI: TAESBlock; var BO: TAESBlock);
{-encrypt one block, not checked: key must be encryption key}
var
r: integer; {round loop countdown counter}
pK: PWA4; {pointer to loop rount key }
s3,s0,s1,s2: longint; {TAESBlock s as separate variables}
t: TWA4;
begin
{Setup key pointer}
pK := PWA4(@ctx.RK);
{Initialize with input block}
s0 := TWA4(BI)[0] xor pK^[0];
s1 := TWA4(BI)[1] xor pK^[1];
s2 := TWA4(BI)[2] xor pK^[2];
s3 := TWA4(BI)[3] xor pK^[3];
inc(pK);
{perform encryption rounds}
for r:=1 to ctx.Rounds-1 do begin
t[0] := Te0[s0 and $ff] xor Te1[s1 shr 8 and $ff] xor Te2[s2 shr 16 and $ff] xor Te3[s3 shr 24] xor pK^[0];
t[1] := Te0[s1 and $ff] xor Te1[s2 shr 8 and $ff] xor Te2[s3 shr 16 and $ff] xor Te3[s0 shr 24] xor pK^[1];
t[2] := Te0[s2 and $ff] xor Te1[s3 shr 8 and $ff] xor Te2[s0 shr 16 and $ff] xor Te3[s1 shr 24] xor pK^[2];
s3 := Te0[s3 and $ff] xor Te1[s0 shr 8 and $ff] xor Te2[s1 shr 16 and $ff] xor Te3[s2 shr 24] xor pK^[3];
s0 := t[0];
s1 := t[1];
s2 := t[2];
inc(pK);
end;
{$ifdef AES_LONGBOX}
{Use expanded longint SBox table Te4 from [2]}
TWA4(BO)[0] := (Te4[s0 and $ff] and X000000ff) xor
(Te4[s1 shr 8 and $ff] and X0000ff00) xor
(Te4[s2 shr 16 and $ff] and X00ff0000) xor
(Te4[s3 shr 24 and $ff] and Xff000000) xor pK^[0];
TWA4(BO)[1] := (Te4[s1 and $ff] and X000000ff) xor
(Te4[s2 shr 8 and $ff] and X0000ff00) xor
(Te4[s3 shr 16 and $ff] and X00ff0000) xor
(Te4[s0 shr 24 and $ff] and Xff000000) xor pK^[1];
TWA4(BO)[2] := (Te4[s2 and $ff] and X000000ff) xor
(Te4[s3 shr 8 and $ff] and X0000ff00) xor
(Te4[s0 shr 16 and $ff] and X00ff0000) xor
(Te4[s1 shr 24 and $ff] and Xff000000) xor pK^[2];
TWA4(BO)[3] := (Te4[s3 and $ff] and X000000ff) xor
(Te4[s0 shr 8 and $ff] and X0000ff00) xor
(Te4[s1 shr 16 and $ff] and X00ff0000) xor
(Te4[s2 shr 24 and $ff] and Xff000000) xor pK^[3];
{$else}
{Uses Sbox and shl, needs type cast longint() for}
{16 bit compilers: here Sbox is byte, Te4 is longint}
TWA4(BO)[0] := (longint(SBox[s0 and $ff]) xor
longint(SBox[s1 shr 8 and $ff]) shl 8 xor
longint(SBox[s2 shr 16 and $ff]) shl 16 xor
longint(SBox[s3 shr 24]) shl 24 ) xor pK^[0];
TWA4(BO)[1] := (longint(SBox[s1 and $ff]) xor
longint(SBox[s2 shr 8 and $ff]) shl 8 xor
longint(SBox[s3 shr 16 and $ff]) shl 16 xor
longint(SBox[s0 shr 24]) shl 24 ) xor pK^[1];
TWA4(BO)[2] := (longint(SBox[s2 and $ff]) xor
longint(SBox[s3 shr 8 and $ff]) shl 8 xor
longint(SBox[s0 shr 16 and $ff]) shl 16 xor
longint(SBox[s1 shr 24]) shl 24 ) xor pK^[2];
TWA4(BO)[3] := (longint(SBox[s3 and $ff]) xor
longint(SBox[s0 shr 8 and $ff]) shl 8 xor
longint(SBox[s1 shr 16 and $ff]) shl 16 xor
longint(SBox[s2 shr 24]) shl 24 ) xor pK^[3];
{$endif}
end;

34
Tocsg.Lib/VCL/EncLib/AES/legal.txt Normal file
View File

@ -0,0 +1,34 @@
---------------------------------------------------------------------------
Legal Notice
Some of my software/programs contain cryptographic algorithms. There are
countries that restrict the use, import, export of cryptographic software.
Before keeping, using, or distributing the software, make sure that you
comply to these restrictions. If (for any reason) you are unable to do so,
you are not allowed to download, use, distribute the software.
If you are residing in a country that allows software patents you must
verify that no part of the software is covered by a patent in your country.
If (for any reason) you are unable to do so, you are not allowed to use or
distribute the software.
---------------------------------------------------------------------------
Rechtlicher Hinweis
Einige meiner Software/Programme enthalten kryptographische Algorithmen. Es
gibt Laender, die den Gebrauch, Import, Export von kryptographischer Software
einschraenken bzw. verbieten. Vor Besitz, Gebrauch, Verbreitung dieser
Software/Programme in diese(n) Laendern muss sichergestellt sein, dass
diesen Beschraenkungen entsprochen wird. Sollte das (aus welchen Gruenden
auch immer) nicht moeglich sein, darf die Software nicht heruntergeladen,
benutzt oder verbreitet werden.
Einige Laender erlauben Softwarepatente. Benutzer aus solchen Laendern
muessen sicherstellen, dass die Software (oder Teile davon) keine Patente
beruehrt oder verletzt. Sollte das (aus welchen Gruenden auch immer) nicht
moeglich sein, darf die Software nicht benutzt oder verbreitet werden.
---------------------------------------------------------------------------
http://wolfgang-ehrhardt.de

71
Tocsg.Lib/VCL/EncLib/AES/manifest.aes Normal file
View File

@ -0,0 +1,71 @@
!bdll.bat Compile batch file for AES_DLL
#ca.bat Generic compile batch file for all console compilers
#ca_dll.bat T_AES_WS with AES_DLL compile batch file for win32 compilers
#times.aes Times for encrypting 512MB, different compilers and packages
$d25.zip dproj files for Delphi 25 (Tokyo Starter)
$log_aes.zip Archive with log files of final tests done before release
aes_base.pas AES basic routines
aes_cbc.pas AES CBC functions
aes_ccm.pas AES CCM functions
aes_cfb.pas AES CFB128 functions
aes_cfb8.pas AES CFB8 functions
aes_cmac.pas AES CMAC routines
aes_conf.inc AES configuration include file
aes_cprf.pas AES CMAC Pseudo-Random Function-128
aes_ctr.pas AES CTR mode functions
aes_decr.pas AES decrypt functions (not needed for CFB/CTR/OFB mode)
aes_dll.dpr Project file for AES_DLL
aes_dll.res RES file for AES_DLL
aes_eax.pas AES EAX mode functions
aes_ecb.pas AES ECB functions
aes_encr.pas AES encrypt functions
aes_gcm.pas AES GCM mode functions
aes_intf.pas Interface unit for AES_DLL
aes_intv.pas Interface unit for AES_DLL (VirtualPascal version)
aes_ofb.pas AES OFB functions
aes_omac.pas AES OMAC1 routines
aes_seek.inc Include file for CTR_Seek functions
aes_type.pas AES type definitions
aes_xts.pas AES XTS mode functions
btypes.pas Common basic type definitions
comp_speed Cycles/Block and MB/s for supported (console) compilers
copying_we.txt License
dec_*.inc Include files for aes_decr.pas
enc_*.inc Include files for aes_encr.pas
legal.txt Legal notice (cryptography, software patents)
manifest.aes This file
mem_util.pas Utilities for hex dump and memory compare
options.zip Archive with optional inc files
ppp.pas AES PPP routines (GRC's Perfect Paper Passwords)
readme.aes Info about the AES archive
samples.zip Additional simple sample programs
std.inc Standard definitions and options
t_aescbc.pas Test prog for AES CBC
t_aesccm.pas Test prog for AES CCM
t_aescf8.pas Test prog for AES CFB8
t_aescfb.pas Test prog for AES CFB
t_aescrp.pas Test prog for AES encrypt/decrypt
t_aesctr.pas Test prog for AES CTR
t_aesecb.pas Test prog for AES ECB
t_aesgcm.pas Test prog for AES GCM
t_aesofb.pas Test prog for AES OFB
t_aestab.pas Calculate static full AES tables
t_aes_as.pas Test prog for associativity of CFB,OFB,CTR modes
t_aes_cs.pas Test prog for CTR_Seek functions
t_aes_ws.pas Main test prog for AES modes
t_aes_xl.pas Test prog for AES modes, ILen > $FFFF for 32 bit
t_cbccts.pas Test prog for AES CBC cipher text stealing
t_cmac.pas Test prog for AES CMAC routines
t_cprf.pas Test prog for aes_cprf
t_eax2.pas Test prog for AES EAX
t_ecbcts.pas Test prog for AES ECB cipher text stealing
t_fbmodi.pas Test prog for AES CTR/CFB/OFB with full blocks first
t_gsp128.pas Cycle test program for 128 bit keys, alignment info
t_gspeed.pas Test prog to compare AES encr/decr speed with Gladmann
t_mcst.pas Monte Carlo Self Tests, compares only final results
t_mctful.pas Full Monte Carlo Self Tests from AES submission
t_mkctab.pas Calculate compressed AES tables
t_omac.pas Test prog for AES OMAC
t_ppp.pas Test prog for PPP unit
t_xts.pas Test prog for AES XTS
_comparm Compile and run test programs on Raspberry Pi / 3

383
Tocsg.Lib/VCL/EncLib/AES/mem_util.pas Normal file
View File

@ -0,0 +1,383 @@
unit Mem_Util;
{Utility procedures for Hex/Base64 and memory compare}
interface
{$i STD.INC}
(*************************************************************************
DESCRIPTION : Utility procedures for Hex/Base64 and memory compare
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP, WDOSX
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : RFC 3548 - The Base16, Base32, and Base64 Data Encodings
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 01.01.02 W.Ehrhardt Initial version
0.20 30.08.03 we with pointer valid for all compilers
0.30 17.09.03 we with HexLong
0.40 27.09.03 we FPC/go32v2
0.50 05.10.03 we STD.INC
0.60 10.10.03 we english comments
0.70 26.12.03 we Base64Str
0.80 12.04.04 we HexUpper, Delphi 7
0.81 12.06.04 we handle nil pointers
0.90 05.12.04 we Hex2Mem
0.91 31.10.05 we Simple Base64Enc/DecStr, D9/WDOSX, Base64Str with result
0.92 11.12.05 we Bugfix: Hex2Mem and $R+
0.93 07.02.06 we RandMem
0.94 14.10.07 we HexWord
0.95 25.09.08 we uses BTypes
0.96 14.11.08 we BString, char8, Ptr2Inc
0.97 05.07.09 we D12 fix for Hex2Mem
0.98 27.07.10 we CompMemXL, RandMemXL
0.99 25.09.10 we CompMemXL returns true if size <= 0
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
uses
BTypes;
var
HexUpper: boolean; {Hex strings in uppercase}
function HexByte(b: byte): BString;
{-byte as hex string}
function HexWord(w: word): BString;
{-word as hex string}
function HexLong(L: longint): BString;
{-longint as hex string, LSB first}
function HexStr(psrc: pointer; L: integer): BString;
{-hex string of memory block of length L pointed by psrc}
procedure Hex2Mem({$ifdef CONST}const{$endif} s: BString; pdest: pointer; MaxL: word; var L: word);
{-Convert hex string to mem pointed by pdest, MaxL bytes, actual byte count in L}
function Base64Str(psrc: pointer; L: integer): BString;
{-Base64 string of memory block of length L pointed by psrc}
function Base64EncStr({$ifdef CONST}const{$endif} s: BString): BString;
{-Simple Base64 encoder, uses Base64Str}
function Base64DecStr({$ifdef CONST}const{$endif} es: BString): BString;
{-Simple Base64 decoder, stops conversion on first invalid char}
function CompMem(psrc, pdest: pointer; size: word): boolean;
{-compare memory block}
procedure RandMem(pdest: pointer; size: word);
{-fill memory block with size random bytes}
function CompMemXL(psrc, pdest: pointer; size: longint): boolean;
{-compare memory block}
procedure RandMemXL(pdest: pointer; size: longint);
{-fill memory block with size random bytes}
implementation
const
CT64: array[0..63] of char8 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
{---------------------------------------------------------------------------}
function HexByte(b: byte): BString;
{-byte as hex string}
const
nib: array[0..15] of char8 = '0123456789abcdef';
begin
if HexUpper then HexByte := upcase(nib[b div 16]) + upcase(nib[b and 15])
else HexByte := nib[b div 16] + nib[b and 15];
end;
{---------------------------------------------------------------------------}
function HexWord(w: word): BString;
{-word as hex string}
begin
HexWord := HexByte(w shr 8)+HexByte(w and $FF);
end;
{---------------------------------------------------------------------------}
function HexLong(L: longint): BString;
{-longint as hex string, LSB first}
var
i: integer;
s: string[8];
begin
s := '';
for i:=0 to 3 do begin
s := HexByte(L and $FF) + s;
L := L shr 8;
end;
HexLong := s;
end;
{---------------------------------------------------------------------------}
function HexStr(psrc: pointer; L: integer): BString;
{-hex string of memory block of length L pointed by psrc}
var
i: integer;
s: BString;
begin
s := '';
if psrc<>nil then begin
for i:=0 to L-1 do begin
s := s + HexByte(pByte(psrc)^);
inc(Ptr2Inc(psrc));
end;
end;
HexStr := s;
end;
{---------------------------------------------------------------------------}
procedure Hex2Mem({$ifdef CONST}const{$endif} s: BString; pdest: pointer; MaxL: word; var L: word);
{-Convert hex string to mem pointed by pdest, MaxL bytes, actual byte count in L}
const
nib: array[0..15] of char8 = '0123456789ABCDEF';
wsp: array[0..3] of char8 = #32#9#13#10;
label
_break; {for versions without break}
var
i,p: integer;
b: byte;
c: char8;
bdone: boolean; {flag byte complete}
begin
L := 0;
if MaxL=0 then exit;
bdone := true;
b := 0;
for i:=1 to length(s) do begin
c := upcase(s[i]);
p := pos(c,nib)-1;
if p>=0 then begin
{Insert new nibble into b. If range checking is on, we}
{must prevent the following shift from overflowing b. }
{$ifopt R+}
b := ((b and $F) shl 4) or (p and $0F);
{$else}
b := (b shl 4) or (p and $0F);
{$endif}
bdone := not bdone;
if bdone then begin
{byte complete, store or break}
if L<MaxL then begin
pByte(pdest)^ := b;
inc(Ptr2Inc(pdest));
inc(L);
end
else goto _break;
end;
end
else begin
{ignore white space}
if pos(c,wsp)=0 then goto _break;
end;
end;
_break:
if (not bdone) and (L<MaxL) then begin
{store remaining nibble}
pByte(pdest)^ := (b and $0F) shl 4;
inc(L);
end;
end;
{---------------------------------------------------------------------------}
function Base64Str(psrc: pointer; L: integer): BString;
{-Base64 string of memory block of length L pointed by psrc}
var
q,r: integer;
b0,b1,b2: byte;
{$ifndef RESULT}
result: BString;
{$endif}
begin
result := '';
if (L>0) and (psrc<>nil) then begin
q := L div 3;
r := L mod 3;
while q>0 do begin
b0 := pByte(psrc)^; inc(Ptr2Inc(psrc));
b1 := pByte(psrc)^; inc(Ptr2Inc(psrc));
b2 := pByte(psrc)^; inc(Ptr2Inc(psrc));
result := result + CT64[(b0 shr 2) and $3f]
+ CT64[((b0 shl 4) and $30) or ((b1 shr 4) and $0f)]
+ CT64[((b1 shl 2) and $3c) or ((b2 shr 6) and $03)]
+ CT64[b2 and $3f];
dec(q);
end;
if r=2 then begin
b0 := pByte(psrc)^; inc(Ptr2Inc(psrc));
b1 := pByte(psrc)^;
result := result + CT64[(b0 shr 2) and $3f]
+ CT64[((b0 shl 4) and $30) or ((b1 shr 4) and $0f)]
+ CT64[(b1 shl 2) and $3c]
+ '=';
end
else if r=1 then begin
b0 := pByte(psrc)^;
result := result + CT64[(b0 shr 2) and $3f]
+ CT64[(b0 shl 4) and $30]
+ '==';
end;
end;
{$ifndef RESULT}
Base64Str := result;
{$endif}
end;
{---------------------------------------------------------------------------}
function Base64EncStr({$ifdef CONST}const{$endif} s: BString): BString;
{-Simple Base64 encoder, uses Base64Str}
begin
Base64EncStr := Base64Str(@s[1], length(s));
end;
{---------------------------------------------------------------------------}
function Base64DecStr({$ifdef CONST}const{$endif} es: BString): BString;
{-Simple Base64 decoder, stops conversion on first invalid char}
var
i,bits,buf: word;
{$ifndef RESULT}
result: BString;
{$endif}
ic: array[char8] of byte;
b: byte;
label
_break; {for TP5/5.5}
begin
{Note: this is a stripped down version of Base2N.Decode2NPrim}
result := '';
{Fill input array with Base64 digit values, $FF if not valid}
fillchar(IC, sizeof(IC), $FF);
for i:=0 to 63 do ic[CT64[i]] := i;
buf := 0;
bits := 0;
for i:=1 to length(es) do begin
b := IC[es[i]];
if b>127 then goto _break;
{Include next input into buffer. If range checking is on, }
{we must prevent the following shift from overflowing buf.}
{$ifopt R+}
buf := ((buf and $03FF) shl 6) or b;
{$else}
buf := (buf shl 6) or b;
{$endif}
inc(bits,6);
if bits>7 then begin
{output a byte if at least 8 bits in input buf}
dec(bits,8);
result := result + char8((buf shr bits) and $FF);
end;
end;
_break:
{$ifndef RESULT}
Base64DecStr := result;
{$endif}
end;
{---------------------------------------------------------------------------}
function CompMemXL(psrc, pdest: pointer; size: longint): boolean;
{-compare memory block}
var
i: longint;
begin
if size>0 then begin
CompMemXL := false;
if (psrc=nil) or (pdest=nil) then exit;
for i:=1 to size do begin
if pByte(psrc)^<>pByte(pdest)^ then exit;
inc(Ptr2Inc(psrc));
inc(Ptr2Inc(pdest));
end;
end;
CompMemXL := true;
end;
{---------------------------------------------------------------------------}
procedure RandMemXL(pdest: pointer; size: longint);
{-fill memory block with size random bytes}
var
i: longint;
begin
if pdest<>nil then begin
for i:=1 to size do begin
pByte(pdest)^ := random(256);
inc(Ptr2Inc(pdest));
end;
end;
end;
{---------------------------------------------------------------------------}
function CompMem(psrc, pdest: pointer; size: word): boolean;
{-compare memory block}
begin
CompMem := CompMemXL(psrc, pdest, size);
end;
{---------------------------------------------------------------------------}
procedure RandMem(pdest: pointer; size: word);
{-fill memory block with size random bytes}
begin
RandMemXL(pdest, size);
end;
begin
HexUpper := false;
end.

BIN
Tocsg.Lib/VCL/EncLib/AES/options.zip Normal file
View File

Binary file not shown.

338
Tocsg.Lib/VCL/EncLib/AES/ppp.pas Normal file
View File

@ -0,0 +1,338 @@
unit PPP;
(*************************************************************************
DESCRIPTION : AES PPP routines (GRC's Perfect Paper Passwords)
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : http://www.grc.com/ppp/algorithm.htm
REMARKS : This unit provides functions for using the PPP system
described on the http://www.grc.com/ppp.htm page.
Although there are hints to a PPP V3 Specification, there
seems to be no formal definition. IMO the best available
description is from the algorithm page:
"The 256-bit PPP "Sequence Key" directly provides the key
for the AES-standard keyed Rijndael block cipher. A 128-bit
sequence counter is initialized to zero for the first
passcode, then increments once for every subsequent
passcode to provide encrypted data that are translated into
individual passcodes for printing on PPP passcards."
Some programs linked by the GRC pages do not comply to this,
and produce e.g. five standard passcodes from one 128-bit
counter: Instead of '32YT 65!@' from the GRC example they
give '32YT YNBq LhY# sGsm cT47 65!@ V2o6 VFjK WPFn ?aWE'.
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 08.08.10 W.Ehrhardt Initial basic version
0.11 08.08.10 we Improved DivBlock
0.12 08.08.10 we PPP_First32, PPP_Next
0.13 08.08.10 we Map constants
0.14 08.08.10 we Error checking
0.15 09.08.10 we PPP_FirstCard, PPP_Init4Standard, PPP_Init4Extended
0.16 09.08.10 we Fix for mlen=0, PPP_SetCodesPerCard
0.17 09.08.10 we Sort character map
0.18 27.09.10 we Add $N- for TP5
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2010 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
{$ifdef VER50}
{$N-} {Once again: brain-damaged TP5 floating-point arithmetic!}
{$endif}
interface
uses
BTypes, AES_Type, AES_Base, AES_Encr;
type
TPPPKey = packed array[0..31] of byte; {PPP uses 256 bit keys}
TPPPMap = packed array[0..255] of char8;
type
TPPPctx = record
actx: TAESContext;
map : TPPPMap; {character map}
mlen: byte; {map length}
clen: byte; {code length}
cpc : word; {codes per card}
end;
const
PPP_Err_non_increasing = -30; {Characters in map are not strictly increasing}
PPP_Err_invalid_maplen = -31; {Invalid number of characters in map}
PPP_Err_invalid_codelen = -32; {Passcode length too large or zero}
const
map64: string[64] = '!#%+23456789:=?@ABCDEFGHJKLMNPRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
map88: string[88] = '!"#$%&''()*+,-./23456789:;<=>?@ABCDEFGHJKLMNOPRSTUVWXYZ[\]^_abcdefghijkmnopqrstuvwxyz{|}~';
procedure PPP_Init(var pctx: TPPPctx; SeqKey: TPPPKey; smap: str255; codelen: word; var Err: integer);
{-Initialize context pctx with Seqkey, character map smap, and passcode length.}
{ If smap is empty, all 256 characters #0..#255 are used.}
procedure PPP_Init4Standard(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, standard map64, passcode length = 4}
procedure PPP_Init4Extended(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, extended map88, passcode length = 4}
procedure PPP_SetCodesPerCard(var pctx: TPPPctx; newcpc: word);
{-Set new "codes per card" value, 70 if 0 }
function PPP_First32(var pctx: TPPPctx; startcode: longint): str255;
{-Get first PPP passcode starting with passcode startcode}
function PPP_First128(var pctx: TPPPctx; start128: TAESBlock): str255;
{-Get first PPP passcode for LSB 128 bit number start128}
function PPP_FirstCard(var pctx: TPPPctx; cardnum: word): str255;
{-Get first PPP passcode of card cardnum (use card 1 if cardnum=0)}
function PPP_Next(var pctx: TPPPctx): str255;
{-Return the next passcode from context pctx}
implementation
{---------------------------------------------------------------------------}
procedure DivBlock(var a: TAESBlock; b: byte; var r: byte);
{-Divide an AES LSB block by b (256 if b=0): r = a mod b; a = a div b}
var
i: integer;
q,w: word;
begin
q := b;
if q=0 then q := 256;
{initialize "carry"}
w := 0;
for i:=15 downto 0 do begin
{loop invariant: 0 <= w < q}
w := (w shl 8) or a[i];
r := w div q;
w := w mod q;
a[i] := r;
end;
{set r to remainder, w is still < q!}
r := byte(w);
end;
{---------------------------------------------------------------------------}
procedure IncBlock(var a: TAESBlock);
{-Increment an AES LSB block}
var
j: integer;
begin
for j:=0 to 15 do begin
if a[j]=$FF then a[j] := 0
else begin
inc(a[j]);
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure SortMap(var pctx: TPPPctx);
{-Sort character map with CombSort routine}
var
i,j,gap,r: integer;
swapped: boolean;
c: char8;
begin
{See my CombSort routine from util archive}
with pctx do begin
if mlen=0 then r := 255 else r := mlen - 1;
gap := r;
if gap<1 then exit;
repeat
gap := longint(gap)*10 div 13;
if (gap=9) or (gap=10) then gap := 11
else if gap<1 then gap:=1;
swapped := false;
for i:=0 to r-gap do begin
j := i + gap;
if ord(map[j]) < ord(map[i]) then begin
c := map[j];
map[j] := map[i];
map[i] := c;
swapped := true;
end
end
until (gap=1) and not swapped;
end;
end;
{---------------------------------------------------------------------------}
procedure PPP_Init(var pctx: TPPPctx; SeqKey: TPPPKey; smap: str255; codelen: word; var Err: integer);
{-Initialize context pctx with Seqkey, character map smap, and passcode length.}
{ If smap is empty, all 256 characters #0..#255 are used.}
var
i: integer;
sorted: boolean;
begin
with pctx do begin
Err := AES_Init_Encr(SeqKey, 256, actx);
if Err<>0 then exit;
fillchar(map, sizeof(map),0);
if smap='' then begin
{use all chars #0..#255}
mlen := 0;
for i:=0 to 255 do map[i] := char8(i);
end
else begin
mlen := length(smap);
if mlen=1 then begin
Err := PPP_Err_invalid_maplen;
exit;
end;
move(smap[1],map[0],mlen);
sorted := true;
i:= 1;
while (i<mlen) and sorted do begin
sorted := ord(map[i-1]) < ord(map[i]);
inc(i);
end;
if not sorted then begin
SortMap(pctx);
for i:=1 to mlen-1 do begin
if ord(map[i-1]) >= ord(map[i]) then begin
Err := PPP_Err_non_increasing;
exit;
end;
end;
end;
end;
{here 2 <= mlen <= 256 or mlen=0}
if mlen=0 then i := 16
else i := trunc(128.0*ln(2.0)/ln(mlen));
if (codelen > i) or (codelen=0) then begin
Err := PPP_Err_invalid_codelen;
exit;
end;
clen := codelen;
cpc := 70; {default codes pre card}
end;
end;
{---------------------------------------------------------------------------}
procedure PPP_Init4Standard(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, standard map64, passcode length = 4}
begin
PPP_Init(pctx, SeqKey, map64, 4, Err);
end;
{---------------------------------------------------------------------------}
procedure PPP_Init4Extended(var pctx: TPPPctx; SeqKey: TPPPKey; var Err: integer);
{-Initialize context pctx with Seqkey, extended map88, passcode length = 4}
begin
PPP_Init(pctx, SeqKey, map88, 4, Err);
end;
{---------------------------------------------------------------------------}
procedure PPP_SetCodesPerCard(var pctx: TPPPctx; newcpc: word);
{-Set new "codes per card" value, 70 if 0 }
begin
if newcpc=0 then newcpc := 70;
pctx.cpc := newcpc;
end;
{---------------------------------------------------------------------------}
function PPP_Next(var pctx: TPPPctx): str255;
{-Return the next passcode from context pctx}
var
i: integer;
idx: byte;
s: str255;
begin
s := '';
with pctx do begin
AES_Encrypt(actx, actx.iv, actx.buf);
for i:=1 to clen do begin
DivBlock(actx.buf, mlen, idx);
s := s + map[idx];
end;
IncBlock(actx.IV);
end;
PPP_Next := s;
end;
{---------------------------------------------------------------------------}
function PPP_First32(var pctx: TPPPctx; startcode: longint): str255;
{-Get first PPP passcode starting with passcode startcode}
begin
with pctx do begin
fillchar(actx.iv, sizeof(actx.iv), 0);
TWA4(actx.iv)[0] := startcode;
end;
PPP_First32 := PPP_Next(pctx);
end;
{---------------------------------------------------------------------------}
function PPP_FirstCard(var pctx: TPPPctx; cardnum: word): str255;
{-Get first PPP passcode of card cardnum (use card 1 if cardnum=0)}
begin
if cardnum=0 then cardnum := 1;
PPP_FirstCard := PPP_First32(pctx, longint(cardnum-1)*pctx.cpc);
end;
{---------------------------------------------------------------------------}
function PPP_First128(var pctx: TPPPctx; start128: TAESBlock): str255;
{-Get first PPP passcode for LSB 128 bit number start128}
begin
pctx.actx.iv := start128;
PPP_First128 := PPP_Next(pctx);
end;
end.

108
Tocsg.Lib/VCL/EncLib/AES/readme.aes Normal file
View File

@ -0,0 +1,108 @@
This archive contains AES (Advanced Encryption Standard) related Pascal /
Delphi sources: basic AES routines and recommended block cipher modes of
operation (with test programs that verify compilation and results).
The block level routines supply separate units for encryption and decryption.
The source code for basic encryption/decryption is split into several include
files. At the lowest level there are type definitions and common routines. Key
sizes of 128, 192, and 256 bits are supported.
The following recommended block cipher modes of operation are implemented:
CBC, CFB128, CFB8, CTR, ECB, OFB, OMAC, CMAC, CCM, EAX, GCM, and XTS. All
chaining modes allow plain and cipher text lengths that need not be multiples
of the block length (for ECB and CBC cipher text stealing is used for the
short block; only one short block is allowed and there must be at least one
full block). CTR mode can use 4 built-in incrementing functions or a user
supplied one, and provides seek functions for random access reads.
All routines have been included in the AES_DLL.DLL, there are two interface
units for this DLL (one for Virtual Pascal, the second for the other Win32
compilers).
Since the July 2006 release there are conditional defines to support
compressed tables: one 2K encryption table (calculated with t_mkctab) replaces
the four 1K tables (same for decryption, here the inverse SBox is no longer
needed). Besides using less static memory, compressed tables are considered as
a countermeasure against cache timing attacks.
W.Ehrhardt, Nov. 2017
http://wolfgang-ehrhardt.de
-------------------------------------------------------------------------------
Last changes:
Nov. 2017
- FPC/ARM and Delphi Tokyo adjustments
Sep. 2015
- Constant time verification/compare for the all-in-one packet
functions (aes_eax, aes_gcm, aes_ccm)
Jan. 2013
- Adjustments (test programs) for D17 (XE3), {$J+} if needed
Dec. 2012
- Small 64-bit adjustments (separate BIT64 include statements in
aes_decr and aes_encr; improved aes_gcm)
July 2012
- 64-bit adjustment for GCM
Oct. 2010
- Galois/Counter Mode (GCM)
- Fix PPP unit for TP5
Aug. 2010
- Message length ILen has now type longint
- New PPP unit (Perfect Paper Passwords)
June 2010
- AES_CTR_Seek functions
July 2009
- Delphi 2009 (D12) adjustments
May 2009
- Counter with CBC-MAC (CCM) mode
Nov. 2008
- Uses the BTypes unit for better portability
Aug. 2008
- All-in-one EAX functions for encrypt / authenticate and decrypt / verify:
decryption is performed only if the verification was successful.
- Range check safe IncProcs for FPC -dDebug
Jan. 2008
New unit aes_cfb8 implementing the 8 bit CFB mode
Oct. 2007
- New unit aes_xts implementing the XTS mode from the IEEE P1619 Draft Standard
for Cryptographic Protection of Data on Block-Oriented Storage Devices.
June 2007
- AES-CMAC-PRF-128 from RFC 4615
- New EAX context name
Nov. 2006
- Contributed AES256 file crypt/authenticate unit
July 2006
- CMAC mode, compressed tables as a countermeasure against cache timing attacks
Jul. 2004
- EAX mode, AES DLL, new demo programs
Jun. 2004
- OMAC mode on AES page
Mar. 2004
- Significant speedup of AES key generation
Jan. 2004
- New faster AES routines
Dec. 2003
- First version of AES archive released

BIN
Tocsg.Lib/VCL/EncLib/AES/samples.zip Normal file
View File

Binary file not shown.

631
Tocsg.Lib/VCL/EncLib/AES/std.inc Normal file
View File

@ -0,0 +1,631 @@
(*************************************************************************
DESCRIPTION : Standard definitions and options
REQUIREMENTS : TP5-7, D1-D7/D9-D12/D14-D25, FPC, VP, (TPW1.0/1.5,BCB3/4)
Version Date Author Modification
------- -------- ------- ------------------------------------------
1.00 05.10.03 W.Ehrhardt Initial version
1.01 05.10.03 we X_OPT, removed TP4
1.02 30.10.03 we WINCRT
1.03 09.12.03 we {$R+,S+} {$ifdef debug}
1.04 26.12.03 we VP: {&Optimise+,SmartLink+,Speed+} ifndef debug
1.05 28.12.03 we DELPHI = Delphi32 (no Delphi 1!)
1.06 12.04.04 we Delphi 7
1.07 26.09.04 we Record starting values of important options
1.08 10.10.04 we RESULT for Result pseudo variable
1.09 02.01.05 we BIT16: default $F-
1.10 26.02.05 we StrictLong
1.11 05.05.05 we D9 aka Delphi 2005
1.12 22.05.05 we StrictLong for FPC 2.0
1.13 27.05.05 we {$goto on} for FPC
1.14 27.05.05 we moved {$goto on} to default settings
1.15 29.05.05 we HAS_INT64, HAS_MSG, _STD_INC_
1.16 06.08.05 we J_OPT, N_OPT, HAS_INLINE
1.17 17.08.05 we HAS_ASSERT
1.18 08.11.05 we APPCONS, partial TMT,TPW15 support
1.19 20.11.05 we Default option {$B-}
1.20 08.01.06 we ABSTRACT/DEFAULT
1.21 08.02.06 we Fix Scanhelp quirk
1.22 11.02.06 we VER5X
1.23 15.04.06 we HAS_XTYPES
1.24 08.05.06 we D10 aka Delphi 2006
1.25 25.05.06 we Define RESULT if FPC_OBJFPC is defined
1.26 08.09.06 we Define RESULT/DEFAULT if FPC_DELPHI is defined
1.27 14.11.06 we HAS_ASSERT for FPC VER1 and VER2
1.28 28.11.06 we HAS_UNSAFE, $warn SYMBOL_../UNSAFE_.. OFF
1.29 25.05.07 we D11 aka Delphi 2007, FPC2.1.4
1.30 23.06.07 we FPC_ProcVar: Helper for procedure variables
1.31 18.09.07 we HAS_INLINE for FPC VER2
1.32 04.10.07 we FPC Intel ASMmode only if CPUI386 is defined
1.33 22.11.07 we Record value of $X option, undef RESULT if $X-
1.34 19.05.08 we HAS_UINT64
1.35 21.06.08 we V7PLUS, HAS_UINT64 for FPC VER2_2
1.36 07.09.08 we HAS_CARD32
1.37 21.11.08 we D12 aka D2009
1.38 19.02.09 we TPW 1.0 adjustments
1.39 05.07.09 we D12Plus
1.40 17.10.09 we BASM (BASM16 or Bit32)
1.41 21.10.09 we HAS_OVERLOAD
1.42 07.04.10 we HAS_DENORM_LIT (Denormalised extended literals, e.g. -1.23e-4942)
1.43 20.06.10 we D14 (VER210)
1.45 16.10.10 we WIN16
1.46 05.11.10 we FPC VER2_4
1.47 12.11.11 we FPC VER2_6
1.48 01.01.12 we HAS_UINT64 for FPC VER2_6
1.49 12.01.12 we BIT64, WIN32or64, Bit32or64
1.50 13.01.12 we EXT64 (64 bit extended = double)
1.51 19.01.12 we Define EXT64 if SIMULATE_EXT64
1.52 05.09.12 we Basic support for D14, D15(XE), D16(XE2), D17(XE3)
1.53 01.12.12 we Simplified FPC 2.X.Y definitions
1.54 17.12.12 we UNIT_SCOPE (D16/D17)
1.55 25.12.12 we J_OPT for BIT64
1.56 25.04.13 we D18/XE4 (VER250)
1.57 28.09.13 we Basic support for D19/XE5 (VER260)
1.58 17.04.14 we Basic support for D20/XE6 (VER270)
1.59 06.05.14 we FPC/CPUARM: $define EXT64, i.e. no FP 80-bit extended
1.60 13.09.14 we Basic support for D21/XE7 (VER280)
1.61 22.10.14 we HAS_OUT
1.62 13.01.15 we FPC VER3 (FPC3.0.1/3.1.1), FPC2Plus, FPC271or3
1.63 22.04.15 we Basic support for D22/XE8 (VER290)
1.64 25.04.15 we HAS_INTXX, HAS_PINTXX
1.65 01.09.15 we Basic support for D23 (VER300) 'Seattle'
1.66 26.04.16 we Basic support for D24 (VER310) 'Berlin'
1.67 17.03.17 we Define PurePascal for FPC/CPUARM
1.68 11.04.17 we Basic support for D25 (VER320) 'Tokyo'
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2017 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$ifndef _STD_INC_}
{$define _STD_INC_} {include STD.INC only once}
{.$undef BIT16} {16 Bit code, Pascal / D1}
{.$undef BIT32} {32 Bit code}
{.$undef BIT64} {64 Bit code}
{.$undef DELPHI} {Delphi2+ and BCB++}
{.$undef G_OPT} {G+ option support}
{.$undef D4PLUS} {Delphi 4 or higher}
{.$undef BASM16} {16 Bit BASM}
{.$undef LoadArgs} {Register params}
{.$undef WINCRT} {Use WinCRT for console}
{.$undef WIN16} {Compiler for 16-bit windows}
{.$undef WIN32or64} {Compiler for 32/64-bit windows}
{.$undef RESULT} {Result pseudo variable}
{.$undef StrictLong} {Warning for longint const with MS bit}
{.$undef HAS_INT64} { int64 integer type available}
{.$undef HAS_UINT64} {uint64 integer type available}
{.$undef HAS_CARD32} {Has 32 bit cardinal}
{.$undef HAS_MSG} {Has message directive}
{.$undef HAS_INLINE} {Has inline procs/funcs (D9)}
{.$undef HAS_OUT} {Has OUT parameters: D3+, FPC2+ Delphi/ObjFPC}
{.$undef ABSTRACT} {Has abstract methods}
{.$undef DEFAULT} {Support default parameters}
{.$undef VER5X} {TP5 or TP55}
{.$undef HAS_XTYPES} {Xtra types in system: pByte, pLongint etc}
{.$undef HAS_UNSAFE} {UNSAFE warnings}
{.$undef APPCONS} {Needs "Apptype console" for console application}
{.$undef FPC_ProcVar} {FPC handling of @ and proc variables}
{.$undef FPC2Plus} {FPC 2 or newer}
{.$undef FPC271or3} {FPC 271 or 3 (less accurate for 64 bit or SSE2)}
{.$undef D12PLUS} {Delphi 12 or higher}
{.$undef HAS_OVERLOAD} {Overloading of procedures and functions}
{.$undef HAS_DENORM_LIT} {Denormalised (extended) literals, e.g. -1.23e-4942}
{.$undef EXT64} {64 bit extended = double}
{.$undef UNIT_SCOPE} {Unit scope name, D16+}
{.$undef HAS_INTXX} {Int8 .. Int32, UInt8 .. UInt32}
{.$undef HAS_PINTXX} {pInt8 .. pInt32, pUInt8 .. pUInt32}
{$define CONST} {const in proc declaration}
{$define Q_OPT} {Q- option support}
{$define X_OPT} {X+ option support}
{$define N_OPT} {N+ option support}
{$define BASM} {BASM16 or BIT32}
{$define V7PLUS} {TP7 or higher}
{$ifdef VER10} {TPW 1.0}
{$define BIT16}
{$define BASM16}
{$define WINCRT}
{$define G_OPT}
{$undef CONST}
{$undef Q_OPT}
{$undef V7PLUS}
{$endif}
{$ifdef VER15} {TPW 1.5}
{$define BIT16}
{$define BASM16}
{$define WINCRT}
{$define G_OPT}
{$undef CONST}
{$undef Q_OPT}
{$undef V7PLUS}
{$endif}
{$ifdef VER50 }
{$define BIT16}
{$define VER5X}
{$undef BASM}
{$undef CONST}
{$undef Q_OPT}
{$undef X_OPT}
{$undef V7PLUS}
{$endif}
{$ifdef VER55 }
{$define BIT16}
{$define VER5X}
{$undef BASM}
{$undef CONST}
{$undef Q_OPT}
{$undef X_OPT}
{$undef V7PLUS}
{$endif}
{$ifdef VER60 }
{$define BIT16}
{$undef CONST}
{$undef Q_OPT}
{$define G_OPT}
{$define BASM16}
{$undef V7PLUS}
{$endif}
{$ifdef VER70 }
{$define BIT16}
{$define G_OPT}
{$define BASM16}
{$endif}
{$ifdef VER80}
{.$define DELPHI} {D1} {*we V1.05}
{$define BIT16 }
{$define G_OPT }
{$define BASM16}
{$define WINCRT}
{$define RESULT}
{$endif}
{$ifdef VER90 }
{$define DELPHI} {D2}
{$endif}
{$ifdef VER93 }
{$define DELPHI} {BCB++1}
{$endif}
{$ifdef VER100}
{$define DELPHI} {D3}
{$define HAS_ASSERT}
{$define HAS_OUT}
{$endif}
{$ifdef VER110}
{$define DELPHI} {BCB3}
{$define HAS_OUT}
{$endif}
{$ifdef VER120}
{$define DELPHI} {D4}
{$define D4PLUS}
{$endif}
{$ifdef VER125}
{$define DELPHI} {BCB4}
{$define D4PLUS}
{$endif}
{$ifdef VER130}
{$define DELPHI} {D5}
{$define D4PLUS}
{$endif}
{$ifdef VER140}
{$define DELPHI} {D6}
{$define D4PLUS}
{$endif}
{$ifdef VER150}
{$define DELPHI} {D7}
{$define D4PLUS}
{$define HAS_UNSAFE}
{$define HAS_UINT64}
{$endif}
{$ifdef VER170}
{$define DELPHI} {D9}
{$define D4PLUS}
{$define HAS_INLINE}
{$define HAS_UNSAFE}
{$define HAS_UINT64}
{$endif}
{$ifdef VER180}
{$define DELPHI} {D10, D11 ifdef VER185}
{$define D4PLUS}
{$define HAS_INLINE}
{$define HAS_UNSAFE}
{$define HAS_UINT64}
{$endif}
{$ifdef VER200}
{$define DELPHI} {D12}
{$define D12PLUS}
{$endif}
{$ifdef VER210}
{$define DELPHI} {D14}
{$define D12PLUS}
{$endif}
{$ifdef VER220}
{$define DELPHI} {D15 - XE}
{$define D12PLUS}
{$endif}
{$ifdef VER230}
{$define DELPHI} {D16 - XE2}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER240}
{$define DELPHI} {D17 - XE3}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER250}
{$define DELPHI} {D18 - XE4}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER260}
{$define DELPHI} {D19 - XE5}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER270}
{$define DELPHI} {D20 - XE6}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER280}
{$define DELPHI} {D21 - XE7}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER290}
{$define DELPHI} {D22 - XE8}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER300}
{$define DELPHI} {D23}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER310}
{$define DELPHI} {D24}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef VER320}
{$define DELPHI} {D25}
{$define D12PLUS}
{$define UNIT_SCOPE}
{$endif}
{$ifdef CONDITIONALEXPRESSIONS} {D6+}
{$ifndef D4PLUS}
{$define D4PLUS}
{$endif}
{$define HAS_MSG}
{$define HAS_XTYPES}
{$ifdef CPUX64}
{$define BIT64}
{$endif}
{$endif}
{$ifdef VER70}
{$ifdef windows}
{$define WINCRT}
{$endif}
{$endif}
{$ifdef VirtualPascal}
{$define G_OPT}
{$define RESULT}
{$define LoadArgs}
{$endif}
{$ifdef WIN32}
{$define J_OPT}
{$endif}
{$ifdef BIT64}
{$define J_OPT}
{$endif}
{$ifdef FPC}
{$define FPC_ProcVar}
{$define ABSTRACT}
{$define HAS_XTYPES}
{$define HAS_OVERLOAD}
{$undef N_OPT}
{$ifdef VER1}
{$undef J_OPT}
{$define HAS_INT64}
{$define HAS_CARD32}
{$define HAS_MSG}
{$define HAS_ASSERT}
{$ifndef VER1_0}
{FPC 1.9.x}
{$define StrictLong}
{$else}
{$define LoadArgs}
{$endif}
{$endif}
{$ifdef VER2}
{$define FPC2Plus}
{$define HAS_ASSERT}
{$define HAS_INT64}
{$define HAS_CARD32}
{$define HAS_MSG}
{$define HAS_INLINE} {Remember to use -Si}
{$define StrictLong}
{$ifdef FPC_OBJFPC}
{$define DEFAULT}
{$endif}
{$ifdef FPC_DELPHI}
{$define DEFAULT}
{$endif}
{$ifndef VER2_0}
{$ifndef VER2_1}
{$define HAS_UINT64} {2.2+}
{$endif}
{$define HAS_DENORM_LIT} {2.1+}
{$endif}
{$ifdef VER2_7_1}
{$define FPC271or3}
{$endif}
{$ifdef VER2_6_2}
{$define HAS_INTXX}
{$endif}
{$ifdef VER2_6_4}
{$define HAS_INTXX}
{$define HAS_PINTXX}
{$endif}
{$endif}
{$ifdef VER3}
{$define FPC2Plus}
{$define FPC271or3}
{$define HAS_ASSERT}
{$define HAS_INT64}
{$define HAS_CARD32}
{$define HAS_MSG}
{$define HAS_INLINE}
{$define HAS_UINT64}
{$define HAS_DENORM_LIT}
{$define StrictLong}
{$define HAS_INTXX}
{$define HAS_PINTXX}
{$ifdef FPC_OBJFPC}
{$define DEFAULT}
{$endif}
{$ifdef FPC_DELPHI}
{$define DEFAULT}
{$endif}
{$endif}
{Note: Mode detection does not work for -Sxxx and version < 2.0.2}
{$ifdef FPC_OBJFPC}
{$define RESULT}
{$define HAS_OUT}
{$endif}
{$ifdef FPC_DELPHI}
{$define RESULT}
{$define HAS_OUT}
{$undef FPC_ProcVar}
{$endif}
{$ifdef FPC_TP}
{$undef FPC_ProcVar}
{$endif}
{$ifdef FPC_GPC}
{$undef FPC_ProcVar}
{$endif}
{$ifdef CPU64}
{$define BIT64}
{$endif}
{$ifdef CPUARM}
{$define EXT64} {No extended for ARM}
{$define PurePascal}
{$endif}
{$endif}
{$ifdef __TMT__}
{$undef N_OPT}
{$define RESULT}
{$define HAS_INT64}
{$define LoadArgs}
{$ifdef __WIN32__}
{$define WIN32}
{$endif}
{$endif}
{$ifndef BIT16}
{$define Bit32or64}
{$ifndef BIT64}
{$define BIT32}
{$endif}
{$endif}
{$ifdef BIT16}
{$ifdef WINDOWS}
{$define WIN16}
{$endif}
{$endif}
{$ifdef Delphi}
{$define RESULT}
{$define ABSTRACT}
{$define HAS_DENORM_LIT}
{$endif}
{$ifdef D12Plus}
{$ifndef D4PLUS}
{$define D4PLUS}
{$endif}
{$define HAS_INLINE}
{$define HAS_UNSAFE}
{$define HAS_UINT64}
{$define HAS_INTXX}
{$endif}
{$ifdef D4Plus}
{$define HAS_OUT}
{$define HAS_INT64}
{$define HAS_CARD32}
{$define StrictLong}
{$define HAS_ASSERT}
{$define DEFAULT}
{$define HAS_OVERLOAD}
{$endif}
{$ifdef WIN32}
{$define WIN32or64}
{$ifndef VirtualPascal}
{$define APPCONS}
{$endif}
{$endif}
{$ifdef WIN64}
{$define BIT64}
{$define WIN32or64}
{$define EXT64}
{$define APPCONS}
{$endif}
{$ifdef BIT64}
{$undef BASM}
{$endif}
{-- Default options --}
{$ifndef FPC}
{$B-} {short-circuit boolean expression evaluation, FPC has always B-!}
{$endif}
{$ifdef FPC}
{$ifdef CPUI386}
{$ASMmode intel}
{$endif}
{$goto on}
{$endif}
{$ifdef VirtualPascal}
{$ifndef debug}
{&Optimise+,SmartLink+,Speed+}
{$endif}
{$endif}
{$ifdef G_OPT}
{$G+}
{$endif}
{$ifdef Q_OPT}
{Most Crypto and CRC/Hash units need Q-, define Q+ locally if needed}
{$Q-}
{$endif}
{$ifdef debug}
{$R+,S+} {Note: D9+ needs $R- for StrictLong setting!}
{$else}
{$R-,S-}
{$endif}
{$ifdef SIMULATE_EXT64}
{$define EXT64}
{$endif}
{$ifdef BIT16}
{$F-}
{$endif}
{-- Record the starting values of important local options --}
{$ifopt A+} {$define Align_on} {$endif}
{$ifopt B+} {$define BoolEval_on} {$endif}
{$ifopt D+} {$define DebugInfo_on} {$endif}
{$ifopt I+} {$define IOChecks_on} {$endif}
{$ifopt R+} {$define RangeChecks_on} {$endif}
{$ifopt V+} {$define VarStringChecks_on} {$endif}
{$ifdef Q_OPT}
{$ifopt P+} {$define OpenStrings_on} {$endif}
{$ifopt Q+} {$define OverflowChecks_on} {$endif}
{$endif}
{-- Note that X option is GLOBAL --}
{$ifdef X_OPT}
{$ifopt X+} {$define ExtendedSyntax_on} {$endif}
{$ifopt X-} {$undef RESULT} {$endif}
{$endif}
{$ifdef CONDITIONALEXPRESSIONS}
{$warn SYMBOL_PLATFORM OFF}
{$warn SYMBOL_DEPRECATED OFF}
{$warn SYMBOL_LIBRARY OFF}
{$warn UNIT_DEPRECATED OFF}
{$warn UNIT_LIBRARY OFF}
{$warn UNIT_PLATFORM OFF}
{$ifdef HAS_UNSAFE}
{$warn UNSAFE_TYPE OFF}
{$warn UNSAFE_CODE OFF}
{$warn UNSAFE_CAST OFF}
{$endif}
{$endif}
{$else}
{$ifdef HAS_MSG}
{$message 'std.inc included more than once'}
{$endif}
{$endif}

190
Tocsg.Lib/VCL/EncLib/AES/t_aes_as.pas Normal file
View File

@ -0,0 +1,190 @@
{-Prog for associativity of CFB,OFB,CTR modes, we Aug.2008}
program T_AES_AS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
BTypes,aes_type,aes_base,aes_ctr,aes_cfb,aes_cfb8,aes_ofb,mem_util;
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
CTR : TAESBlock = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct_cfb : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$c8,$a6,$45,$37,$a0,$b3,$a9,$3f,
$cd,$e3,$cd,$ad,$9f,$1c,$e5,$8b,
$26,$75,$1f,$67,$a3,$cb,$b1,$40,
$b1,$80,$8c,$f1,$87,$a4,$f4,$df,
$c0,$4b,$05,$35,$7c,$5d,$1c,$0e,
$ea,$c4,$c6,$6f,$9f,$f7,$f2,$e6);
ct_ctr : array[0..63] of byte = ($87,$4d,$61,$91,$b6,$20,$e3,$26,
$1b,$ef,$68,$64,$99,$0d,$b6,$ce,
$98,$06,$f6,$6b,$79,$70,$fd,$ff,
$86,$17,$18,$7b,$b9,$ff,$fd,$ff,
$5a,$e4,$df,$3e,$db,$d5,$d3,$5e,
$5b,$4f,$09,$02,$0d,$b0,$3e,$ab,
$1e,$03,$1d,$da,$2f,$be,$03,$d1,
$79,$21,$70,$a0,$f3,$00,$9c,$ee);
ct_ofb : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$77,$89,$50,$8d,$16,$91,$8f,$03,
$f5,$3c,$52,$da,$c5,$4e,$d8,$25,
$97,$40,$05,$1e,$9c,$5f,$ec,$f6,
$43,$44,$f7,$a8,$22,$60,$ed,$cc,
$30,$4c,$65,$28,$f6,$59,$c7,$78,
$66,$a5,$10,$d9,$c1,$d6,$ae,$5e);
var
ct: array[0..63] of byte;
var
Context: TAESContext;
{---------------------------------------------------------------------------}
function test(px,py: pointer): string;
begin
if compmem(px,py,64) then test := 'OK' else test := 'Error';
end;
{---------------------------------------------------------------------------}
procedure TestCFB;
var
i: integer;
pp,pc: pointer;
begin
if AES_CFB_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error CFB');
exit;
end;
pp := @plain;
pc := @ct;
for i:=1 to sizeof(plain) do begin
if AES_CFB_Encrypt(pp, pc, 1, context)<>0 then begin
writeln('*** Error CFB');
exit;
end;
inc(Ptr2Inc(pp));
inc(Ptr2Inc(pc));
end;
writeln('CFB test: ', test(@ct,@ct_cfb));
end;
{---------------------------------------------------------------------------}
procedure TestCFB8;
const
ct_cf8 : array[0..17] of byte = ($3b,$79,$42,$4c,$9c,$0d,$d4,$36,
$ba,$ce,$9e,$0e,$d4,$58,$6a,$4f,
$32,$b9);
var
i: integer;
pp,pc: pointer;
begin
{Note CFB8 is about 16 times slower than CFB. Therefore only}
{the case N=1 is tested using NIST SP 800-38A Test F.3.7}
if AES_CFB8_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error CFB8');
exit;
end;
pp := @plain;
pc := @ct;
for i:=1 to sizeof(plain) do begin
if AES_CFB8_Encrypt(pp, pc, 1, context)<>0 then begin
writeln('*** Error CFB8');
exit;
end;
inc(Ptr2Inc(pp));
inc(Ptr2Inc(pc));
end;
write('CFB8 test: ');
if compmem(@ct,@ct_cf8,sizeof(ct_cf8)) then writeln('OK') else writeln('Error');
end;
{---------------------------------------------------------------------------}
procedure TestCTR;
var
i: integer;
pp,pc: pointer;
begin
if AES_CTR_Init(key128, 128, CTR, context)<>0 then begin
writeln('*** Error CTR');
exit;
end;
pp := @plain;
pc := @ct;
for i:=1 to sizeof(plain) do begin
if AES_CTR_Encrypt(pp, pc, 1, context)<>0 then begin
writeln('*** Error CTR');
exit;
end;
inc(Ptr2Inc(pp));
inc(Ptr2Inc(pc));
end;
writeln('CTR test: ', test(@ct,@ct_ctr));
end;
{---------------------------------------------------------------------------}
procedure TestOFB;
var
i: integer;
pp,pc: pointer;
begin
if AES_OFB_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error OFB');
exit;
end;
pp := @plain;
pc := @ct;
for i:=1 to sizeof(plain) do begin
if AES_OFB_Encrypt(pp, pc, 1, context)<>0 then begin
writeln('*** Error OFB');
exit;
end;
inc(Ptr2Inc(pp));
inc(Ptr2Inc(pc));
end;
writeln('OFB test: ', test(@ct,@ct_ofb));
end;
begin
writeln('Test program "Associativity of CFB,OFB,CTR" (C) 2008 W.Ehrhardt');
AES_SetFastInit(true);
TestCFB;
TestCFB8;
TestCTR;
TestOFB;
end.

377
Tocsg.Lib/VCL/EncLib/AES/t_aes_cs.pas Normal file
View File

@ -0,0 +1,377 @@
{-Test prog for AES CTR Seek, (c) we July 2010}
program T_AES_CS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifdef BIT16}
{$N+,F+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
HRTimer,
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv;
{$else}
AES_Intf;
{$endif}
{$else}
aes_type, aes_ctr;
{$endif}
{USE_INT64: if Int64 and errout available}
{$ifdef FPC}
{$ifdef FPC2Plus}
{$define USE_INT64}
{$endif}
{$endif}
{$ifdef CONDITIONALEXPRESSIONS} {D6+}
{$define USE_INT64}
{$endif}
{---------------------------------------------------------------------------}
procedure My_IncMSBFull(var CTR: TAESBlock);
{$ifdef USEDLL} stdcall; {$endif}
{-Increment CTR[15]..CTR[0]}
var
j: integer;
begin
{This is the same as the standard pre-defined function, but it cannot be }
{recognized by its @address and therefore the seek loop will be performed}
for j:=15 downto 0 do begin
if CTR[j]=$FF then CTR[j] := 0
else begin
inc(CTR[j]);
exit;
end;
end;
end;
var
HR: THRTimer;
var
ctx1, ctx2: TAESContext;
Err : integer;
{$ifdef USE_INT64}
const
BSIZE=$8000;
{$else}
const
BSIZE=8192;
{$endif}
var
pbuf, cbuf1, cbuf2: array[0..BSIZE-1] of byte;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then begin
writeln('Error ',Err);
halt;
end;
end;
{---------------------------------------------------------------------------}
procedure randomtest(userdef: boolean);
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
CTR : TAESBlock = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($87,$4d,$61,$91,$b6,$20,$e3,$26,
$1b,$ef,$68,$64,$99,$0d,$b6,$ce,
$98,$06,$f6,$6b,$79,$70,$fd,$ff,
$86,$17,$18,$7b,$b9,$ff,$fd,$ff,
$5a,$e4,$df,$3e,$db,$d5,$d3,$5e,
$5b,$4f,$09,$02,$0d,$b0,$3e,$ab,
$1e,$03,$1d,$da,$2f,$be,$03,$d1,
$79,$21,$70,$a0,$f3,$00,$9c,$ee);
ct2 : array[0..63] of byte = ($1a,$bc,$93,$24,$17,$52,$1c,$a2,
$4f,$2b,$04,$59,$fe,$7e,$6e,$0b,
$09,$03,$39,$ec,$0a,$a6,$fa,$ef,
$d5,$cc,$c2,$c6,$f4,$ce,$8e,$94,
$1e,$36,$b2,$6b,$d1,$eb,$c6,$70,
$d1,$bd,$1d,$66,$56,$20,$ab,$f7,
$4f,$78,$a7,$f6,$d2,$98,$09,$58,
$5a,$97,$da,$ec,$58,$c6,$b0,$50);
ct3 : array[0..63] of byte = ($60,$1e,$c3,$13,$77,$57,$89,$a5,
$b7,$a7,$f5,$04,$bb,$f3,$d2,$28,
$f4,$43,$e3,$ca,$4d,$62,$b5,$9a,
$ca,$84,$e9,$90,$ca,$ca,$f5,$c5,
$2b,$09,$30,$da,$a2,$3d,$e9,$4c,
$e8,$70,$17,$ba,$2d,$84,$98,$8d,
$df,$c9,$c5,$8d,$b6,$7a,$ad,$a6,
$13,$c2,$dd,$08,$45,$79,$41,$a6);
var
ct: array[0..255] of byte;
SO: integer;
begin
writeln('NIST vector test: 128 bit key');
Err := AES_CTR_Init(key128, 128, CTR, ctx2);
CheckError;
if userdef then begin
Err := AES_SetIncProc({$ifdef FPC_ProcVar}@{$endif}My_IncMSBFull, ctx2);
CheckError;
end;
for SO:=0 to 63 do begin
write('.');
Err := AES_CTR_Seek(CTR, SO, 0, ctx2);
CheckError;
Err := AES_CTR_Encrypt(@plain[SO], @ct[SO], 1, ctx2);
if ct[SO]<>ct1[SO] then begin
writeln('Diff: SO=',SO:2,' ct1[SO]=',ct1[SO]:3,' ct[SO]=',ct[SO]:3);
end;
end;
writeln(' done');
writeln('NIST vector test: 192 bit key');
Err := AES_CTR_Init(key192, 192, CTR, ctx2);
CheckError;
for SO:=0 to 63 do begin
write('.');
{$ifdef USE_INT64}
Err := AES_CTR_Seek64(CTR, SO, ctx2);
{$else}
Err := AES_CTR_Seek(CTR, SO, 0, ctx2);
{$endif}
CheckError;
Err := AES_CTR_Encrypt(@plain[SO], @ct[SO], 1, ctx2);
if ct[SO]<>ct2[SO] then begin
writeln('Diff: SO=',SO:2,' ct2[SO]=',ct2[SO]:3,' ct[SO]=',ct[SO]:3);
end;
end;
writeln(' done');
writeln('NIST vector test: 256 bit key');
Err := AES_CTR_Init(key256, 256, CTR, ctx2);
CheckError;
for SO:=63 downto 0 do begin
write('.');
Err := AES_CTR_Seek(CTR, SO, 0, ctx2);
CheckError;
Err := AES_CTR_Encrypt(@plain[SO], @ct[SO], 1, ctx2);
if ct[SO]<>ct3[SO] then begin
writeln('Diff: SO=',SO:2,' ct3[SO]=',ct2[SO]:3,' ct[SO]=',ct[SO]:3);
end;
end;
writeln(' done');
end;
{---------------------------------------------------------------------------}
procedure bigtest(n: integer);
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
CTR : TAESBlock = ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,
$ff,$ff,$ff,$ff,$fd,$fc,$fb,$fa);
{$ifdef USE_INT64}
var
ofs: int64;
const
oma = int64($3FFFFFFF)*$100; {avoid braindamaged D2 error}
{$else}
var
ofs: longint;
const
oma = $6FFFFFFF;
{$endif}
var
i: integer;
begin
for i:=0 to BSIZE-1 do pbuf[i] := random(256);
Err := AES_CTR_Init(key128, 128, CTR, ctx1);
CheckError;
case n of
1: begin
writeln('IncProc = AES_IncMSBFull, max. offset = ',oma);
{$ifdef USE_INT64}
writeln(erroutput, 'IncProc = AES_IncMSBFull, max. offset = ',oma);
{$endif}
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncMSBFull, ctx1);
{$else}
err := AES_SetIncProc(AES_IncMSBFull, ctx1);
{$endif}
end;
2: begin
writeln('IncProc = AES_IncLSBFull, max. offset = ',oma);
{$ifdef USE_INT64}
writeln(erroutput, 'IncProc = AES_IncLSBFull, max. offset = ',oma);
{$endif}
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncLSBFull, ctx1);
{$else}
err := AES_SetIncProc(AES_IncLSBFull, ctx1);
{$endif}
end;
3: begin
writeln('IncProc = AES_IncMSBPart, max. offset = ',oma);
{$ifdef USE_INT64}
writeln(erroutput, 'IncProc = AES_IncMSBPart, max. offset = ',oma);
{$endif}
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncMSBPart, ctx1);
{$else}
err := AES_SetIncProc(AES_IncMSBPart, ctx1);
{$endif}
end;
4: begin
writeln('IncProc = AES_IncLSBPart, max. offset = ',oma);
{$ifdef USE_INT64}
writeln(erroutput, 'IncProc = AES_IncLSBPart, max. offset = ',oma);
{$endif}
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncLSBPart, ctx1);
{$else}
err := AES_SetIncProc(AES_IncLSBPart, ctx1);
{$endif}
end;
end;
CheckError;
ofs := 0;
ReStartTimer(HR);
repeat
for i:=1 to 99 do begin
Err := AES_CTR_Encrypt(@pbuf, @cbuf1, BSIZE, ctx1);
ofs := ofs + BSIZE;
end;
{$ifdef USE_INT64}
write(erroutput, 100.0*ofs/oma:1:3,'%'#13);
{$else}
write(100.0*ofs/oma:1:3,'%'#13);
{$endif}
Err := AES_CTR_Encrypt(@pbuf, @cbuf1, BSIZE, ctx1);
CheckError;
i := random(BSIZE);
Err := AES_CTR_Init(key128, 128, CTR, ctx2);
CheckError;
case n of
1: begin
(*
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncMSBFull, ctx2);
{$else}
err := AES_SetIncProc(AES_IncMSBFull, ctx2);
{$endif}
*)
end;
2: begin
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncLSBFull, ctx2);
{$else}
err := AES_SetIncProc(AES_IncLSBFull, ctx2);
{$endif}
end;
3: begin
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncMSBPart, ctx2);
{$else}
err := AES_SetIncProc(AES_IncMSBPart, ctx2);
{$endif}
end;
4: begin
{$ifdef FPC_ProcVar}
err := AES_SetIncProc(@AES_IncLSBPart, ctx2);
{$else}
err := AES_SetIncProc(AES_IncLSBPart, ctx2);
{$endif}
end;
else begin
writeln('Invalid n');
halt;
end;
end;
CheckError;
{$ifdef USE_INT64}
Err := AES_CTR_Seek64(CTR, ofs+i, ctx2);
{$else}
Err := AES_CTR_Seek(CTR, ofs+i, 0, ctx2);
{$endif}
CheckError;
Err := AES_CTR_Encrypt(@pbuf[i], @cbuf2[i], 1, ctx2);
CheckError;
if cbuf1[i]<>cbuf2[i] then begin
writeln('Diff: Offset=',ofs+i,' cbuf1[]=',cbuf1[i]:3,' cbuf2[]=',cbuf2[i]:3);
halt;
end;
ofs := ofs + BSIZE;
until ofs>oma;
writeln('Done - no differences.');
writeln('Time [s]: ', ReadSeconds(HR):1:3);
end;
var
{$ifdef D12Plus}
s: string;
{$else}
s: string[10];
{$endif}
begin
writeln('Test program "AES CTR Seek" (C) 2010-2017 W.Ehrhardt');
{$ifdef USEDLL}
writeln('DLL Version: ',AES_DLL_Version);
{$endif}
writeln;
writeln('Test using standard AES_IncMSBFull');
randomtest(false);
writeln;
writeln('Test using user-defines My_IncMSBFull');
randomtest(true);
writeln;
StartTimer(HR);
s := paramstr(1);
if s='big' then begin
bigtest(1);
bigtest(2);
bigtest(3);
bigtest(4);
end;
end.

549
Tocsg.Lib/VCL/EncLib/AES/t_aes_ws.pas Normal file
View File

@ -0,0 +1,549 @@
{-Speed test prog for AES modes, we 2003-2012}
{23.05.2004 we TestOMAC}
{09.07.2006 we TestCMAC}
{22.06.2007 we Selftest AES CMAC PRF-128}
{25.12.2007 we Test CFB8}
{20.07.2008 we EAX All-in-one API}
program T_AES_WS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifdef J_OPT}
{$J+}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
aes_type,aes_base,aes_ctr,aes_cfb,aes_cfb8,aes_ofb,aes_cbc,
aes_ecb,aes_omac,aes_cmac,aes_eax,aes_cprf,
{$endif}
BTypes,mem_util;
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
CTR : TAESBlock = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct_cbc : array[0..63] of byte = ($76,$49,$ab,$ac,$81,$19,$b2,$46,
$ce,$e9,$8e,$9b,$12,$e9,$19,$7d,
$50,$86,$cb,$9b,$50,$72,$19,$ee,
$95,$db,$11,$3a,$91,$76,$78,$b2,
$73,$be,$d6,$b8,$e3,$c1,$74,$3b,
$71,$16,$e6,$9e,$22,$22,$95,$16,
$3f,$f1,$ca,$a1,$68,$1f,$ac,$09,
$12,$0e,$ca,$30,$75,$86,$e1,$a7);
ct_cfb : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$c8,$a6,$45,$37,$a0,$b3,$a9,$3f,
$cd,$e3,$cd,$ad,$9f,$1c,$e5,$8b,
$26,$75,$1f,$67,$a3,$cb,$b1,$40,
$b1,$80,$8c,$f1,$87,$a4,$f4,$df,
$c0,$4b,$05,$35,$7c,$5d,$1c,$0e,
$ea,$c4,$c6,$6f,$9f,$f7,$f2,$e6);
ct_ctr : array[0..63] of byte = ($87,$4d,$61,$91,$b6,$20,$e3,$26,
$1b,$ef,$68,$64,$99,$0d,$b6,$ce,
$98,$06,$f6,$6b,$79,$70,$fd,$ff,
$86,$17,$18,$7b,$b9,$ff,$fd,$ff,
$5a,$e4,$df,$3e,$db,$d5,$d3,$5e,
$5b,$4f,$09,$02,$0d,$b0,$3e,$ab,
$1e,$03,$1d,$da,$2f,$be,$03,$d1,
$79,$21,$70,$a0,$f3,$00,$9c,$ee);
ct_ofb : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$77,$89,$50,$8d,$16,$91,$8f,$03,
$f5,$3c,$52,$da,$c5,$4e,$d8,$25,
$97,$40,$05,$1e,$9c,$5f,$ec,$f6,
$43,$44,$f7,$a8,$22,$60,$ed,$cc,
$30,$4c,$65,$28,$f6,$59,$c7,$78,
$66,$a5,$10,$d9,$c1,$d6,$ae,$5e);
ct_ecb : array[0..63] of byte = ($3a,$d7,$7b,$b4,$0d,$7a,$36,$60,
$a8,$9e,$ca,$f3,$24,$66,$ef,$97,
$f5,$d3,$d5,$85,$03,$b9,$69,$9d,
$e7,$85,$89,$5a,$96,$fd,$ba,$af,
$43,$b1,$cd,$7f,$59,$8e,$ce,$23,
$88,$1b,$00,$e3,$ed,$03,$06,$88,
$7b,$0c,$78,$5e,$27,$e8,$ad,$3f,
$82,$23,$20,$71,$04,$72,$5d,$d4);
tag03 : TAESBlock = ($51,$f0,$be,$bf,$7e,$3b,$9d,$92,$fc,$49,$74,$17,$79,$36,$3c,$fe);
var
ct: array[0..63] of byte;
var
Context: TAESContext;
const
N : longint = 8*1000000; {512MB}
{---------------------------------------------------------------------------}
function test(px,py: pointer): str255;
begin
if compmem(px,py,64) then test := 'OK' else test := 'Error';
end;
{---------------------------------------------------------------------------}
procedure TestCFB;
var
i: longint;
begin
if AES_CFB_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error CFB');
exit;
end;
for i:=1 to N do begin
if AES_CFB_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error CFB');
exit;
end;
end;
if N=1 then begin
writeln('CFB test: ', test(@ct,@ct_cfb));
end;
end;
{---------------------------------------------------------------------------}
procedure TestCFB8;
const
ct_cf8 : array[0..17] of byte = ($3b,$79,$42,$4c,$9c,$0d,$d4,$36,
$ba,$ce,$9e,$0e,$d4,$58,$6a,$4f,
$32,$b9);
begin
{Note CFB8 is about 16 times slower than CFB. Therefore only}
{the case N=1 is tested using NIST SP 800-38A Test F.3.7}
if AES_CFB8_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error CFB8');
exit;
end;
if AES_CFB8_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error CFB8');
exit;
end;
write('CFB8 test: ');
if compmem(@ct,@ct_cf8,sizeof(ct_cf8)) then writeln('OK') else writeln('Error');
end;
{---------------------------------------------------------------------------}
procedure TestCBC;
var
i: longint;
begin
if AES_CBC_Init_Encr(key128, 128, IV, context)<>0 then begin
writeln('*** Error CBC');
exit;
end;
for i:=1 to N do begin
if AES_CBC_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error CBC');
exit;
end;
end;
if N=1 then begin
writeln('CBC test: ', test(@ct,@ct_cbc));
end;
end;
{---------------------------------------------------------------------------}
procedure TestECB;
var
i: longint;
begin
if AES_ECB_Init_Encr(key128, 128, context)<>0 then begin
writeln('*** Error ECB');
exit;
end;
for i:=1 to N do begin
if AES_ECB_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error ECB');
exit;
end;
end;
if N=1 then begin
writeln('ECB test: ', test(@ct,@ct_ECB));
end;
end;
{---------------------------------------------------------------------------}
procedure TestCTR;
var
i: longint;
begin
if AES_CTR_Init(key128, 128, CTR, context)<>0 then begin
writeln('*** Error CTR');
exit;
end;
for i:=1 to N do begin
if AES_CTR_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error CTR');
exit;
end;
end;
if N=1 then begin
writeln('CTR test: ', test(@ct,@ct_ctr));
end;
end;
{---------------------------------------------------------------------------}
procedure TestOFB;
var
i: longint;
begin
if AES_OFB_Init(key128, 128, IV, context)<>0 then begin
writeln('*** Error OFB');
exit;
end;
for i:=1 to N do begin
if AES_OFB_Encrypt(@plain, @ct, sizeof(plain), context)<>0 then begin
writeln('*** Error OFB');
exit;
end;
end;
if N=1 then begin
writeln('OFB test: ', test(@ct,@ct_ofb));
end;
end;
{---------------------------------------------------------------------------}
procedure TestOMAC;
var
i: longint;
tag: TAESBlock;
begin
if AES_OMAC_Init(key128, 128, context)<>0 then begin
writeln('*** Error OMAC Init');
exit;
end;
for i:=1 to N do begin
if AES_OMAC_Update(@plain, 64, context)<>0 then begin
writeln('*** Error OMAC update');
exit;
end;
end;
AES_OMAC_Final(tag, context);
if N=1 then begin
write('OMAC test: ');
if compmem(@tag, @tag03, sizeof(tag)) then writeln('OK') else writeln('Error');
end;
end;
{---------------------------------------------------------------------------}
procedure TestCMAC;
var
i: longint;
tag: TAESBlock;
begin
if AES_CMAC_Init(key128, 128, context)<>0 then begin
writeln('*** Error OMAC Init');
exit;
end;
for i:=1 to N do begin
if AES_CMAC_Update(@plain, 64, context)<>0 then begin
writeln('*** Error CMAC update');
exit;
end;
end;
AES_CMAC_Final(tag, context);
if N=1 then begin
write('CMAC test: ');
if compmem(@tag, @tag03, sizeof(tag)) then writeln('OK') else writeln('Error');
end;
end;
{---------------------------------------------------------------------------}
procedure TestEAX;
const
{Test vector from Tom St Denis}
hex32: array[1..32] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
tag00: array[1..16] of byte = ($9a, $d0, $7e, $7d, $bf, $f3, $01, $f5,
$05, $de, $59, $6b, $96, $15, $df, $ff);
tag01: array[1..16] of byte = ($1c, $e1, $0d, $3e, $ff, $d4, $ca, $db,
$e2, $e4, $4b, $58, $d6, $0a, $b9, $ec);
tag02: array[1..16] of byte = ($3a, $69, $8f, $7a, $27, $0e, $51, $b0,
$f6, $5b, $3d, $3e, $47, $19, $3c, $ff);
ct03 : array[1..32] of byte = ($29, $d8, $78, $d1, $a3, $be, $85, $7b,
$6f, $b8, $c8, $ea, $59, $50, $a7, $78,
$33, $1f, $bf, $2c, $cf, $33, $98, $6f,
$35, $e8, $cf, $12, $1d, $cb, $30, $bc);
tag03: array[1..16] of byte = ($4f, $be, $03, $38, $be, $1c, $8c, $7e,
$1d, $7a, $e7, $e4, $5b, $92, $c5, $87);
ct04: array[1..29] of byte = ($dd, $25, $c7, $54, $c5, $b1, $7c, $59,
$28, $b6, $9b, $73, $15, $5f, $7b, $b8,
$88, $8f, $af, $37, $09, $1a, $d9, $2c,
$8a, $24, $db, $86, $8b);
tag04: array[1..16] of byte = ($0d, $1a, $14, $e5, $22, $24, $ff, $d2,
$3a, $05, $fa, $02, $cd, $ef, $52, $da);
{Test vectors from <http://eprint.iacr.org/2003/069> App. E,}
{reproduced by Brian Gladman, ctx is split into ctxx and tagxx}
key05: array[1..16] of byte = ($23, $39, $52, $de, $e4, $d5, $ed, $5f,
$9b, $9c, $6d, $6f, $f8, $0f, $f4, $78);
non05: array[1..16] of byte = ($62, $ec, $67, $f9, $c3, $a4, $a4, $07,
$fc, $b2, $a8, $c4, $90, $31, $a8, $b3);
hdr05: array[1..08] of byte = ($6b, $fb, $91, $4f, $d0, $7e, $ae, $6b);
tag05: array[1..16] of byte = ($e0, $37, $83, $0e, $83, $89, $f2, $7b,
$02, $5a, $2d, $65, $27, $e7, $9d, $01);
pt06 : array[1..02] of byte = ($f7, $fb);
key06: array[1..16] of byte = ($91, $94, $5d, $3f, $4d, $cb, $ee, $0b,
$f4, $5e, $f5, $22, $55, $f0, $95, $a4);
non06: array[1..16] of byte = ($be, $ca, $f0, $43, $b0, $a2, $3d, $84,
$31, $94, $ba, $97, $2c, $66, $de, $bd);
hdr06: array[1..08] of byte = ($fa, $3b, $fd, $48, $06, $eb, $53, $fa);
ct06 : array[1..02] of byte = ($19, $dd);
tag06: array[1..16] of byte = ($5c, $4c, $93, $31, $04, $9d, $0b, $da,
$b0, $27, $74, $08, $f6, $79, $67, $e5);
pt07 : array[1..05] of byte = ($1a, $47, $cb, $49, $33);
key07: array[1..16] of byte = ($01, $f7, $4a, $d6, $40, $77, $f2, $e7,
$04, $c0, $f6, $0a, $da, $3d, $d5, $23);
non07: array[1..16] of byte = ($70, $c3, $db, $4f, $0d, $26, $36, $84,
$00, $a1, $0e, $d0, $5d, $2b, $ff, $5e);
hdr07: array[1..08] of byte = ($23, $4a, $34, $63, $c1, $26, $4a, $c6);
ct07 : array[1..05] of byte = ($d8, $51, $d5, $ba, $e0);
tag07: array[1..16] of byte = ($3a, $59, $f2, $38, $a2, $3e, $39, $19,
$9d, $c9, $26, $66, $26, $c4, $0f, $80);
pt08 : array[1..05] of byte = ($48, $1c, $9e, $39, $b1);
key08: array[1..16] of byte = ($d0, $7c, $f6, $cb, $b7, $f3, $13, $bd,
$de, $66, $b7, $27, $af, $d3, $c5, $e8);
non08: array[1..16] of byte = ($84, $08, $df, $ff, $3c, $1a, $2b, $12,
$92, $dc, $19, $9e, $46, $b7, $d6, $17);
hdr08: array[1..08] of byte = ($33, $cc, $e2, $ea, $bf, $f5, $a7, $9d);
ct08 : array[1..05] of byte = ($63, $2a, $9d, $13, $1a);
tag08: array[1..16] of byte = ($d4, $c1, $68, $a4, $22, $5d, $8e, $1f,
$f7, $55, $93, $99, $74, $a7, $be, $de);
pt09 : array[1..06] of byte = ($40, $d0, $c0, $7d, $a5, $e4);
key09: array[1..16] of byte = ($35, $b6, $d0, $58, $00, $05, $bb, $c1,
$2b, $05, $87, $12, $45, $57, $d2, $c2);
non09: array[1..16] of byte = ($fd, $b6, $b0, $66, $76, $ee, $dc, $5c,
$61, $d7, $42, $76, $e1, $f8, $e8, $16);
hdr09: array[1..08] of byte = ($ae, $b9, $6e, $ae, $be, $29, $70, $e9);
ct09 : array[1..06] of byte = ($07, $1d, $fe, $16, $c6, $75);
tag09: array[1..16] of byte = ($cb, $06, $77, $e5, $36, $f7, $3a, $fe,
$6a, $14, $b7, $4e, $e4, $98, $44, $dd);
pt10 : array[1..12] of byte = ($4d, $e3, $b3, $5c, $3f, $c0, $39, $24,
$5b, $d1, $fb, $7d);
key10: array[1..16] of byte = ($bd, $8e, $6e, $11, $47, $5e, $60, $b2,
$68, $78, $4c, $38, $c6, $2f, $eb, $22);
non10: array[1..16] of byte = ($6e, $ac, $5c, $93, $07, $2d, $8e, $85,
$13, $f7, $50, $93, $5e, $46, $da, $1b);
hdr10: array[1..08] of byte = ($d4, $48, $2d, $1c, $a7, $8d, $ce, $0f);
ct10 : array[1..12] of byte = ($83, $5b, $b4, $f1, $5d, $74, $3e, $35,
$0e, $72, $84, $14);
tag10: array[1..16] of byte = ($ab, $b8, $64, $4f, $d6, $cc, $b8, $69,
$47, $c5, $e1, $05, $90, $21, $0a, $4f);
pt11 : array[1..17] of byte = ($8b, $0a, $79, $30, $6c, $9c, $e7, $ed,
$99, $da, $e4, $f8, $7f, $8d, $d6, $16, $36);
key11: array[1..16] of byte = ($7c, $77, $d6, $e8, $13, $be, $d5, $ac,
$98, $ba, $a4, $17, $47, $7a, $2e, $7d);
non11: array[1..16] of byte = ($1a, $8c, $98, $dc, $d7, $3d, $38, $39,
$3b, $2b, $f1, $56, $9d, $ee, $fc, $19);
hdr11: array[1..08] of byte = ($65, $d2, $01, $79, $90, $d6, $25, $28);
ct11 : array[1..17] of byte = ($02, $08, $3e, $39, $79, $da, $01, $48,
$12, $f5, $9f, $11, $d5, $26, $30, $da, $30);
tag11: array[1..16] of byte = ($13, $73, $27, $d1, $06, $49, $b0, $aa,
$6e, $1c, $18, $1d, $b6, $17, $d7, $f2);
pt12 : array[1..18] of byte = ($1b, $da, $12, $2b, $ce, $8a, $8d, $ba,
$f1, $87, $7d, $96, $2b, $85, $92, $dd, $2d, $56);
key12: array[1..16] of byte = ($5f, $ff, $20, $ca, $fa, $b1, $19, $ca,
$2f, $c7, $35, $49, $e2, $0f, $5b, $0d);
non12: array[1..16] of byte = ($dd, $e5, $9b, $97, $d7, $22, $15, $6d,
$4d, $9a, $ff, $2b, $c7, $55, $98, $26);
hdr12: array[1..08] of byte = ($54, $b9, $f0, $4e, $6a, $09, $18, $9a);
ct12 : array[1..18] of byte = ($2e, $c4, $7b, $2c, $49, $54, $a4, $89,
$af, $c7, $ba, $48, $97, $ed, $cd, $ae, $8c, $c3);
tag12: array[1..16] of byte = ($3b, $60, $45, $05, $99, $bd, $02, $c9,
$63, $82, $90, $2a, $ef, $7f, $83, $2a);
pt13 : array[1..18] of byte = ($6c, $f3, $67, $20, $87, $2b, $85, $13,
$f6, $ea, $b1, $a8, $a4, $44, $38, $d5, $ef, $11);
key13: array[1..16] of byte = ($a4, $a4, $78, $2b, $cf, $fd, $3e, $c5,
$e7, $ef, $6d, $8c, $34, $a5, $61, $23);
non13: array[1..16] of byte = ($b7, $81, $fc, $f2, $f7, $5f, $a5, $a8,
$de, $97, $a9, $ca, $48, $e5, $22, $ec);
hdr13: array[1..08] of byte = ($89, $9a, $17, $58, $97, $56, $1d, $7e);
ct13 : array[1..18] of byte = ($0d, $e1, $8f, $d0, $fd, $d9, $1e, $7a,
$f1, $9f, $1d, $8e, $e8, $73, $39, $38, $b1, $e8);
tag13: array[1..16] of byte = ($e7, $f6, $d2, $23, $16, $18, $10, $2f,
$db, $7f, $e5, $5f, $f1, $99, $17, $00);
pt14 : array[1..21] of byte = ($ca, $40, $d7, $44, $6e, $54, $5f, $fa,
$ed, $3b, $d1, $2a, $74, $0a, $65, $9f,
$fb, $bb, $3c, $ea, $b7);
key14: array[1..16] of byte = ($83, $95, $fc, $f1, $e9, $5b, $eb, $d6,
$97, $bd, $01, $0b, $c7, $66, $aa, $c3);
non14: array[1..16] of byte = ($22, $e7, $ad, $d9, $3c, $fc, $63, $93,
$c5, $7e, $c0, $b3, $c1, $7d, $6b, $44);
hdr14: array[1..08] of byte = ($12, $67, $35, $fc, $c3, $20, $d2, $5a);
ct14 : array[1..21] of byte = ($cb, $89, $20, $f8, $7a, $6c, $75, $cf,
$f3, $96, $27, $b5, $6e, $3e, $d1, $97,
$c5, $52, $d2, $95, $a7);
tag14: array[1..16] of byte = ($cf, $c4, $6a, $fc, $25, $3b, $46, $52,
$b1, $af, $37, $95, $b1, $24, $ab, $6e);
function test(var key, hdr, nonce, pt, tct, ttag; nlen, hlen, plen: word): boolean;
var
ctx: TAES_EAXContext;
tag: TAESBlock;
buf: array[0..63] of byte;
begin
test := false;
{Incremental API}
{encrypt}
if AES_EAX_Init(Key, 128, nonce, nlen, ctx)<>0 then exit;
if AES_EAX_Provide_Header(@hdr,hLen,ctx)<>0 then exit;
if AES_EAX_Encrypt(@pt, @buf, plen, ctx)<>0 then exit;
AES_EAX_Final(tag, ctx);
if not compmem(@buf,@tct,plen) then exit;
if not compmem(@tag,@ttag,sizeof(tag)) then exit;
{decrypt}
if AES_EAX_Init(Key, 128, nonce, nlen, ctx)<>0 then exit;
if AES_EAX_Provide_Header(@hdr,hLen,ctx)<>0 then exit;
if AES_EAX_Decrypt(@tct, @buf, plen, ctx)<>0 then exit;
AES_EAX_Final(tag, ctx);
if not compmem(@buf,@pt,plen) then exit;
if not compmem(@tag,@ttag,sizeof(tag)) then exit;
{All-in-one API}
{encrypt}
if AES_EAX_Enc_Auth(tag,Key,128,nonce,nlen,@hdr,hLen, @pt,plen, @buf)<>0 then exit;
if not compmem(@buf,@tct,plen) then exit;
if not compmem(@tag,@ttag,sizeof(tag)) then exit;
{decrypt}
{adjust test procedure if taglen <> 16!!!}
if AES_EAX_Dec_Veri(@ttag,16,key,128,nonce,nlen,@hdr,hLen,@tct,plen,@buf)<>0 then exit;
{tag is OK, otherwise AES_Err_EAX_Verify_Tag would have been returned}
if not compmem(@buf,@pt,plen) then exit;
test := true;
end;
var
OK: boolean;
begin
OK := true;
write('EAX test: ');
if OK then OK := Test(hex32, hex32, hex32, hex32, hex32, tag00, 0, 0, 0);
if OK then OK := Test(hex32, hex32, hex32, hex32, hex32, tag01, 16, 0, 0);
if OK then OK := Test(hex32, hex32, hex32, hex32, hex32, tag02, 0, 16, 0);
if OK then OK := Test(hex32, hex32, hex32, hex32, ct03, tag03, 16, 16, 32);
if OK then OK := Test(hex32, hex32, hex32, hex32, ct04, tag04, 15, 14, 29);
if OK then OK := Test(key05, hdr05, non05, hex32, hex32, tag05, 16, 08, 0);
if OK then OK := Test(key06, hdr06, non06, pt06, ct06, tag06, 16, 08, 2);
if OK then OK := Test(key07, hdr07, non07, pt07, ct07, tag07, 16, 08, 5);
if OK then OK := Test(key08, hdr08, non08, pt08, ct08, tag08, 16, 08, 5);
if OK then OK := Test(key09, hdr09, non09, pt09, ct09, tag09, 16, 08, 6);
if OK then OK := Test(key10, hdr10, non10, pt10, ct10, tag10, 16, 08, 12);
if OK then OK := Test(key11, hdr11, non11, pt11, ct11, tag11, 16, 08, 17);
if OK then OK := Test(key12, hdr12, non12, pt12, ct12, tag12, 16, 08, 18);
if OK then OK := Test(key13, hdr13, non13, pt13, ct13, tag13, 16, 08, 18);
if OK then OK := Test(key14, hdr14, non14, pt14, ct14, tag14, 16, 08, 21);
if OK then writeln('OK') else writeln('Error');
end;
var
{$ifdef D12Plus}
s: string;
{$else}
s: string[10];
{$endif}
i: integer;
begin
AES_SetFastInit(true);
{$ifdef USEDLL}
writeln('Test program for AES_DLL V',AES_DLL_Version,' (C) 2004-2012 W.Ehrhardt');
{$else}
{$ifdef AES_ComprTab}
writeln('Test program for AES functions [compressed tables] (C) 2004-2012 W.Ehrhardt');
{$else}
writeln('Test program for AES functions [full tables] (C) 2004-2012 W.Ehrhardt');
{$endif}
{$endif}
s := paramstr(1);
for i:=1 to length(s) do s[i] := upcase(s[i]);
if s='TEST' then begin
N := 1;
writeln('Selftest AES CMAC PRF-128: ', AES_CPRF128_selftest);
TestCBC;
TestCFB;
TestCFB8;
TestCTR;
TestECB;
TestOFB;
TestOMAC;
TestCMAC;
TestEAX;
writeln;
end
else if s='CBC' then TestCBC
else if s='CFB' then TestCFB
else if s='CTR' then TestCTR
else if s='ECB' then TestECB
else if s='OFB' then TestOFB
else if s='OMAC' then TestOMAC
else if s='CMAC' then TestCMAC
else begin
writeln('Usage: T_AES_WS [ TEST | CBC | CFB | CTR | ECB | OFB | OMAC | CMAC ]');
halt;
end;
end.

306
Tocsg.Lib/VCL/EncLib/AES/t_aes_xl.pas Normal file
View File

@ -0,0 +1,306 @@
{-Test prog for AES modes, ILen > $FFFF for 32 bit, we July 2010}
program T_AES_XL;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
AES_Type, AES_CTR, AES_CFB, AES_CFB8, AES_OFB, AES_CBC, AES_ECB, AES_OMAC, AES_EAX,
{$endif}
BTypes, mem_util;
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
IV : array[0..15] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
CTR : array[0..15] of byte = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
{$ifndef BIT16}
const BSIZE=400000;
{$else}
const BSIZE=10000;
{$endif}
const
BS1 = AESBLKSIZE*(BSIZE div (2*AESBLKSIZE));
type
TBuf = array[0..BSIZE-1] of byte;
var
pt, ct, dt: Tbuf;
var
Context: TAESContext;
{---------------------------------------------------------------------------}
function test(px,py: pointer): Str255;
begin
if compmemxl(px,py,sizeof(TBuf)) then test := 'OK' else test := 'Error';
end;
{---------------------------------------------------------------------------}
procedure TestCFB;
begin
fillchar(dt,sizeof(dt),0);
if AES_CFB_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CFB_Init');
exit;
end;
if AES_CFB_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error CFB_Encrypt 1');
exit;
end;
if AES_CFB_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error CFB_Encrypt 2');
exit;
end;
if AES_CFB_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CFB_Init');
exit;
end;
if AES_CFB_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error CFB_Decrypt');
exit;
end;
writeln('CFB test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestCFB8;
begin
fillchar(dt,sizeof(dt),0);
if AES_CFB8_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CFB8_Init');
exit;
end;
if AES_CFB8_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error CFB8_Encrypt 1');
exit;
end;
if AES_CFB8_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error CFB8_Encrypt 2');
exit;
end;
if AES_CFB8_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CFB8_Init');
exit;
end;
if AES_CFB8_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error CFB8_Decrypt');
exit;
end;
writeln('CFB8 test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestCBC;
begin
fillchar(dt,sizeof(dt),0);
if AES_CBC_Init_Encr(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CBC_Init_Encr');
exit;
end;
if AES_CBC_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error CBC_Encrypt 1');
exit;
end;
if AES_CBC_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error CBC_Encrypt 2');
exit;
end;
if AES_CBC_Init_Decr(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error CBC_Init_Decr');
exit;
end;
if AES_CBC_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error CBC_Decrypt');
exit;
end;
writeln('CBC test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestECB;
begin
fillchar(dt,sizeof(dt),0);
if AES_ECB_Init_Encr(key128, 8*sizeof(key128), context)<>0 then begin
writeln('*** Error ECB_Init_Encr');
exit;
end;
if AES_ECB_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error ECB_Encrypt 1');
exit;
end;
if AES_ECB_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error ECB_Encrypt 2');
exit;
end;
if AES_ECB_Init_Decr(key128, 8*sizeof(key128), context)<>0 then begin
writeln('*** Error ECB_Init_Decr');
exit;
end;
if AES_ECB_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error ECB_Decrypt');
exit;
end;
writeln('ECB test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestCTR;
begin
fillchar(dt,sizeof(dt),0);
if AES_CTR_Init(key128, 8*sizeof(key128), TAESBlock(CTR), context)<>0 then begin
writeln('*** Error CTR_Init');
exit;
end;
if AES_CTR_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error CTR_Encrypt 1');
exit;
end;
if AES_CTR_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error CTR_Encrypt 2');
exit;
end;
if AES_CTR_Init(key128, 8*sizeof(key128), TAESBlock(CTR), context)<>0 then begin
writeln('*** Error CTR_Init');
exit;
end;
if AES_CTR_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error CTR_Decrypt');
exit;
end;
writeln('CTR test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestOFB;
begin
fillchar(dt,sizeof(dt),0);
if AES_OFB_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error OFB_Init');
exit;
end;
if AES_OFB_Encrypt(@pt, @ct, BS1, context)<>0 then begin
writeln('*** Error OFB_Encrypt 1');
exit;
end;
if AES_OFB_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, context)<>0 then begin
writeln('*** Error OFB_Encrypt 2');
exit;
end;
if AES_OFB_Init(key128, 8*sizeof(key128), TAESBlock(IV), context)<>0 then begin
writeln('*** Error OFB_Init');
exit;
end;
if AES_OFB_Decrypt(@ct, @dt, sizeof(TBuf), context)<>0 then begin
writeln('*** Error OFB_Decrypt');
exit;
end;
writeln('OFB test: ', test(@pt,@dt));
end;
{---------------------------------------------------------------------------}
procedure TestEAX;
const
hex32: array[1..32] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b,$1c,$1d,$1e,$1f);
var
ctx: TAES_EAXContext;
te,td: TAESBlock;
begin
fillchar(dt,sizeof(dt),0);
if AES_EAX_Init(key128, 128, hex32, sizeof(hex32), ctx) <>0 then begin
writeln('*** Error EAX_Init');
exit;
end;
if AES_EAX_Provide_Header(@hex32, sizeof(hex32),ctx) <>0 then begin
writeln('*** Error EAX_Provide_Header');
exit;
end;
if AES_EAX_Encrypt(@pt, @ct, BS1, ctx) <>0 then begin
writeln('*** Error EAX_Encrypt 1');
exit;
end;
if AES_EAX_Encrypt(@pt[BS1], @ct[BS1], sizeof(TBuf)-BS1, ctx) <>0 then begin
writeln('*** Error EAX_Encrypt 2');
exit;
end;
AES_EAX_Final(te, ctx);
if AES_EAX_Init(key128, 128, hex32, sizeof(hex32), ctx) <>0 then begin
writeln('*** Error EAX_Init');
exit;
end;
if AES_EAX_Provide_Header(@hex32, sizeof(hex32),ctx) <>0 then begin
writeln('*** Error EAX_Provide_Header');
exit;
end;
if AES_EAX_Decrypt(@ct, @dt, sizeof(TBuf), ctx) <>0 then begin
writeln('*** Error EAX_Encrypt');
exit;
end;
AES_EAX_Final(td, ctx);
if not compmemxl(@pt, @dt, sizeof(TBuf)) then begin
writeln('*** Dec EAX diff buf');
exit;
end;
if not compmem(@te, @td, sizeof(td)) then begin
writeln('*** Dec EAX diff tag');
exit;
end;
write('EAX test: OK');
end;
begin
{$ifdef USEDLL}
writeln('Test program for AES_DLL V',AES_DLL_Version,' (C) 2010 W.Ehrhardt');
{$else}
writeln('Test program for AES modes (C) 2010 W.Ehrhardt');
{$endif}
writeln('Test of encrypt/decrypt routines using single calls with ',BS1,'/',BSize, ' bytes.');
RandMemXL(@pt, sizeof(TBuf));
TestCBC;
TestCFB;
TestCFB8;
TestCTR;
TestECB;
TestOFB;
TestEAX;
writeln;
end.

218
Tocsg.Lib/VCL/EncLib/AES/t_aescbc.pas Normal file
View File

@ -0,0 +1,218 @@
{-Test prog for AES CBC, we Sep.2003}
program T_AESCBC;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_cbc, mem_util, BTypes;
var
Context: TAESContext;
Err: integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-CBC mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample for AES CBC mode'#0;
var
i : integer;
ct, pt, plain: array[1..length(sample)] of char8;
IV : TAESBlock;
procedure CheckRes;
begin
writeln('Test Dec(Enc)=Id: ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
for i:=0 to 15 do IV[i] := random(256);
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-CBC mode');
writeln('Plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_CBC_Init_Encr(key128, 128, IV, context);
Err := AES_CBC_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_CBC_Init_Decr(key128, 128, IV, context);
Err := AES_CBC_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/Dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_CBC_Init_Decr(key128, 128, IV, context);
Err := AES_CBC_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_CBC_Init_Encr(key192, 192, IV, context);
Err := AES_CBC_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_CBC_Init_Decr(key192, 192, IV, context);
Err := AES_CBC_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_CBC_Init_Decr(key192, 192, IV, context);
Err := AES_CBC_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_CBC_Init_Encr(key256, 256, IV, context);
Err := AES_CBC_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_CBC_Init_Decr(key256, 256, IV, context);
Err := AES_CBC_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_CBC_Init_Decr(key256, 256, IV, context);
Err := AES_CBC_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A CBC/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($76,$49,$ab,$ac,$81,$19,$b2,$46,
$ce,$e9,$8e,$9b,$12,$e9,$19,$7d,
$50,$86,$cb,$9b,$50,$72,$19,$ee,
$95,$db,$11,$3a,$91,$76,$78,$b2,
$73,$be,$d6,$b8,$e3,$c1,$74,$3b,
$71,$16,$e6,$9e,$22,$22,$95,$16,
$3f,$f1,$ca,$a1,$68,$1f,$ac,$09,
$12,$0e,$ca,$30,$75,$86,$e1,$a7);
ct2 : array[0..63] of byte = ($4f,$02,$1d,$b2,$43,$bc,$63,$3d,
$71,$78,$18,$3a,$9f,$a0,$71,$e8,
$b4,$d9,$ad,$a9,$ad,$7d,$ed,$f4,
$e5,$e7,$38,$76,$3f,$69,$14,$5a,
$57,$1b,$24,$20,$12,$fb,$7a,$e0,
$7f,$a9,$ba,$ac,$3d,$f1,$02,$e0,
$08,$b0,$e2,$79,$88,$59,$88,$81,
$d9,$20,$a9,$e6,$4f,$56,$15,$cd);
ct3 : array[0..63] of byte = ($f5,$8c,$4c,$04,$d6,$e5,$f1,$ba,
$77,$9e,$ab,$fb,$5f,$7b,$fb,$d6,
$9c,$fc,$4e,$96,$7e,$db,$80,$8d,
$67,$9f,$77,$7b,$c6,$70,$2c,$7d,
$39,$f2,$33,$69,$a9,$d9,$ba,$cf,
$a5,$30,$e2,$63,$04,$23,$14,$61,
$b2,$eb,$05,$e2,$c3,$9b,$e9,$fc,
$da,$6c,$19,$07,$8c,$6a,$9d,$1b);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A CBC/AES tests');
Err := AES_CBC_Init_Encr(key128, 128, IV, context);
Err := AES_CBC_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.2.1 CBC-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_CBC_Init_Decr(key128, 128, IV, context);
Err := AES_CBC_Decrypt(@ct{1}, @ct, sizeof(ct1), context);
CheckError;
writeln('Test F.2.2 CBC-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CBC_Init_Encr(key192, 192, IV, context);
Err := AES_CBC_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.2.3 CBC-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_CBC_Init_Decr(key192, 192, IV, context);
Err := AES_CBC_Decrypt(@ct{2}, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.2.4 CBC-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CBC_Init_Encr(key256, 256, IV, context);
Err := AES_CBC_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.2.5 CBC-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_CBC_Init_Decr(key256, 256, IV, context);
Err := AES_CBC_Decrypt(@ct{3}, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.2.6 CBC-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

308
Tocsg.Lib/VCL/EncLib/AES/t_aesccm.pas Normal file
View File

@ -0,0 +1,308 @@
{-Test program for CCM, (c) we 05.2009}
program T_AESCCM;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
AES_Type, AES_Encr, AES_CCM,
{$endif}
mem_util;
{---------------------------------------------------------------------------}
procedure Simple_Tests;
{-Two tests from RFC one from NIST}
const
key1: array[0..15] of byte = ($C0,$C1,$C2,$C3,$C4,$C5,$C6,$C7,$C8,$C9,$CA,$CB,$CC,$CD,$CE,$CF);
iv1 : array[0..12] of byte = ($00,$00,$00,$03,$02,$01,$00,$A0,$A1,$A2,$A3,$A4,$A5);
hdr1: array[0..07] of byte = ($00,$01,$02,$03,$04,$05,$06,$07);
pt1 : array[0..22] of byte = ($08,$09,$0A,$0B,$0C,$0D,$0E,$0F,
$10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1A,$1B,$1C,$1D,$1E);
ct1 : array[0..22] of byte = ($58,$8C,$97,$9A,$61,$C6,$63,$D2,
$F0,$66,$D0,$C2,$C0,$F9,$89,$80,
$6D,$5F,$6B,$61,$DA,$C3,$84);
tag1: array[0..07] of byte = ($17,$e8,$d1,$2c,$fd,$f9,$26,$e0);
const
key2: array[0..15] of byte = ($C0,$C1,$C2,$C3,$C4,$C5,$C6,$C7,$C8,$C9,$CA,$CB,$CC,$CD,$CE,$CF);
iv2 : array[0..12] of byte = ($00,$00,$00,$06,$05,$04,$03,$A0,$A1,$A2,$A3,$A4,$A5);
hdr2: array[0..11] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B);
pt2 : array[0..18] of byte = ($0C,$0D,$0E,$0F,$10,$11,$12,$13,
$14,$15,$16,$17,$18,$19,$1A,$1B,
$1C,$1D,$1E);
ct2 : array[0..18] of byte = ($A2,$8C,$68,$65,$93,$9A,$9A,$79,
$FA,$AA,$5C,$4C,$2A,$9D,$4A,$91,
$CD,$AC,$8C);
tag2: array[0..07] of byte = ($96,$C8,$61,$B9,$C9,$E6,$1E,$F1);
const
key3: array[0..15] of byte = ($40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f);
iv3 : array[0..06] of byte = ($10,$11,$12,$13,$14,$15,$16);
hdr3: array[0..07] of byte = ($00,$01,$02,$03,$04,$05,$06,$07);
pt3 : array[0..03] of byte = ($20,$21,$22,$23);
ct3 : array[0..03] of byte = ($71,$62,$01,$5b);
tag3: array[0..03] of byte = ($4d,$ac,$25,$5d);
var
ccm_ctx: TAESContext;
var
tag: TAESBlock;
buf: array[0..63] of byte;
err: integer;
begin
{-----------------------------------------------------------------}
writeln('Test 1: Ex functions');
err := AES_Init_Encr(Key1, 8*sizeof(key1), ccm_ctx);
if err=0 then err := AES_CCM_Enc_AuthEx(ccm_ctx, tag, sizeof(tag1),
iv1, sizeof(iv1), @hdr1, sizeof(hdr1),
@pt1, sizeof(pt1), @buf);
if err<>0 then writeln('Err1: ', err)
else begin
writeln(' CT1: ', compmem(@buf, @ct1, sizeof(ct1)));
writeln('Tag1: ', compmem(@tag, @tag1, sizeof(tag1)));
end;
err := AES_CCM_Dec_VeriEx(ccm_ctx, @tag1, sizeof(tag1),
iv1, sizeof(iv1), @hdr1, sizeof(hdr1),
@ct1, sizeof(ct1), @buf);
if err<>0 then writeln('Err1: ', err)
else begin
writeln(' PT1: ', compmem(@buf, @pt1, sizeof(pt1)));
end;
writeln('Test 1: simple functions');
err := AES_CCM_Enc_Auth(tag, sizeof(tag1), key1, sizeof(key1),
iv1, sizeof(iv1), @hdr1, sizeof(hdr1),
@pt1, sizeof(pt1), @buf);
if err<>0 then writeln('Err1: ', err)
else begin
writeln(' CT1: ', compmem(@buf, @ct1, sizeof(ct1)));
writeln('Tag1: ', compmem(@tag, @tag1, sizeof(tag1)));
end;
err := AES_CCM_Dec_Veri(@tag1, sizeof(tag1), key1, sizeof(key1),
iv1, sizeof(iv1), @hdr1, sizeof(hdr1),
@ct1, sizeof(ct1), @buf);
if err<>0 then writeln('Err1: ', err)
else begin
writeln(' PT1: ', compmem(@buf, @pt1, sizeof(pt1)));
end;
{-----------------------------------------------------------------}
writeln('Test 2: Ex functions');
err := AES_Init_Encr(Key2, 8*sizeof(key2), ccm_ctx);
if err=0 then err := AES_CCM_Enc_AuthEx(ccm_ctx, tag, sizeof(tag2),
iv2, sizeof(iv2), @hdr2, sizeof(hdr2),
@pt2, sizeof(pt2), @buf);
if err<>0 then writeln('Err2: ', err)
else begin
writeln(' CT2: ', compmem(@buf, @ct2, sizeof(ct2)));
writeln('Tag2: ', compmem(@tag, @tag2, sizeof(tag2)));
end;
err := AES_CCM_Dec_VeriEx(ccm_ctx, @tag2, sizeof(tag2),
iv2, sizeof(iv2), @hdr2, sizeof(hdr2),
@ct2, sizeof(ct2), @buf);
if err<>0 then writeln('Err2: ', err)
else begin
writeln(' PT2: ', compmem(@buf, @pt2, sizeof(pt2)));
end;
writeln('Test 2: simple functions');
err := AES_CCM_Enc_Auth(tag, sizeof(tag2), key2, sizeof(key2),
iv2, sizeof(iv2), @hdr2, sizeof(hdr2),
@pt2, sizeof(pt2), @buf);
if err<>0 then writeln('Err2: ', err)
else begin
writeln(' CT2: ', compmem(@buf, @ct2, sizeof(ct2)));
writeln('Tag2: ', compmem(@tag, @tag2, sizeof(tag2)));
end;
err := AES_CCM_Dec_Veri(@tag2, sizeof(tag2), key2, sizeof(key2),
iv2, sizeof(iv2), @hdr2, sizeof(hdr2),
@ct2, sizeof(ct2), @buf);
if err<>0 then writeln('Err2: ', err)
else begin
writeln(' PT2: ', compmem(@buf, @pt2, sizeof(pt2)));
end;
{-----------------------------------------------------------------}
writeln('Test 3: Ex functions');
err := AES_Init_Encr(Key3, 8*sizeof(key3), ccm_ctx);
if err=0 then err := AES_CCM_Enc_AuthEx(ccm_ctx, tag, sizeof(tag3),
iv3, sizeof(iv3), @hdr3, sizeof(hdr3),
@pt3, sizeof(pt3), @buf);
if err<>0 then writeln('Err3: ', err)
else begin
writeln(' CT3: ', compmem(@buf, @ct3, sizeof(ct3)));
writeln('Tag3: ', compmem(@tag, @tag3, sizeof(tag3)));
end;
err := AES_CCM_Dec_VeriEx(ccm_ctx, @tag3, sizeof(tag3),
iv3, sizeof(iv3), @hdr3, sizeof(hdr3),
@ct3, sizeof(ct3), @buf);
if err<>0 then writeln('Err3: ', err)
else begin
writeln(' PT3: ', compmem(@buf, @pt3, sizeof(pt3)));
end;
writeln('Test 3: simple functions');
err := AES_CCM_Enc_Auth(tag, sizeof(tag3), key3, sizeof(key3),
iv3, sizeof(iv3), @hdr3, sizeof(hdr3),
@pt3, sizeof(pt3), @buf);
if err<>0 then writeln('Err3: ', err)
else begin
writeln(' CT3: ', compmem(@buf, @ct3, sizeof(ct3)));
writeln('Tag3: ', compmem(@tag, @tag3, sizeof(tag3)));
end;
err := AES_CCM_Dec_Veri(@tag3, sizeof(tag3), key3, sizeof(key3),
iv3, sizeof(iv3), @hdr3, sizeof(hdr3),
@ct3, sizeof(ct3), @buf);
if err<>0 then writeln('Err3: ', err)
else begin
writeln(' PT3: ', compmem(@buf, @pt3, sizeof(pt3)));
end;
end;
{---------------------------------------------------------------------------}
procedure LTC_Test(print: boolean);
{-reproduce LTC CCM-AES test vectors}
var
key, nonce, tag: TAESBlock;
buf: array[0..63] of byte;
i,k,err: integer;
const
final: TAESBlock = ($0f,$5a,$69,$f5,$2a,$a8,$d8,$50,$8d,$09,$e6,$42,$51,$1e,$54,$e5);
begin
writeln('LibTomCrypt CCM-AES test');
HexUpper := true;
for i:=0 to 15 do key[i] := i and $FF;
nonce := key;
for k:=0 to 32 do begin
for i:=0 to k-1 do buf[i] := i and $FF;
err := AES_CCM_Enc_Auth(tag, sizeof(tag), key, sizeof(key), nonce, 13, @buf, k, @buf, k, @buf);
if err<>0 then begin
writeln('AES_CCM_Enc_Auth error code ',err, ' at k=',k);
exit;
end;
if print then writeln(k:2,': ',HexStr(@buf,k),', ',HexStr(@tag,sizeof(tag)));
key := tag;
end;
writeln('Final tag OK: ', compmem(@tag, @final, sizeof(final)));
end;
{---------------------------------------------------------------------------}
procedure RFC_Packets;
{-Check (non-random) CCM packets from RFC 3610}
type
ta25 = array[0..24] of byte;
ta10 = array[0..09] of byte;
const
ctest: array[1..12] of ta25 = (
($58,$8C,$97,$9A,$61,$C6,$63,$D2,$F0,$66,$D0,$C2,$C0,$F9,$89,$80,$6D,$5F,$6B,$61,$DA,$C3,$84,$00,$00),
($72,$C9,$1A,$36,$E1,$35,$F8,$CF,$29,$1C,$A8,$94,$08,$5C,$87,$E3,$CC,$15,$C4,$39,$C9,$E4,$3A,$3B,$00),
($51,$B1,$E5,$F4,$4A,$19,$7D,$1D,$A4,$6B,$0F,$8E,$2D,$28,$2A,$E8,$71,$E8,$38,$BB,$64,$DA,$85,$96,$57),
($A2,$8C,$68,$65,$93,$9A,$9A,$79,$FA,$AA,$5C,$4C,$2A,$9D,$4A,$91,$CD,$AC,$8C,$00,$00,$00,$00,$00,$00),
($DC,$F1,$FB,$7B,$5D,$9E,$23,$FB,$9D,$4E,$13,$12,$53,$65,$8A,$D8,$6E,$BD,$CA,$3E,$00,$00,$00,$00,$00),
($6F,$C1,$B0,$11,$F0,$06,$56,$8B,$51,$71,$A4,$2D,$95,$3D,$46,$9B,$25,$70,$A4,$BD,$87,$00,$00,$00,$00),
($01,$35,$D1,$B2,$C9,$5F,$41,$D5,$D1,$D4,$FE,$C1,$85,$D1,$66,$B8,$09,$4E,$99,$9D,$FE,$D9,$6C,$00,$00),
($7B,$75,$39,$9A,$C0,$83,$1D,$D2,$F0,$BB,$D7,$58,$79,$A2,$FD,$8F,$6C,$AE,$6B,$6C,$D9,$B7,$DB,$24,$00),
($82,$53,$1A,$60,$CC,$24,$94,$5A,$4B,$82,$79,$18,$1A,$B5,$C8,$4D,$F2,$1C,$E7,$F9,$B7,$3F,$42,$E1,$97),
($07,$34,$25,$94,$15,$77,$85,$15,$2B,$07,$40,$98,$33,$0A,$BB,$14,$1B,$94,$7B,$00,$00,$00,$00,$00,$00),
($67,$6B,$B2,$03,$80,$B0,$E3,$01,$E8,$AB,$79,$59,$0A,$39,$6D,$A7,$8B,$83,$49,$34,$00,$00,$00,$00,$00),
($C0,$FF,$A0,$D6,$F0,$5B,$DB,$67,$F2,$4D,$43,$A4,$33,$8D,$2A,$A4,$BE,$D7,$B2,$0E,$43,$00,$00,$00,$00));
ttest: array[1..12] of ta10 = (
($17,$E8,$D1,$2C,$FD,$F9,$26,$E0,$00,$00),
($A0,$91,$D5,$6E,$10,$40,$09,$16,$00,$00),
($4A,$DA,$A7,$6F,$BD,$9F,$B0,$C5,$00,$00),
($96,$C8,$61,$B9,$C9,$E6,$1E,$F1,$00,$00),
($51,$E8,$3F,$07,$7D,$9C,$2D,$93,$00,$00),
($40,$5A,$04,$43,$AC,$91,$CB,$94,$00,$00),
($04,$8C,$56,$60,$2C,$97,$AC,$BB,$74,$90),
($C1,$7B,$44,$33,$F4,$34,$96,$3F,$34,$B4),
($EA,$9C,$07,$E5,$6B,$5E,$B1,$7E,$5F,$4E),
($56,$6A,$A9,$40,$6B,$4D,$99,$99,$88,$DD),
($F5,$3A,$A2,$E9,$10,$7A,$8B,$6C,$02,$2C),
($CD,$1A,$A3,$16,$62,$E7,$AD,$65,$D6,$DB));
var
pn: integer;
key, nonce, tag, hdr: TAESBlock;
buf: array[0..63] of byte;
i,ih,it,k,err: integer;
plen,tlen,hlen: word;
x: longint;
b: byte;
begin
writeln('Test packet vectors 1 .. 12 from RFC 3610');
nonce[00] := 0;
nonce[01] := 0;
nonce[02] := 0;
nonce[07] := $A0;
nonce[08] := $A1;
nonce[09] := $A2;
nonce[10] := $A3;
nonce[11] := $A4;
nonce[12] := $A5;
pn := 0;
for i:=0 to 15 do key[i] := $C0+i;
for it:=0 to 1 do begin
tlen := 8 + 2*it;
for ih:=0 to 1 do begin
hlen := 8 + 4*ih;
for k := 31 to 33 do begin
pLen := k-hlen;
x := pn*$01010101+$03020100;
inc(pn);
nonce[03] := (x shr 24) and $ff;
nonce[04] := (x shr 16) and $ff;
nonce[05] := (x shr 08) and $ff;
nonce[06] := x and $ff;
b := 0;
for i:=0 to pred(hlen) do begin
hdr[i] := b;
inc(b);
end;
for i:=0 to pred(pLen) do begin
buf[i] := b;
inc(b);
end;
err := AES_CCM_Enc_Auth(tag,tlen,key,16,nonce,13,@hdr,hlen,@buf,plen,@buf);
write('Packet ',pn:2);
if err<>0 then writeln(': AES_CCM_Enc_Auth error code ',err)
else begin
writeln(': CT ',compmem(@buf,@ctest[pn],plen), ', Tag ',compmem(@tag,@ttest[pn],tlen));
err := AES_CCM_Dec_Veri(@tag,tlen,key,16,nonce,13,@hdr,hlen,@ctest[pn],plen,@buf);
if err<>0 then writeln(' - AES_CCM_Dec_Veri error code ',err);
end;
end;
end;
end;
end;
begin
writeln('Test program AES-CCM mode (c) 2009 W.Ehrhardt');
{$ifdef USEDLL}
writeln('DLL Version: ',AES_DLL_Version);
{$endif}
Simple_Tests;
RFC_Packets;
writeln;
LTC_Test(false);
end.

198
Tocsg.Lib/VCL/EncLib/AES/t_aescf8.pas Normal file
View File

@ -0,0 +1,198 @@
{-Test prog for AES CFB8, we Dec.2007}
program T_AESCF8;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_cfb8, mem_util, BTypes;
var
Context: TAESContext;
Err : integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-CFB8 mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample text for AES CFB8 mode'#0;
var
i : integer;
IV : TAESBlock;
ct, pt, plain: array[1..length(sample)] of char8;
procedure CheckRes;
begin
writeln('Decr(Encr)=Id : ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
for i:=0 to 15 do IV[i] := random(256);
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-CFB8 mode');
writeln('Org. plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_CFB8_Init(key128, 128, IV, context);
Err := AES_CFB8_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB8_Init(key128, 128, IV, context);
Err := AES_CFB8_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB8_Init(key128, 128, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB8_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_CFB8_Init(key192, 192, IV, context);
Err := AES_CFB8_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB8_Init(key192, 192, IV, context);
Err := AES_CFB8_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB8_Init(key192, 192, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB8_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_CFB8_Init(key256, 256, IV, context);
Err := AES_CFB8_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB8_Init(key256, 256, IV, context);
Err := AES_CFB8_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB8_Init(key256, 256, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB8_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A CFB8/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
plain : array[0..17] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d);
ct1 : array[0..17] of byte = ($3b,$79,$42,$4c,$9c,$0d,$d4,$36,
$ba,$ce,$9e,$0e,$d4,$58,$6a,$4f,
$32,$b9);
ct2 : array[0..17] of byte = ($cd,$a2,$52,$1e,$f0,$a9,$05,$ca,
$44,$cd,$05,$7c,$bf,$0d,$47,$a0,
$67,$8a);
ct3 : array[0..17] of byte = ($dc,$1f,$1a,$85,$20,$a6,$4d,$b5,
$5f,$cc,$8a,$c5,$54,$84,$4e,$88,
$97,$00);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A CFB8/AES tests');
Err := AES_CFB8_Init(key128, 128, IV, context);
Err := AES_CFB8_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.7 CFB8-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_CFB8_Init(key128, 128, IV, context);
Err := AES_CFB8_Decrypt(@ct1, @ct, sizeof(ct1), context);
writeln('Test F.3.8 CFB8-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CFB8_Init(key192, 192, IV, context);
Err := AES_CFB8_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.9 CFB8-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_CFB8_Init(key192, 192, IV, context);
Err := AES_CFB8_Decrypt(@ct2, @ct, sizeof(ct3), context);
writeln('Test F.3.10 CFB8-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CFB8_Init(key256, 256, IV, context);
Err := AES_CFB8_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.11 CFB8-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_CFB8_Init(key256, 256, IV, context);
Err := AES_CFB8_Decrypt(@ct3, @ct, sizeof(ct3), context);
writeln('Test F.3.12 CFB8-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

217
Tocsg.Lib/VCL/EncLib/AES/t_aescfb.pas Normal file
View File

@ -0,0 +1,217 @@
{-Test prog for AES CFB, we Sep.2003}
program T_AESCFB;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_cfb, mem_util, BTypes;
var
Context: TAESContext;
Err : integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-CFB mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample text for AES CFB mode'#0;
var
i : integer;
IV : TAESBlock;
ct, pt, plain: array[1..length(sample)] of char8;
procedure CheckRes;
begin
writeln('Decr(Encr)=Id : ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
for i:=0 to 15 do IV[i] := random(256);
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-CFB mode');
writeln('Org. plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB_Init(key128, 128, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_CFB_Init(key192, 192, IV, context);
Err := AES_CFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB_Init(key192, 192, IV, context);
Err := AES_CFB_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB_Init(key192, 192, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_CFB_Init(key256, 256, IV, context);
Err := AES_CFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CFB_Init(key256, 256, IV, context);
Err := AES_CFB_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CFB_Init(key256, 256, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A CFB/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$c8,$a6,$45,$37,$a0,$b3,$a9,$3f,
$cd,$e3,$cd,$ad,$9f,$1c,$e5,$8b,
$26,$75,$1f,$67,$a3,$cb,$b1,$40,
$b1,$80,$8c,$f1,$87,$a4,$f4,$df,
$c0,$4b,$05,$35,$7c,$5d,$1c,$0e,
$ea,$c4,$c6,$6f,$9f,$f7,$f2,$e6);
ct2 : array[0..63] of byte = ($cd,$c8,$0d,$6f,$dd,$f1,$8c,$ab,
$34,$c2,$59,$09,$c9,$9a,$41,$74,
$67,$ce,$7f,$7f,$81,$17,$36,$21,
$96,$1a,$2b,$70,$17,$1d,$3d,$7a,
$2e,$1e,$8a,$1d,$d5,$9b,$88,$b1,
$c8,$e6,$0f,$ed,$1e,$fa,$c4,$c9,
$c0,$5f,$9f,$9c,$a9,$83,$4f,$a0,
$42,$ae,$8f,$ba,$58,$4b,$09,$ff);
ct3 : array[0..63] of byte = ($dc,$7e,$84,$bf,$da,$79,$16,$4b,
$7e,$cd,$84,$86,$98,$5d,$38,$60,
$39,$ff,$ed,$14,$3b,$28,$b1,$c8,
$32,$11,$3c,$63,$31,$e5,$40,$7b,
$df,$10,$13,$24,$15,$e5,$4b,$92,
$a1,$3e,$d0,$a8,$26,$7a,$e2,$f9,
$75,$a3,$85,$74,$1a,$b9,$ce,$f8,
$20,$31,$62,$3d,$55,$b1,$e4,$71);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A CFB/AES tests');
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.13 CFB128-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Decrypt(@ct1, @ct, sizeof(ct1), context);
writeln('Test F.3.14 CFB128-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CFB_Init(key192, 192, IV, context);
Err := AES_CFB_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.15 CFB128-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_CFB_Init(key192, 192, IV, context);
Err := AES_CFB_Decrypt(@ct2, @ct, sizeof(ct3), context);
writeln('Test F.3.16 CFB128-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CFB_Init(key256, 256, IV, context);
Err := AES_CFB_Encrypt(@plain, @ct, sizeof(plain), context);
writeln('Test F.3.17 CFB128-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_CFB_Init(key256, 256, IV, context);
Err := AES_CFB_Decrypt(@ct3, @ct, sizeof(ct3), context);
writeln('Test F.3.18 CFB128-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

100
Tocsg.Lib/VCL/EncLib/AES/t_aescrp.pas Normal file
View File

@ -0,0 +1,100 @@
{-Test prog for AES encrypt/decrypt, we 2003}
program T_AESCRP;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_encr, aes_decr, mem_util;
var
Context: TAESContext;
const
Plain: TAESBlock = ($0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $a, $b, $c, $d, $e, $f);
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
CT128 : TAESBlock = ($0A, $94, $0B, $B5, $41, $6E, $F0, $45, $F1, $C3, $94, $58, $C6, $53, $EA, $5A);
CT192 : TAESBlock = ($00, $60, $BF, $FE, $46, $83, $4B, $B8, $DA, $5C, $F9, $A6, $1F, $F2, $20, $AE);
CT256 : TAESBlock = ($5A, $6E, $04, $57, $08, $FB, $71, $96, $F0, $2E, $55, $3D, $02, $C3, $A6, $92);
var
Err : integer;
OK : boolean;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure DoTests;
var
Block: TAESBlock; {16 Bit: dorce Block in stack for debugging}
begin
writeln('------------------------------------');
Err := AES_Init_Encr(Key128, 8*sizeof(Key128), Context);
CheckError;
writeln('Plaintext : ', HexStr(@Plain, sizeof(Plain)));
writeln;
writeln('Key : ', HexStr(@key128, sizeof(key128)));
AES_Encrypt(Context, Plain, Block);
OK := CompMem(@CT128, @Block, sizeof(Block));
writeln('Encrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
Err := AES_Init_Decr(Key128, 8*sizeof(Key128), Context);
CheckError;
AES_Decrypt(Context, Block, Block);
OK := CompMem(@Plain, @Block, sizeof(Block));
writeln('Decrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
writeln;
Err := AES_Init_Encr(Key192, 8*sizeof(Key192), Context);
CheckError;
writeln('Key : ', HexStr(@key192, sizeof(key192)));
AES_Encrypt(Context, Plain, Block);
OK := CompMem(@CT192, @Block, sizeof(Block));
writeln('Encrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
Err := AES_Init_Decr(Key192, 8*sizeof(Key192), Context);
CheckError;
AES_Decrypt(Context, Block, Block);
OK := CompMem(@Plain, @Block, sizeof(Block));
writeln('Decrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
writeln;
Err := AES_Init_Encr(Key256, 8*sizeof(Key256), Context);
CheckError;
writeln('Key : ', HexStr(@key256, sizeof(key256)));
AES_Encrypt(Context, Plain, Block);
OK := CompMem(@CT256, @Block, sizeof(Block));
writeln('Encrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
Err := AES_Init_Decr(Key256, 8*sizeof(Key256), Context);
CheckError;
AES_Decrypt(Context, Block, Block);
OK := CompMem(@Plain, @Block, sizeof(Block));
writeln('Decrypted : ', HexStr(@Block, sizeof(Block)), OK:8);
end;
begin
DoTests;
end.

224
Tocsg.Lib/VCL/EncLib/AES/t_aesctr.pas Normal file
View File

@ -0,0 +1,224 @@
{-Test prog for AES CTR, we Sep.2003}
program T_AESCTR;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_ctr, mem_util, BTypes;
var
Context: TAESContext;
Err : integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-CTR mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample text for AES CTR mode'#0;
var
IV : TAESBlock;
i : integer;
ct, pt, plain: array[1..length(sample)] of char8;
procedure CheckRes;
begin
writeln('Decr(Encr)=Id : ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
for i:=0 to 15 do IV[i] := random(256);
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-CTR mode');
writeln('Org. plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_CTR_Init(key128, 128, IV, context);
Err := AES_CTR_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CTR_Init(key128, 128, IV, context);
Err := AES_CTR_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CTR_Init(key128, 128, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CTR_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_CTR_Init(key192, 192, IV, context);
Err := AES_CTR_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CTR_Init(key192, 192, IV, context);
Err := AES_CTR_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CTR_Init(key192, 192, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CTR_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_CTR_Init(key256, 256, IV, context);
Err := AES_CTR_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_CTR_Init(key256, 256, IV, context);
Err := AES_CTR_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_CTR_Init(key256, 256, IV, context);
for i:=1 to sizeof(plain) do begin
if Err=0 then Err := AES_CTR_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
CheckRes;
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A CTR/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
CTR : TAESBlock = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($87,$4d,$61,$91,$b6,$20,$e3,$26,
$1b,$ef,$68,$64,$99,$0d,$b6,$ce,
$98,$06,$f6,$6b,$79,$70,$fd,$ff,
$86,$17,$18,$7b,$b9,$ff,$fd,$ff,
$5a,$e4,$df,$3e,$db,$d5,$d3,$5e,
$5b,$4f,$09,$02,$0d,$b0,$3e,$ab,
$1e,$03,$1d,$da,$2f,$be,$03,$d1,
$79,$21,$70,$a0,$f3,$00,$9c,$ee);
ct2 : array[0..63] of byte = ($1a,$bc,$93,$24,$17,$52,$1c,$a2,
$4f,$2b,$04,$59,$fe,$7e,$6e,$0b,
$09,$03,$39,$ec,$0a,$a6,$fa,$ef,
$d5,$cc,$c2,$c6,$f4,$ce,$8e,$94,
$1e,$36,$b2,$6b,$d1,$eb,$c6,$70,
$d1,$bd,$1d,$66,$56,$20,$ab,$f7,
$4f,$78,$a7,$f6,$d2,$98,$09,$58,
$5a,$97,$da,$ec,$58,$c6,$b0,$50);
ct3 : array[0..63] of byte = ($60,$1e,$c3,$13,$77,$57,$89,$a5,
$b7,$a7,$f5,$04,$bb,$f3,$d2,$28,
$f4,$43,$e3,$ca,$4d,$62,$b5,$9a,
$ca,$84,$e9,$90,$ca,$ca,$f5,$c5,
$2b,$09,$30,$da,$a2,$3d,$e9,$4c,
$e8,$70,$17,$ba,$2d,$84,$98,$8d,
$df,$c9,$c5,$8d,$b6,$7a,$ad,$a6,
$13,$c2,$dd,$08,$45,$79,$41,$a6);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A CTR/AES tests');
Err := AES_CTR_Init(key128, 128, CTR, context);
Err := AES_CTR_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.5.1 CTR-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_CTR_Init(key128, 128, CTR, context);
Err := AES_CTR_Decrypt(@ct1, @ct, sizeof(ct1), context);
CheckError;
writeln('Test F.5.2 CTR-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CTR_Init(key192, 192, CTR, context);
Err := AES_CTR_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.5.3 CTR-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_CTR_Init(key192, 192, CTR, context);
Err := AES_CTR_Decrypt(@ct2, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.5.4 CTR-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_CTR_Init(key256, 256, CTR, context);
Err := AES_CTR_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.5.5 CTR-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_CTR_Init(key256, 256, CTR, context);
Err := AES_CTR_Decrypt(@ct3, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.5.6 CTR-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

212
Tocsg.Lib/VCL/EncLib/AES/t_aesecb.pas Normal file
View File

@ -0,0 +1,212 @@
{-Test prog for AES ECB, we Sep.2003}
program T_AESECB;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_ecb, mem_util, BTypes;
var
Context: TAESContext;
Err: integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-ECB mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample for AES ECB mode'#0;
var
ct, pt, plain: array[1..length(sample)] of char8;
procedure CheckRes;
begin
writeln('Test Dec(Enc)=Id: ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-ECB mode');
writeln('Plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_ECB_Init_Encr(key128, 128, context);
Err := AES_ECB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_ECB_Init_Decr(key128, 128, context);
Err := AES_ECB_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/Dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_ECB_Init_Decr(key128, 128, context);
Err := AES_ECB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_ECB_Init_Encr(key192, 192, context);
Err := AES_ECB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_ECB_Init_Decr(key192, 192, context);
Err := AES_ECB_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/Dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_ECB_Init_Decr(key192, 192, context);
Err := AES_ECB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_ECB_Init_Encr(key256, 256, context);
Err := AES_ECB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
Err := AES_ECB_Init_Decr(key256, 256, context);
Err := AES_ECB_Decrypt(@ct, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/Dec @pt<>@ct: ', pt);
CheckRes;
pt := ct;
Err := AES_ECB_Init_Decr(key256, 256, context);
Err := AES_ECB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Enc/dec inplace : ', pt);
CheckRes;
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A ECB/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($3a,$d7,$7b,$b4,$0d,$7a,$36,$60,
$a8,$9e,$ca,$f3,$24,$66,$ef,$97,
$f5,$d3,$d5,$85,$03,$b9,$69,$9d,
$e7,$85,$89,$5a,$96,$fd,$ba,$af,
$43,$b1,$cd,$7f,$59,$8e,$ce,$23,
$88,$1b,$00,$e3,$ed,$03,$06,$88,
$7b,$0c,$78,$5e,$27,$e8,$ad,$3f,
$82,$23,$20,$71,$04,$72,$5d,$d4);
ct2 : array[0..63] of byte = ($bd,$33,$4f,$1d,$6e,$45,$f2,$5f,
$f7,$12,$a2,$14,$57,$1f,$a5,$cc,
$97,$41,$04,$84,$6d,$0a,$d3,$ad,
$77,$34,$ec,$b3,$ec,$ee,$4e,$ef,
$ef,$7a,$fd,$22,$70,$e2,$e6,$0a,
$dc,$e0,$ba,$2f,$ac,$e6,$44,$4e,
$9a,$4b,$41,$ba,$73,$8d,$6c,$72,
$fb,$16,$69,$16,$03,$c1,$8e,$0e);
ct3 : array[0..63] of byte = ($f3,$ee,$d1,$bd,$b5,$d2,$a0,$3c,
$06,$4b,$5a,$7e,$3d,$b1,$81,$f8,
$59,$1c,$cb,$10,$d4,$10,$ed,$26,
$dc,$5b,$a7,$4a,$31,$36,$28,$70,
$b6,$ed,$21,$b9,$9c,$a6,$f4,$f9,
$f1,$53,$e7,$b1,$be,$af,$ed,$1d,
$23,$30,$4b,$7a,$39,$f9,$f3,$ff,
$06,$7d,$8d,$8f,$9e,$24,$ec,$c7);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A ECB/AES tests');
Err := AES_ECB_Init_Encr(key128, 128, context);
Err := AES_ECB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.1.1 ECB-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_ECB_Init_Decr(key128, 128, context);
Err := AES_ECB_Decrypt(@ct{1}, @ct, sizeof(ct1), context);
CheckError;
writeln('Test F.1.2 ECB-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_ECB_Init_Encr(key192, 192, context);
Err := AES_ECB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.1.3 ECB-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_ECB_Init_Decr(key192, 192, context);
Err := AES_ECB_Decrypt(@ct{2}, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.1.4 ECB-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_ECB_Init_Encr(key256, 256, context);
Err := AES_ECB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.1.5 ECB-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_ECB_Init_Decr(key256, 256, context);
Err := AES_ECB_Decrypt(@ct{3}, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.1.6 ECB-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

957
Tocsg.Lib/VCL/EncLib/AES/t_aesgcm.pas Normal file
View File

@ -0,0 +1,957 @@
{-Test prog for AES_GCM, we 09.2010}
program T_AESGCM;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifdef BIT16}
{$N+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
BTypes,
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
AES_Type, AES_Base, AES_GCM,
{$endif}
Mem_Util;
var
tag : TAESBlock;
ctx : TAES_GCMContext;
err : integer;
pt : array[0..511] of byte;
ct : array[0..511] of byte;
fail: longint;
const
print: boolean = false;
{---------------------------------------------------------------------------}
procedure single_test( ptag: pointer; tLen: word; {Tag: address / length (0..16)}
{$ifdef CONST}const{$else}var{$endif} Key; KBits: word; {key and bitlength of key}
pIV: pointer; IV_len: word; {IV: address / length}
pAAD: pointer; aLen: word; {AAD: address / length}
ctp: pointer; cLen: longint; {ciphertext: address / length}
ptp: pointer; tn: integer); {plaintext: address}
var
lf: integer;
sn: string[10];
begin
str(tn:3,sn);
sn := 'TV '+sn+': ';
lf := 0;
{-------------------------------------------------------------------------}
fillchar(pt,sizeof(pt),0);
fillchar(ct,sizeof(ct),0);
err := AES_GCM_Dec_Veri(ptag,tLen,Key,KBits,pIV,IV_Len,pAAD,aLen,ctp,cLen,@pt,ctx);
if err<>0 then begin
inc(lf);
writeln(sn,'AES_GCM_Dec_Veri error: ',err);
end
else begin
if not compmem(@pt, ptp, cLen) then begin
writeln(sn,'AES_GCM_Dec_Veri - plaintext does not match');
inc(lf);
end;
end;
{-------------------------------------------------------------------------}
fillchar(pt,sizeof(pt),0);
fillchar(ct,sizeof(ct),0);
err := AES_GCM_Enc_Auth(tag,Key,KBits,pIV,IV_Len,pAAD,aLen,ptp,cLen,@ct,ctx);
if err<>0 then begin
inc(lf);
writeln(sn,'AES_GCM_Enc_Auth error: ',err);
end
else begin
if not compmem(@tag, ptag, tLen) then begin
writeln(sn,'AES_GCM_Enc_Auth - Tag does not match');
inc(lf);
end;
if not compmem(@ct, ctp, cLen) then begin
writeln(sn,'AES_GCM_Enc_Auth - Ciphertext does not match');
inc(lf);
end;
end;
{-------------------------------------------------------------------------}
fillchar(pt,sizeof(pt),0);
fillchar(ct,sizeof(ct),0);
err := AES_GCM_Init(Key, KBits, ctx);
if err<>0 then writeln(sn,'Enc - AES_GCM_Init error: ',err);
if err=0 then begin
err := AES_GCM_Reset_IV(pIV, IV_Len, ctx);
if err<>0 then writeln(sn,'Enc - AES_GCM_Reset_IV error: ',err);
end;
if err=0 then begin
err := AES_GCM_Add_AAD(pAAD, aLen, ctx);
if err<>0 then writeln(sn,'Enc - AES_GCM_Add_AAD error: ',err);
end;
if err=0 then begin
err := AES_GCM_Encrypt(ptp, @ct, cLen, ctx);
if err<>0 then writeln(sn,'Enc - AES_GCM_Encrypt error: ',err);
end;
if err=0 then begin
err := AES_GCM_Final(tag, ctx);
if err<>0 then writeln(sn,'Enc - AES_GCM_Final error: ',err);
end;
if err=0 then begin
if not compmem(@tag, ptag, tLen) then begin
writeln(sn,'Enc - Tag does not match');
inc(lf);
end;
if not compmem(@ct, ctp, cLen) then begin
writeln(sn,'Enc - Ciphertext does not match');
inc(lf);
end;
end
else inc(lf);
{-------------------------------------------------------------------------}
fillchar(pt,sizeof(pt),0);
fillchar(ct,sizeof(ct),0);
err := AES_GCM_Init(Key, KBits, ctx);
if err<>0 then writeln(sn,'Dec - AES_GCM_Init error: ',err);
if err=0 then begin
err := AES_GCM_Reset_IV(pIV, IV_Len, ctx);
if err<>0 then writeln(sn,'Dec - AES_GCM_Reset_IV error: ',err);
end;
if err=0 then begin
err := AES_GCM_Add_AAD(pAAD, aLen, ctx);
if err<>0 then writeln(sn,'Dec - AES_GCM_Add_AAD error: ',err);
end;
if err=0 then begin
err := AES_GCM_Decrypt(ctp, @pt, cLen, ctx);
if err<>0 then writeln(sn,'Dec - AES_GCM_Encrypt error: ',err);
end;
if err=0 then begin
err := AES_GCM_Final(tag, ctx);
if err<>0 then writeln(sn,'Dec - AES_GCM_Final error: ',err);
end;
if err=0 then begin
if not compmem(@tag, ptag, tLen) then begin
writeln(sn,'Dec - Tag does not match');
inc(lf);
end;
if not compmem(@pt, ptp, cLen) then begin
writeln(sn,'Dec - Plaintext does not match');
inc(lf);
end;
end
else inc(lf);
if lf<>0 then inc(fail);
end;
{---------------------------------------------------------------------------}
procedure testspec;
const
K01: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I01: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
T01: array[0..15] of byte = ($58,$e2,$fc,$ce,$fa,$7e,$30,$61,
$36,$7f,$1d,$57,$a4,$e7,$45,$5a);
K02: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
P02: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I02: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
C02: array[0..15] of byte = ($03,$88,$da,$ce,$60,$b6,$a3,$92,
$f3,$28,$c2,$b9,$71,$b2,$fe,$78);
T02: array[0..15] of byte = ($ab,$6e,$47,$d4,$2c,$ec,$13,$bd,
$f5,$3a,$67,$b2,$12,$57,$bd,$df);
K03: array[0..15] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P03: array[0..63] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39,$1a,$af,$d2,$55);
I03: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C03: array[0..63] of byte = ($42,$83,$1e,$c2,$21,$77,$74,$24,
$4b,$72,$21,$b7,$84,$d0,$d4,$9c,
$e3,$aa,$21,$2f,$2c,$02,$a4,$e0,
$35,$c1,$7e,$23,$29,$ac,$a1,$2e,
$21,$d5,$14,$b2,$54,$66,$93,$1c,
$7d,$8f,$6a,$5a,$ac,$84,$aa,$05,
$1b,$a3,$0b,$39,$6a,$0a,$ac,$97,
$3d,$58,$e0,$91,$47,$3f,$59,$85);
T03: array[0..15] of byte = ($4d,$5c,$2a,$f3,$27,$cd,$64,$a6,
$2c,$f3,$5a,$bd,$2b,$a6,$fa,$b4);
K04: array[0..15] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P04: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A04: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I04: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C04: array[0..59] of byte = ($42,$83,$1e,$c2,$21,$77,$74,$24,
$4b,$72,$21,$b7,$84,$d0,$d4,$9c,
$e3,$aa,$21,$2f,$2c,$02,$a4,$e0,
$35,$c1,$7e,$23,$29,$ac,$a1,$2e,
$21,$d5,$14,$b2,$54,$66,$93,$1c,
$7d,$8f,$6a,$5a,$ac,$84,$aa,$05,
$1b,$a3,$0b,$39,$6a,$0a,$ac,$97,
$3d,$58,$e0,$91);
T04: array[0..15] of byte = ($5b,$c9,$4f,$bc,$32,$21,$a5,$db,
$94,$fa,$e9,$5a,$e7,$12,$1a,$47);
K05: array[0..15] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P05: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A05: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I05: array[0..07] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad);
C05: array[0..59] of byte = ($61,$35,$3b,$4c,$28,$06,$93,$4a,
$77,$7f,$f5,$1f,$a2,$2a,$47,$55,
$69,$9b,$2a,$71,$4f,$cd,$c6,$f8,
$37,$66,$e5,$f9,$7b,$6c,$74,$23,
$73,$80,$69,$00,$e4,$9f,$24,$b2,
$2b,$09,$75,$44,$d4,$89,$6b,$42,
$49,$89,$b5,$e1,$eb,$ac,$0f,$07,
$c2,$3f,$45,$98);
T05: array[0..15] of byte = ($36,$12,$d2,$e7,$9e,$3b,$07,$85,
$56,$1b,$e1,$4a,$ac,$a2,$fc,$cb);
K06: array[0..15] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P06: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A06: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I06: array[0..59] of byte = ($93,$13,$22,$5d,$f8,$84,$06,$e5,
$55,$90,$9c,$5a,$ff,$52,$69,$aa,
$6a,$7a,$95,$38,$53,$4f,$7d,$a1,
$e4,$c3,$03,$d2,$a3,$18,$a7,$28,
$c3,$c0,$c9,$51,$56,$80,$95,$39,
$fc,$f0,$e2,$42,$9a,$6b,$52,$54,
$16,$ae,$db,$f5,$a0,$de,$6a,$57,
$a6,$37,$b3,$9b);
C06: array[0..59] of byte = ($8c,$e2,$49,$98,$62,$56,$15,$b6,
$03,$a0,$33,$ac,$a1,$3f,$b8,$94,
$be,$91,$12,$a5,$c3,$a2,$11,$a8,
$ba,$26,$2a,$3c,$ca,$7e,$2c,$a7,
$01,$e4,$a9,$a4,$fb,$a4,$3c,$90,
$cc,$dc,$b2,$81,$d4,$8c,$7c,$6f,
$d6,$28,$75,$d2,$ac,$a4,$17,$03,
$4c,$34,$ae,$e5);
T06: array[0..15] of byte = ($61,$9c,$c5,$ae,$ff,$fe,$0b,$fa,
$46,$2a,$f4,$3c,$16,$99,$d0,$50);
K07: array[0..23] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I07: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
T07: array[0..15] of byte = ($cd,$33,$b2,$8a,$c7,$73,$f7,$4b,
$a0,$0e,$d1,$f3,$12,$57,$24,$35);
K08: array[0..23] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
P08: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I08: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
C08: array[0..15] of byte = ($98,$e7,$24,$7c,$07,$f0,$fe,$41,
$1c,$26,$7e,$43,$84,$b0,$f6,$00);
T08: array[0..15] of byte = ($2f,$f5,$8d,$80,$03,$39,$27,$ab,
$8e,$f4,$d4,$58,$75,$14,$f0,$fb);
K09: array[0..23] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c);
P09: array[0..63] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39,$1a,$af,$d2,$55);
I09: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C09: array[0..63] of byte = ($39,$80,$ca,$0b,$3c,$00,$e8,$41,
$eb,$06,$fa,$c4,$87,$2a,$27,$57,
$85,$9e,$1c,$ea,$a6,$ef,$d9,$84,
$62,$85,$93,$b4,$0c,$a1,$e1,$9c,
$7d,$77,$3d,$00,$c1,$44,$c5,$25,
$ac,$61,$9d,$18,$c8,$4a,$3f,$47,
$18,$e2,$44,$8b,$2f,$e3,$24,$d9,
$cc,$da,$27,$10,$ac,$ad,$e2,$56);
T09: array[0..15] of byte = ($99,$24,$a7,$c8,$58,$73,$36,$bf,
$b1,$18,$02,$4d,$b8,$67,$4a,$14);
K10: array[0..23] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c);
P10: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A10: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I10: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C10: array[0..59] of byte = ($39,$80,$ca,$0b,$3c,$00,$e8,$41,
$eb,$06,$fa,$c4,$87,$2a,$27,$57,
$85,$9e,$1c,$ea,$a6,$ef,$d9,$84,
$62,$85,$93,$b4,$0c,$a1,$e1,$9c,
$7d,$77,$3d,$00,$c1,$44,$c5,$25,
$ac,$61,$9d,$18,$c8,$4a,$3f,$47,
$18,$e2,$44,$8b,$2f,$e3,$24,$d9,
$cc,$da,$27,$10);
T10: array[0..15] of byte = ($25,$19,$49,$8e,$80,$f1,$47,$8f,
$37,$ba,$55,$bd,$6d,$27,$61,$8c);
K11: array[0..23] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c);
P11: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A11: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I11: array[0.. 7] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad);
C11: array[0..59] of byte = ($0f,$10,$f5,$99,$ae,$14,$a1,$54,
$ed,$24,$b3,$6e,$25,$32,$4d,$b8,
$c5,$66,$63,$2e,$f2,$bb,$b3,$4f,
$83,$47,$28,$0f,$c4,$50,$70,$57,
$fd,$dc,$29,$df,$9a,$47,$1f,$75,
$c6,$65,$41,$d4,$d4,$da,$d1,$c9,
$e9,$3a,$19,$a5,$8e,$8b,$47,$3f,
$a0,$f0,$62,$f7);
T11: array[0..15] of byte = ($65,$dc,$c5,$7f,$cf,$62,$3a,$24,
$09,$4f,$cc,$a4,$0d,$35,$33,$f8);
K12: array[0..23] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c);
P12: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A12: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I12: array[0..59] of byte = ($93,$13,$22,$5d,$f8,$84,$06,$e5,
$55,$90,$9c,$5a,$ff,$52,$69,$aa,
$6a,$7a,$95,$38,$53,$4f,$7d,$a1,
$e4,$c3,$03,$d2,$a3,$18,$a7,$28,
$c3,$c0,$c9,$51,$56,$80,$95,$39,
$fc,$f0,$e2,$42,$9a,$6b,$52,$54,
$16,$ae,$db,$f5,$a0,$de,$6a,$57,
$a6,$37,$b3,$9b);
C12: array[0..59] of byte = ($d2,$7e,$88,$68,$1c,$e3,$24,$3c,
$48,$30,$16,$5a,$8f,$dc,$f9,$ff,
$1d,$e9,$a1,$d8,$e6,$b4,$47,$ef,
$6e,$f7,$b7,$98,$28,$66,$6e,$45,
$81,$e7,$90,$12,$af,$34,$dd,$d9,
$e2,$f0,$37,$58,$9b,$29,$2d,$b3,
$e6,$7c,$03,$67,$45,$fa,$22,$e7,
$e9,$b7,$37,$3b);
T12: array[0..15] of byte = ($dc,$f5,$66,$ff,$29,$1c,$25,$bb,
$b8,$56,$8f,$c3,$d3,$76,$a6,$d9);
K13: array[0..31] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I13: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
T13: array[0..15] of byte = ($53,$0f,$8a,$fb,$c7,$45,$36,$b9,
$a9,$63,$b4,$f1,$c4,$cb,$73,$8b);
K14: array[0..31] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
P14: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I14: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
C14: array[0..15] of byte = ($ce,$a7,$40,$3d,$4d,$60,$6b,$6e,
$07,$4e,$c5,$d3,$ba,$f3,$9d,$18);
T14: array[0..15] of byte = ($d0,$d1,$c8,$a7,$99,$99,$6b,$f0,
$26,$5b,$98,$b5,$d4,$8a,$b9,$19);
K15: array[0..31] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P15: array[0..63] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39,$1a,$af,$d2,$55);
I15: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C15: array[0..63] of byte = ($52,$2d,$c1,$f0,$99,$56,$7d,$07,
$f4,$7f,$37,$a3,$2a,$84,$42,$7d,
$64,$3a,$8c,$dc,$bf,$e5,$c0,$c9,
$75,$98,$a2,$bd,$25,$55,$d1,$aa,
$8c,$b0,$8e,$48,$59,$0d,$bb,$3d,
$a7,$b0,$8b,$10,$56,$82,$88,$38,
$c5,$f6,$1e,$63,$93,$ba,$7a,$0a,
$bc,$c9,$f6,$62,$89,$80,$15,$ad);
T15: array[0..15] of byte = ($b0,$94,$da,$c5,$d9,$34,$71,$bd,
$ec,$1a,$50,$22,$70,$e3,$cc,$6c);
K16: array[0..31] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P16: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A16: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I16: array[0..11] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad,
$de,$ca,$f8,$88);
C16: array[0..59] of byte = ($52,$2d,$c1,$f0,$99,$56,$7d,$07,
$f4,$7f,$37,$a3,$2a,$84,$42,$7d,
$64,$3a,$8c,$dc,$bf,$e5,$c0,$c9,
$75,$98,$a2,$bd,$25,$55,$d1,$aa,
$8c,$b0,$8e,$48,$59,$0d,$bb,$3d,
$a7,$b0,$8b,$10,$56,$82,$88,$38,
$c5,$f6,$1e,$63,$93,$ba,$7a,$0a,
$bc,$c9,$f6,$62);
T16: array[0..15] of byte = ($76,$fc,$6e,$ce,$0f,$4e,$17,$68,
$cd,$df,$88,$53,$bb,$2d,$55,$1b);
K17: array[0..31] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P17: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A17: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I17: array[0.. 7] of byte = ($ca,$fe,$ba,$be,$fa,$ce,$db,$ad);
C17: array[0..59] of byte = ($c3,$76,$2d,$f1,$ca,$78,$7d,$32,
$ae,$47,$c1,$3b,$f1,$98,$44,$cb,
$af,$1a,$e1,$4d,$0b,$97,$6a,$fa,
$c5,$2f,$f7,$d7,$9b,$ba,$9d,$e0,
$fe,$b5,$82,$d3,$39,$34,$a4,$f0,
$95,$4c,$c2,$36,$3b,$c7,$3f,$78,
$62,$ac,$43,$0e,$64,$ab,$e4,$99,
$f4,$7c,$9b,$1f);
T17: array[0..15] of byte = ($3a,$33,$7d,$bf,$46,$a7,$92,$c4,
$5e,$45,$49,$13,$fe,$2e,$a8,$f2);
K18: array[0..31] of byte = ($fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08,
$fe,$ff,$e9,$92,$86,$65,$73,$1c,
$6d,$6a,$8f,$94,$67,$30,$83,$08);
P18: array[0..59] of byte = ($d9,$31,$32,$25,$f8,$84,$06,$e5,
$a5,$59,$09,$c5,$af,$f5,$26,$9a,
$86,$a7,$a9,$53,$15,$34,$f7,$da,
$2e,$4c,$30,$3d,$8a,$31,$8a,$72,
$1c,$3c,$0c,$95,$95,$68,$09,$53,
$2f,$cf,$0e,$24,$49,$a6,$b5,$25,
$b1,$6a,$ed,$f5,$aa,$0d,$e6,$57,
$ba,$63,$7b,$39);
A18: array[0..19] of byte = ($fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$fe,$ed,$fa,$ce,$de,$ad,$be,$ef,
$ab,$ad,$da,$d2);
I18: array[0..59] of byte = ($93,$13,$22,$5d,$f8,$84,$06,$e5,
$55,$90,$9c,$5a,$ff,$52,$69,$aa,
$6a,$7a,$95,$38,$53,$4f,$7d,$a1,
$e4,$c3,$03,$d2,$a3,$18,$a7,$28,
$c3,$c0,$c9,$51,$56,$80,$95,$39,
$fc,$f0,$e2,$42,$9a,$6b,$52,$54,
$16,$ae,$db,$f5,$a0,$de,$6a,$57,
$a6,$37,$b3,$9b);
C18: array[0..59] of byte = ($5a,$8d,$ef,$2f,$0c,$9e,$53,$f1,
$f7,$5d,$78,$53,$65,$9e,$2a,$20,
$ee,$b2,$b2,$2a,$af,$de,$64,$19,
$a0,$58,$ab,$4f,$6f,$74,$6b,$f4,
$0f,$c0,$c3,$b7,$80,$f2,$44,$45,
$2d,$a3,$eb,$f1,$c5,$d8,$2c,$de,
$a2,$41,$89,$97,$20,$0e,$f8,$2e,
$44,$ae,$7e,$3f);
T18: array[0..15] of byte = ($a4,$4a,$82,$66,$ee,$1c,$8e,$b0,
$c8,$b5,$d4,$cf,$5a,$e9,$f1,$9a);
begin
fail := 0;
writeln('Test cases AES_GCM from GCM Spec');
single_test(@T01,16,K01,8*sizeof(K01),@I01,sizeof(I01),nil,0,nil,0,nil,01);
single_test(@T02,16,K02,8*sizeof(K02),@I02,sizeof(I02),nil,0,@C02,sizeof(C02),@P02,02);
single_test(@T03,16,K03,8*sizeof(K03),@I03,sizeof(I03),nil,0,@C03,sizeof(C03),@P03,03);
single_test(@T04,16,K04,8*sizeof(K04),@I04,sizeof(I04),@A04,sizeof(A04),@C04,sizeof(C04),@P04,04);
single_test(@T05,16,K05,8*sizeof(K05),@I05,sizeof(I05),@A05,sizeof(A05),@C05,sizeof(C05),@P05,05);
single_test(@T06,16,K06,8*sizeof(K06),@I06,sizeof(I06),@A06,sizeof(A06),@C06,sizeof(C06),@P06,06);
single_test(@T07,16,K07,8*sizeof(K07),@I07,sizeof(I07),nil,0,nil,0,nil,07);
single_test(@T08,16,K08,8*sizeof(K08),@I08,sizeof(I08),nil,0,@C08,sizeof(C08),@P08,08);
single_test(@T09,16,K09,8*sizeof(K09),@I09,sizeof(I09),nil,0,@C09,sizeof(C09),@P09,09);
single_test(@T10,16,K10,8*sizeof(K10),@I10,sizeof(I10),@A10,sizeof(A10),@C10,sizeof(C10),@P10,10);
single_test(@T11,16,K11,8*sizeof(K11),@I11,sizeof(I11),@A11,sizeof(A11),@C11,sizeof(C11),@P11,11);
single_test(@T12,16,K12,8*sizeof(K12),@I12,sizeof(I12),@A12,sizeof(A12),@C12,sizeof(C12),@P12,12);
single_test(@T13,16,K13,8*sizeof(K13),@I13,sizeof(I13),nil,0,nil,0,nil,13);
single_test(@T14,16,K14,8*sizeof(K14),@I14,sizeof(I14),nil,0,@C14,sizeof(C14),@P14,14);
single_test(@T15,16,K15,8*sizeof(K15),@I15,sizeof(I15),nil,0,@C15,sizeof(C15),@P15,15);
single_test(@T16,16,K16,8*sizeof(K16),@I16,sizeof(I16),@A16,sizeof(A16),@C16,sizeof(C16),@P16,16);
single_test(@T17,16,K17,8*sizeof(K17),@I17,sizeof(I17),@A17,sizeof(A17),@C17,sizeof(C17),@P17,17);
single_test(@T18,16,K18,8*sizeof(K18),@I18,sizeof(I18),@A18,sizeof(A18),@C18,sizeof(C18),@P18,18);
if fail=0 then writeln('All tests passed.')
else writeln('*** Number of failed tests: ', fail);
end;
{---------------------------------------------------------------------------}
procedure tsd_test;
{-Reproduce AES part of Tom St Denis' GCM_TV.TXT, LTC V1.18}
const
hex32: array[1..32] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b,$1c,$1d,$1e,$1f);
buf32: array[0..31] of byte = ($92,$4e,$17,$8a,$17,$fa,$1c,$a0,
$e7,$48,$6f,$04,$04,$12,$3b,$91,
$db,$f7,$97,$bb,$9d,$bd,$e9,$b1,
$d4,$8d,$5c,$7f,$53,$16,$59,$12);
tag32: array[0..15] of byte = ($10,$f9,$72,$b6,$f9,$e0,$a3,$c1,
$cf,$9c,$cf,$56,$54,$3d,$ca,$79);
var
err,n: integer;
ctx: TAES_GCMContext;
key, tag: TAESBlock;
buf: array[0..63] of byte;
begin
{Note: Contrary to what Tom writes in GCM_TV.TXT the length of nonce=IV is}
{NOT fixed=13, but varies the same way as the header and plaintext length!}
writeln('Test AES part of Tom St Denis'' GCM_TV.TXT (LTC V1.18)');
{Uppercase from HexStr}
HexUpper := true;
{Initial key from hex32}
move(hex32, key, sizeof(key));
for n:=1 to 32 do begin
err := AES_GCM_Init(key, 128, ctx);
if err=0 then err := AES_GCM_Reset_IV(@hex32, n, ctx);
if err=0 then err := AES_GCM_Add_AAD(@hex32,n,ctx);
if err=0 then err := AES_GCM_Encrypt(@hex32, @buf, n, ctx);
if err=0 then err := AES_GCM_Final(tag, ctx);
if err=0 then begin
if print then writeln(n:3,': ', HexStr(@buf,n), ', ', HexStr(@tag,16));
{key for step n>1 is the tag of the previous step repeated}
key := tag;
end
else begin
writeln('Error ',err);
exit;
end;
end;
{compare final values}
writeln('buf32 compares: ', compmem(@buf32, @buf, sizeof(buf32)):5);
writeln('tag32 compares: ', compmem(@tag32, @tag, sizeof(tag32)):5);
end;
{---------------------------------------------------------------------------}
procedure test_glad2;
const
K01: array[0..31] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I01: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
P01: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
C01: array[0..15] of byte = ($ce,$a7,$40,$3d,$4d,$60,$6b,$6e,
$07,$4e,$c5,$d3,$ba,$f3,$9d,$18);
T01: array[0..15] of byte = ($d0,$d1,$c8,$a7,$99,$99,$6b,$f0,
$26,$5b,$98,$b5,$d4,$8a,$b9,$19);
K02: array[0..31] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I02: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
H02: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
T02: array[0..15] of byte = ($2d,$45,$55,$2d,$85,$75,$92,$2b,
$3c,$a3,$cc,$53,$84,$42,$fa,$26);
K03: array[0..31] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
I03: array[0..11] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00);
H03: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
P03: array[0..15] of byte = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
C03: array[0..15] of byte = ($ce,$a7,$40,$3d,$4d,$60,$6b,$6e,
$07,$4e,$c5,$d3,$ba,$f3,$9d,$18);
T03: array[0..15] of byte = ($ae,$9b,$17,$71,$db,$a9,$cf,$62,
$b3,$9b,$e0,$17,$94,$03,$30,$b4);
K04: array[0..31] of byte = ($fb,$76,$15,$b2,$3d,$80,$89,$1d,
$d4,$70,$98,$0b,$c7,$95,$84,$c8,
$b2,$fb,$64,$ce,$60,$97,$8f,$4d,
$17,$fc,$e4,$5a,$49,$e8,$30,$b7);
I04: array[0..11] of byte = ($db,$d1,$a3,$63,$60,$24,$b7,$b4,
$02,$da,$7d,$6f);
P04: array[0..15] of byte = ($a8,$45,$34,$8e,$c8,$c5,$b5,$f1,
$26,$f5,$0e,$76,$fe,$fd,$1b,$1e);
C04: array[0..15] of byte = ($5d,$f5,$d1,$fa,$bc,$bb,$dd,$05,
$15,$38,$25,$24,$44,$17,$87,$04);
T04: array[0..15] of byte = ($4c,$43,$cc,$e5,$a5,$74,$d8,$a8,
$8b,$43,$d4,$35,$3b,$d6,$0f,$9f);
K05: array[0..31] of byte = ($40,$41,$42,$43,$44,$45,$46,$47,
$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,
$58,$59,$5a,$5b,$5c,$5d,$5e,$5f);
I05: array[0..11] of byte = ($10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b);
H05: array[0..19] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13);
P05: array[0..23] of byte = ($20,$21,$22,$23,$24,$25,$26,$27,
$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37);
C05: array[0..23] of byte = ($59,$1b,$1f,$f2,$72,$b4,$32,$04,
$86,$8f,$fc,$7b,$c7,$d5,$21,$99,
$35,$26,$b6,$fa,$32,$24,$7c,$3c);
T05: array[0..15] of byte = ($7d,$e1,$2a,$56,$70,$e5,$70,$d8,
$ca,$e6,$24,$a1,$6d,$f0,$9c,$08);
K07: array[0..31] of byte = ($40,$41,$42,$43,$44,$45,$46,$47,
$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,
$58,$59,$5a,$5b,$5c,$5d,$5e,$5f);
I07: array[0..11] of byte = ($10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b);
H07: array[0..31] of byte = ($20,$21,$22,$23,$24,$25,$26,$27,
$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,
$38,$39,$3a,$3b,$3c,$3d,$3e,$3f);
P07: array[0..255] of byte =($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
$20,$21,$22,$23,$24,$25,$26,$27,
$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,
$38,$39,$3a,$3b,$3c,$3d,$3e,$3f,
$40,$41,$42,$43,$44,$45,$46,$47,
$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,
$58,$59,$5a,$5b,$5c,$5d,$5e,$5f,
$60,$61,$62,$63,$64,$65,$66,$67,
$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
$70,$71,$72,$73,$74,$75,$76,$77,
$78,$79,$7a,$7b,$7c,$7d,$7e,$7f,
$80,$81,$82,$83,$84,$85,$86,$87,
$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
$90,$91,$92,$93,$94,$95,$96,$97,
$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
$a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,
$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,
$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
$c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,
$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
$d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,
$d8,$d9,$da,$db,$dc,$dd,$de,$df,
$e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,
$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
$f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
C07: array[0..255] of byte =($79,$3b,$3f,$d2,$52,$94,$12,$24,
$a6,$af,$dc,$5b,$e7,$f5,$01,$b9,
$15,$06,$96,$da,$12,$04,$5c,$1c,
$60,$77,$d3,$ca,$c7,$74,$ac,$cf,
$c3,$d5,$30,$d8,$48,$d6,$65,$d8,
$1a,$49,$cb,$b5,$00,$b8,$8b,$bb,
$62,$4a,$e6,$1d,$16,$67,$22,$9c,
$30,$2d,$c6,$ff,$0b,$b4,$d7,$0b,
$db,$bc,$85,$66,$d6,$f5,$b1,$58,
$da,$99,$a2,$ff,$2e,$01,$dd,$a6,
$29,$b8,$9c,$34,$ad,$1e,$5f,$eb,
$a7,$0e,$7a,$ae,$43,$28,$28,$9c,
$36,$29,$b0,$58,$83,$50,$58,$1c,
$a8,$b9,$7c,$cf,$12,$58,$fa,$3b,
$be,$2c,$50,$26,$04,$7b,$a7,$26,
$48,$96,$9c,$ff,$8b,$a1,$0a,$e3,
$0e,$05,$93,$5d,$f0,$c6,$93,$74,
$18,$92,$b7,$6f,$af,$67,$13,$3a,
$bd,$2c,$f2,$03,$11,$21,$bd,$8b,
$b3,$81,$27,$a4,$d2,$ee,$de,$ea,
$13,$27,$64,$94,$f4,$02,$cd,$7c,
$10,$7f,$b3,$ec,$3b,$24,$78,$48,
$34,$33,$8e,$55,$43,$62,$87,$09,
$2a,$c4,$a2,$6f,$5e,$a7,$ea,$4a,
$d6,$8d,$73,$15,$16,$39,$b0,$5b,
$24,$e6,$8b,$98,$16,$d1,$39,$83,
$76,$d8,$e4,$13,$85,$94,$75,$8d,
$b9,$ad,$3b,$40,$92,$59,$b2,$6d,
$cf,$c0,$6e,$72,$2b,$e9,$87,$b3,
$76,$7f,$70,$a7,$b8,$56,$b7,$74,
$b1,$ba,$26,$85,$b3,$68,$09,$14,
$29,$fc,$cb,$8d,$cd,$de,$09,$e4);
T07: array[0..15] of byte = ($87,$ec,$83,$7a,$bf,$53,$28,$55,
$b2,$ce,$a1,$69,$d6,$94,$3f,$cd);
K08: array[0..31] of byte = ($fb,$76,$15,$b2,$3d,$80,$89,$1d,
$d4,$70,$98,$0b,$c7,$95,$84,$c8,
$b2,$fb,$64,$ce,$60,$97,$87,$8d,
$17,$fc,$e4,$5a,$49,$e8,$30,$b7);
I08: array[0..11] of byte = ($db,$d1,$a3,$63,$60,$24,$b7,$b4,
$02,$da,$7d,$6f);
H08: array[0.. 0] of byte = ($36);
P08: array[0.. 0] of byte = ($a9);
C08: array[0.. 0] of byte = ($0a);
T08: array[0..15] of byte = ($be,$98,$7d,$00,$9a,$4b,$34,$9a,
$a8,$0c,$b9,$c4,$eb,$c1,$e9,$f4);
K09: array[0..31] of byte = ($f8,$d4,$76,$cf,$d6,$46,$ea,$6c,
$23,$84,$cb,$1c,$27,$d6,$19,$5d,
$fe,$f1,$a9,$f3,$7b,$9c,$8d,$21,
$a7,$9c,$21,$f8,$cb,$90,$d2,$89);
I09: array[0..11] of byte = ($db,$d1,$a3,$63,$60,$24,$b7,$b4,
$02,$da,$7d,$6f);
H09: array[0..19] of byte = ($7b,$d8,$59,$a2,$47,$96,$1a,$21,
$82,$3b,$38,$0e,$9f,$e8,$b6,$50,
$82,$ba,$61,$d3);
P09: array[0..19] of byte = ($90,$ae,$61,$cf,$7b,$ae,$bd,$4c,
$ad,$e4,$94,$c5,$4a,$29,$ae,$70,
$26,$9a,$ec,$71);
C09: array[0..19] of byte = ($ce,$20,$27,$b4,$7a,$84,$32,$52,
$01,$34,$65,$83,$4d,$75,$fd,$0f,
$07,$29,$75,$2e);
T09: array[0..15] of byte = ($ac,$d8,$83,$38,$37,$ab,$0e,$de,
$84,$f4,$74,$8d,$a8,$89,$9c,$15);
K10: array[0..31] of byte = ($db,$bc,$85,$66,$d6,$f5,$b1,$58,
$da,$99,$a2,$ff,$2e,$01,$dd,$a6,
$29,$b8,$9c,$34,$ad,$1e,$5f,$eb,
$a7,$0e,$7a,$ae,$43,$28,$28,$9c);
I10: array[0..15] of byte = ($cf,$c0,$6e,$72,$2b,$e9,$87,$b3,
$76,$7f,$70,$a7,$b8,$56,$b7,$74);
P10: array[0..15] of byte = ($ce,$20,$27,$b4,$7a,$84,$32,$52,
$01,$34,$65,$83,$4d,$75,$fd,$0f);
C10: array[0..15] of byte = ($dc,$03,$e5,$24,$83,$0d,$30,$f8,
$8e,$19,$7f,$3a,$ca,$ce,$66,$ef);
T10: array[0..15] of byte = ($99,$84,$ef,$f6,$90,$57,$55,$d1,
$83,$6f,$2d,$b0,$40,$89,$63,$4c);
K11: array[0..31] of byte = ($0e,$05,$93,$5d,$f0,$c6,$93,$74,
$18,$92,$b7,$6f,$af,$67,$13,$3a,
$bd,$2c,$f2,$03,$11,$21,$bd,$8b,
$b3,$81,$27,$a4,$d2,$ee,$de,$ea);
I11: array[0..16] of byte = ($74,$b1,$ba,$26,$85,$b3,$68,$09,
$14,$29,$fc,$cb,$8d,$cd,$de,$09,
$e4);
H11: array[0..19] of byte = ($7b,$d8,$59,$a2,$47,$96,$1a,$21,
$82,$3b,$38,$0e,$9f,$e8,$b6,$50,
$82,$ba,$61,$d3);
P11: array[0..19] of byte = ($90,$ae,$61,$cf,$7b,$ae,$bd,$4c,
$ad,$e4,$94,$c5,$4a,$29,$ae,$70,
$26,$9a,$ec,$71);
C11: array[0..19] of byte = ($6b,$e6,$5e,$56,$06,$6c,$40,$56,
$73,$8c,$03,$fe,$23,$20,$97,$4b,
$a3,$f6,$5e,$09);
T11: array[0..15] of byte = ($61,$08,$dc,$41,$7b,$f3,$2f,$7f,
$b7,$55,$4a,$e5,$2f,$08,$8f,$87);
begin
fail := 0;
writeln('Test cases AES_GCM from Brian Gladman/IEEE P1619.1');
single_test(@T01,16,K01,8*sizeof(K01),@I01,sizeof(I01),nil ,0 ,@C01,sizeof(C01),@P01,01);
single_test(@T02,16,K02,8*sizeof(K02),@I02,sizeof(I02),@H02,sizeof(H02),nil ,0 ,nil ,02);
single_test(@T03,16,K03,8*sizeof(K03),@I03,sizeof(I03),@H03,sizeof(H03),@C03,sizeof(C03),@P03,03);
single_test(@T04,16,K04,8*sizeof(K04),@I04,sizeof(I04),nil ,0 ,@C04,sizeof(C04),@P04,04);
single_test(@T05,16,K05,8*sizeof(K05),@I05,sizeof(I05),@H05,sizeof(H05),@C05,sizeof(C05),@P05,05);
single_test(@T07,16,K07,8*sizeof(K07),@I07,sizeof(I07),@H07,sizeof(H07),@C07,sizeof(C07),@P07,07);
single_test(@T08,16,K08,8*sizeof(K08),@I08,sizeof(I08),@H08,sizeof(H08),@C08,sizeof(C08),@P08,08);
single_test(@T09,16,K09,8*sizeof(K09),@I09,sizeof(I09),@H09,sizeof(H09),@C09,sizeof(C09),@P09,09);
single_test(@T10,16,K10,8*sizeof(K10),@I10,sizeof(I10),nil ,0 ,@C10,sizeof(C10),@P10,10);
single_test(@T11,16,K11,8*sizeof(K11),@I11,sizeof(I11),@H11,sizeof(H11),@C11,sizeof(C11),@P11,11);
if fail=0 then writeln('All tests passed.')
else writeln('*** Number of failed tests: ', fail);
end;
begin
write('Test program for AES-GCM functions');
{$ifdef USEDLL}
write(' [AES_DLL V',AES_DLL_Version,']');
{$endif}
writeln(' (C) 2010 W.Ehrhardt');
writeln;
testspec;
writeln;
test_glad2;
writeln;
tsd_test;
end.

220
Tocsg.Lib/VCL/EncLib/AES/t_aesofb.pas Normal file
View File

@ -0,0 +1,220 @@
{-Test prog for AES OFB, we Sep.2003}
program T_AESOFB;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_OFB, mem_util, BTypes;
var
Context: TAESContext;
Err : integer;
{---------------------------------------------------------------------------}
procedure CheckError;
begin
if Err<>0 then writeln('Error ',Err);
end;
{---------------------------------------------------------------------------}
procedure SimpleTests;
{-Simple encrypt/decrypt test for AES-OFB mode}
const
Key128 : array[0..15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f);
Key192 : array[0..23] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17);
Key256 : array[0..31] of byte = ($00, $01, $02, $03, $04, $05, $06, $07,
$08, $09, $0a, $0b, $0c, $0d, $0e, $0f,
$10, $11, $12, $13, $14, $15, $16, $17,
$18, $19, $1a, $1b, $1c, $1d, $1e, $1f);
const
sample = 'This is a short test sample text for AES OFB mode'#0;
var
i : integer;
ct, pt, plain: array[1..length(sample)] of char8;
IV : TAESBlock;
procedure CheckRes;
begin
writeln('Decr(Encr)=Id : ',CompMem(@pt, @plain, sizeof(plain)));
end;
begin
for i:=0 to 15 do IV[i] := random(256);
plain := sample;
writeln;
writeln('============================================');
writeln('Simple encrypt/decrypt test for AES-OFB mode');
writeln('Org. plain text: ', plain);
writeln;
writeln('++++ 128 bit key ++++');
pt := plain;
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_OFB_Init(key128, 128, IV, context);
for i:=1 to sizeof(plain) do begin
Err := AES_OFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
writeln;
writeln('++++ 192 bit key ++++');
pt := plain;
Err := AES_OFB_Init(key192, 192, IV, context);
Err := AES_OFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_OFB_Init(key192, 192, IV, context);
Err := AES_OFB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_OFB_Init(key192, 192, IV, context);
for i:=1 to sizeof(plain) do begin
Err := AES_OFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
writeln;
writeln('++++ 256 bit key ++++');
pt := plain;
Err := AES_OFB_Init(key256, 256, IV, context);
Err := AES_OFB_Encrypt(@pt, @ct, sizeof(plain), context);
CheckError;
pt := ct;
Err := AES_OFB_Init(key256, 256, IV, context);
Err := AES_OFB_Decrypt(@pt, @pt, sizeof(plain), context);
CheckError;
writeln('Block Encr/decr: ', pt);
CheckRes;
Err := AES_OFB_Init(key256, 256, IV, context);
for i:=1 to sizeof(plain) do begin
Err := AES_OFB_Decrypt(@ct[i], @pt[i], 1, context);
end;
CheckError;
writeln(' Char Encr/decr: ', pt);
end;
{---------------------------------------------------------------------------}
procedure NistTests;
{-NIST SP 800-38A OFB/AES Tests}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
plain : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
ct1 : array[0..63] of byte = ($3b,$3f,$d9,$2e,$b7,$2d,$ad,$20,
$33,$34,$49,$f8,$e8,$3c,$fb,$4a,
$77,$89,$50,$8d,$16,$91,$8f,$03,
$f5,$3c,$52,$da,$c5,$4e,$d8,$25,
$97,$40,$05,$1e,$9c,$5f,$ec,$f6,
$43,$44,$f7,$a8,$22,$60,$ed,$cc,
$30,$4c,$65,$28,$f6,$59,$c7,$78,
$66,$a5,$10,$d9,$c1,$d6,$ae,$5e);
ct2 : array[0..63] of byte = ($cd,$c8,$0d,$6f,$dd,$f1,$8c,$ab,
$34,$c2,$59,$09,$c9,$9a,$41,$74,
$fc,$c2,$8b,$8d,$4c,$63,$83,$7c,
$09,$e8,$17,$00,$c1,$10,$04,$01,
$8d,$9a,$9a,$ea,$c0,$f6,$59,$6f,
$55,$9c,$6d,$4d,$af,$59,$a5,$f2,
$6d,$9f,$20,$08,$57,$ca,$6c,$3e,
$9c,$ac,$52,$4b,$d9,$ac,$c9,$2a);
ct3 : array[0..63] of byte = ($dc,$7e,$84,$bf,$da,$79,$16,$4b,
$7e,$cd,$84,$86,$98,$5d,$38,$60,
$4f,$eb,$dc,$67,$40,$d2,$0b,$3a,
$c8,$8f,$6a,$d8,$2a,$4f,$b0,$8d,
$71,$ab,$47,$a0,$86,$e8,$6e,$ed,
$f3,$9d,$1c,$5b,$ba,$97,$c4,$08,
$01,$26,$14,$1d,$67,$f3,$7b,$e8,
$53,$8f,$5a,$8b,$e7,$40,$e4,$84);
var
ct: array[0..255] of byte;
begin
writeln;
writeln('=============================');
writeln('NIST SP 800-38A OFB/AES tests');
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.4.1 OFB-AES128.Encrypt - OK: ',CompMem(@ct1, @ct, sizeof(ct1)));
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Decrypt(@ct1, @ct, sizeof(ct1), context);
CheckError;
writeln('Test F.4.2 OFB-AES128.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_OFB_Init(key192, 192, IV, context);
Err := AES_OFB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.4.3 OFB-AES192.Encrypt - OK: ',CompMem(@ct2, @ct, sizeof(ct2)));
Err := AES_OFB_Init(key192, 192, IV, context);
Err := AES_OFB_Decrypt(@ct2, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.4.4 OFB-AES192.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
Err := AES_OFB_Init(key256, 256, IV, context);
Err := AES_OFB_Encrypt(@plain, @ct, sizeof(plain), context);
CheckError;
writeln('Test F.4.5 OFB-AES256.Encrypt - OK: ',CompMem(@ct3, @ct, sizeof(ct3)));
Err := AES_OFB_Init(key256, 256, IV, context);
Err := AES_OFB_Decrypt(@ct3, @ct, sizeof(ct3), context);
CheckError;
writeln('Test F.4.6 OFB-AES256.Decrypt - OK: ',CompMem(@plain, @ct, sizeof(plain)));
end;
begin
SimpleTests;
NistTests;
end.

226
Tocsg.Lib/VCL/EncLib/AES/t_aestab.pas Normal file
View File

@ -0,0 +1,226 @@
program t_aestab;
(*************************************************************************
DESCRIPTION : Calculate static AES tables
REQUIREMENTS : TP5-7, D1-D7/D9-D10, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] http://csrc.nist.gov/fips/fips-197.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
1.00 17.09.03 we Init version
1.01 18.09.03 we duplicate GF routines and rotword
1.10 05.10.03 we STD.INC, TP5-6
1.20 09.01.04 we Sbox is calculated, uses only mem_util
1.21 11.04.04 we D7, {$apptype console} if needed
1.22 27.17.04 we Te0..Te4, Td0..Td4
**************************************************************************)
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
mem_util;
type
bytearray = array[byte] of byte;
longarray = array[byte] of longint;
{encr}
var
SBox: bytearray;
Te0,Te1,Te2,Te3,Te4: longarray;
{decr}
var
InvSBox: bytearray;
GLog, GPow: bytearray;
Td0,Td1,Td2,Td3,Td4: longarray;
{---------------------------------------------------------------------------}
procedure CalcBaseTables;
{-Calculate dynamic tables: power, log}
var
i, p: byte;
begin
{Power/Log tables}
p := 1;
for i:=0 to 254 do begin
GPow[i] := p;
GLog[p] := i;
if p and $80 = 0 then p := (p shl 1) xor p
else p := (p shl 1) xor p xor $1B;
end;
GPow[255] := 1;
end;
{---------------------------------------------------------------------------}
function GMul(x,y: byte): byte;
{-calculate x*y in GF(2^8)}
var
i: word;
begin
if (x=0) or (y=0) then GMul := 0
else begin
i := word(GLog[x])+word(GLog[y]);
if i>=255 then dec(i,255);
GMul := GPow[i];
end;
end;
{---------------------------------------------------------------------------}
function GM32(x,y: byte): longint;
{-calculate x*y in GF(2^8) result as longint}
begin
GM32 := GMul(x,y);
end;
{---------------------------------------------------------------------------}
procedure RotWord(var w: longint);
{-rotate AES word}
type
TBA4 = packed array[0..3] of byte;
var
b: TBA4 absolute w;
t: byte;
begin
t := b[0];
b[0] := b[1];
b[1] := b[2];
b[2] := b[3];
b[3] := t;
end;
{---------------------------------------------------------------------------}
procedure CalcEncrTables;
{-Calculate dynamic encr tables Te0..Te4, SBox}
var
i, p: byte;
t: longint;
function rot(b,n: byte): byte;
begin
rot := (b shr n) xor (b shl (8-n));
end;
begin
for i:=0 to 255 do begin
end;
for i:=0 to 255 do begin
{SBox calculation, cf. [1] 5.1.1}
if i=0 then p:=0 else p:=GPow[255-GLog[i]]; {p*i = 1}
p := p xor rot(p,4) xor rot(p,5) xor rot(p,6) xor rot(p,7) xor $63;
Sbox[i] := p;
Te4[i] := $01010101*p;
{Tex tables}
t := GM32(2,p) or (longint(p) shl 8) or (longint(p) shl 16) or (GM32(3,p) shl 24);
Te0[i] := t;
RotWord(t);
Te3[i] := t;
RotWord(t);
Te2[i] := t;
RotWord(t);
Te1[i] := t;
end;
end;
{---------------------------------------------------------------------------}
procedure CalcDecrTables;
{-Calculate dynamic decr. tables: Td0..Td4, inverse SBox}
var
i, p: byte;
t: longint;
begin
{InvSBox}
for i:=0 to 255 do InvSBox[SBox[i]] := i;
{Tdx tables}
for i:=0 to 255 do begin
p := InvSBox[i];
Td4[i] := $01010101*p;
t := GM32(14,p) or (GM32(9,p) shl 8) or (GM32(13,p) shl 16) or (GM32(11,p) shl 24);
Td0[i] := t;
RotWord(t);
Td3[i] := t;
RotWord(t);
Td2[i] := t;
RotWord(t);
Td1[i] := t;
end;
end;
{---------------------------------------------------------------------------}
procedure DumpByteTab(VName: string; var BA: bytearray);
{-dump an array of bytes}
var
i: integer;
begin
writeln;
writeln(VName, ': array[byte] of byte = (');
for i:= 0 to 255 do begin
write(' $',HexByte(BA[i]));
if i=255 then writeln(');')
else if i and 15 = 15 then writeln(',')
else write(',');
end;
end;
{---------------------------------------------------------------------------}
procedure DumpLongTab(VName: string; var LA: longarray);
{-dump an array of longint}
var
i: integer;
begin
writeln;
writeln(VName, ': array[byte] of longint = (');
for i:= 0 to 255 do begin
write(' $',HexLong(LA[i]));
if i=255 then writeln(');')
else if i and 7 = 7 then writeln(',')
else write(',');
end;
end;
begin
CalcBaseTables;
CalcEncrTables;
CalcDecrTables;
DumpByteTab('GLog', GLog);
DumpByteTab('GPow', GPow);
DumpByteTab('SBox', SBox);
DumpByteTab('InvSBox', InvSBox);
DumpLongTab('Te0', Te0);
DumpLongTab('Te1', Te1);
DumpLongTab('Te2', Te2);
DumpLongTab('Te3', Te3);
DumpLongTab('Te4', Te4);
DumpLongTab('Td0', Td0);
DumpLongTab('Td1', Td1);
DumpLongTab('Td2', Td2);
DumpLongTab('Td3', Td3);
DumpLongTab('Td4', Td4);
end.

198
Tocsg.Lib/VCL/EncLib/AES/t_cbccts.pas Normal file
View File

@ -0,0 +1,198 @@
{-Test prog for AES CBC cipher text stealing, we Sep.2003}
program T_CBCCTS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
aes_type, aes_cbc,
{$endif}
mem_util;
const
BSIZE = $400;
var
Context: TAESContext;
pt, pt0, ct, ct0, pd: array[1..BSIZE+2] of byte;
{RFC 3962 Advanced Encryption Standard (AES) Encryption for Kerberos 5}
{Appendix B. Sample Test Vectors}
const
key128 : array[0..15] of byte = ($63,$68,$69,$63,$6b,$65,$6e,$20,
$74,$65,$72,$69,$79,$61,$6b,$69);
IV : TAESBlock = ($00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00);
pt1: array[0..16] of byte = ($49,$20,$77,$6f,$75,$6c,$64,$20,
$6c,$69,$6b,$65,$20,$74,$68,$65,
$20);
ct1: array[0..16] of byte = ($c6,$35,$35,$68,$f2,$bf,$8c,$b4,
$d8,$a5,$80,$36,$2d,$a7,$ff,$7f,
$97);
pt2: array[0..30] of byte = ($49,$20,$77,$6f,$75,$6c,$64,$20,
$6c,$69,$6b,$65,$20,$74,$68,$65,
$20,$47,$65,$6e,$65,$72,$61,$6c,
$20,$47,$61,$75,$27,$73,$20);
ct2: array[0..30] of byte = ($fc,$00,$78,$3e,$0e,$fd,$b2,$c1,
$d4,$45,$d4,$c8,$ef,$f7,$ed,$22,
$97,$68,$72,$68,$d6,$ec,$cc,$c0,
$c0,$7b,$25,$e2,$5e,$cf,$e5);
pt3: array[0..31] of byte = ($49,$20,$77,$6f,$75,$6c,$64,$20,
$6c,$69,$6b,$65,$20,$74,$68,$65,
$20,$47,$65,$6e,$65,$72,$61,$6c,
$20,$47,$61,$75,$27,$73,$20,$43);
ct3: array[0..31] of byte = ($39,$31,$25,$23,$a7,$86,$62,$d5,
$be,$7f,$cb,$cc,$98,$eb,$f5,$a8,
$97,$68,$72,$68,$d6,$ec,$cc,$c0,
$c0,$7b,$25,$e2,$5e,$cf,$e5,$84);
pt4: array[0..46] of byte = ($49,$20,$77,$6f,$75,$6c,$64,$20,
$6c,$69,$6b,$65,$20,$74,$68,$65,
$20,$47,$65,$6e,$65,$72,$61,$6c,
$20,$47,$61,$75,$27,$73,$20,$43,
$68,$69,$63,$6b,$65,$6e,$2c,$20,
$70,$6c,$65,$61,$73,$65,$2c);
ct4: array[0..46] of byte = ($97,$68,$72,$68,$d6,$ec,$cc,$c0,
$c0,$7b,$25,$e2,$5e,$cf,$e5,$84,
$b3,$ff,$fd,$94,$0c,$16,$a1,$8c,
$1b,$55,$49,$d2,$f8,$38,$02,$9e,
$39,$31,$25,$23,$a7,$86,$62,$d5,
$be,$7f,$cb,$cc,$98,$eb,$f5);
pt5: array[0..47] of byte = ($49,$20,$77,$6f,$75,$6c,$64,$20,
$6c,$69,$6b,$65,$20,$74,$68,$65,
$20,$47,$65,$6e,$65,$72,$61,$6c,
$20,$47,$61,$75,$27,$73,$20,$43,
$68,$69,$63,$6b,$65,$6e,$2c,$20,
$70,$6c,$65,$61,$73,$65,$2c,$20);
ct5: array[0..47] of byte = ($97,$68,$72,$68,$d6,$ec,$cc,$c0,
$c0,$7b,$25,$e2,$5e,$cf,$e5,$84,
$9d,$ad,$8b,$bb,$96,$c4,$cd,$c0,
$3b,$c1,$03,$e1,$a1,$94,$bb,$d8,
$39,$31,$25,$23,$a7,$86,$62,$d5,
$be,$7f,$cb,$cc,$98,$eb,$f5,$a8);
{---------------------------------------------------------------------------}
procedure RFC_Test;
{-Test with known vectors}
procedure SingleTest(pp,pc: pointer; lt,n: word);
var
cmp: boolean;
begin
if AES_CBC_Init_Encr(key128, 128, IV, context)<>0 then begin
writeln('*** Error CBC_Init');
exit;
end;
if AES_CBC_Encrypt(pp, @ct, lt, context)<>0 then begin
writeln('*** Error CBC');
exit;
end;
cmp := compmem(@ct,pc,lt);
write('Test vector ',n,': ',cmp:6);
{if lt multiple of block size results must not compare}
if (lt mod AESBLKSIZE=0) <> cmp then writeln(' OK')
else writeln('Error');
end;
begin
SingleTest(@pt1,@ct1,sizeof(pt1),1);
SingleTest(@pt2,@ct2,sizeof(pt2),2);
SingleTest(@pt3,@ct3,sizeof(pt3),3);
SingleTest(@pt4,@ct4,sizeof(pt4),4);
SingleTest(@pt5,@ct5,sizeof(pt5),5);
end;
{---------------------------------------------------------------------------}
procedure Rand_Test;
{-Test with random plain text}
var
n,Err: integer;
begin
randmem(@pt0, sizeof(pt0));
pt := pt0;
for n:=1 to BSIZE do begin
if AES_CBC_Init_Encr(key128, 128, IV, context)<>0 then begin
writeln('*** Error CBC_Init_Encr');
exit;
end;
Err := AES_CBC_Encrypt(@pt, @ct, n, context);
if not compmem(@pt,@pt0,n+2) then begin
writeln('Encr: src overwrite, n: ',n);
halt;
end;
if Err=0 then begin
ct0 := ct;
if AES_CBC_Init_Decr(key128, 128, IV, context)<>0 then begin
writeln('*** Error CBC_Init_Decr');
exit;
end;
Err := AES_CBC_Decrypt(@ct, @pd, n, context);
if Err=0 then begin
if not CompMem(@pt, @pd, n) then writeln(n:6, ' Diff');
end;
if not compmem(@ct,@ct0,n+2) then begin
writeln('Decr: src overwrite, n: ',n);
halt;
end;
end;
if Err<>0 then begin
write(n:6, ' Error: ', Err);
if (n<AESBLKSIZE) and (Err=AES_Err_Invalid_Length) then write(' (OK)');
writeln;
end;
end;
end;
begin
writeln;
{$ifdef USEDLL}
writeln('Test program for AES_DLL V',AES_DLL_Version,' (C) 2004-2008 W.Ehrhardt');
{$else}
writeln('Test program for AES functions (C) 2004-2008 W.Ehrhardt');
{$endif}
writeln('AES-CBC cipher text stealing');
writeln;
writeln('Test with random plain text');
writeln('---------------------------');
Rand_Test;
writeln;
writeln('Test vectors from RFC 3962');
writeln('--------------------------');
RFC_Test;
end.

138
Tocsg.Lib/VCL/EncLib/AES/t_cmac.pas Normal file
View File

@ -0,0 +1,138 @@
{-Test program for CMAC, (c) we 07.2006, essentially OMAC1 part of T_OMAC}
program T_CMAC;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifdef J_OPT}
{$J+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
AES_Type, AES_CMAC,
{$endif}
Mem_Util;
(*
Keys, msg, and tag data taken from:
http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/tv/omac1-tv.txt and
http://csrc.nist.gov/publications/nistpubs/800-38B/SP_800-38B.pdf
*)
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
const
msg : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
const
tag00: TAESBlock = ($bb,$1d,$69,$29,$e9,$59,$37,$28,$7f,$a3,$7d,$12,$9b,$75,$67,$46);
tag01: TAESBlock = ($07,$0a,$16,$b4,$6b,$4d,$41,$44,$f7,$9b,$dd,$9d,$d0,$4a,$28,$7c);
tag02: TAESBlock = ($df,$a6,$67,$47,$de,$9a,$e6,$30,$30,$ca,$32,$61,$14,$97,$c8,$27);
tag03: TAESBlock = ($51,$f0,$be,$bf,$7e,$3b,$9d,$92,$fc,$49,$74,$17,$79,$36,$3c,$fe);
tag10: TAESBlock = ($d1,$7d,$df,$46,$ad,$aa,$cd,$e5,$31,$ca,$c4,$83,$de,$7a,$93,$67);
tag11: TAESBlock = ($9e,$99,$a7,$bf,$31,$e7,$10,$90,$06,$62,$f6,$5e,$61,$7c,$51,$84);
tag12: TAESBlock = ($8a,$1d,$e5,$be,$2e,$b3,$1a,$ad,$08,$9a,$82,$e6,$ee,$90,$8b,$0e);
tag13: TAESBlock = ($a1,$d5,$df,$0e,$ed,$79,$0f,$79,$4d,$77,$58,$96,$59,$f3,$9a,$11);
tag20: TAESBlock = ($02,$89,$62,$f6,$1b,$7b,$f8,$9e,$fc,$6b,$55,$1f,$46,$67,$d9,$83);
tag21: TAESBlock = ($28,$a7,$02,$3f,$45,$2e,$8f,$82,$bd,$4b,$f2,$8d,$8c,$37,$c3,$5c);
tag22: TAESBlock = ($aa,$f3,$d8,$f1,$de,$56,$40,$c2,$32,$f5,$b1,$69,$b9,$c9,$11,$e6);
tag23: TAESBlock = ($e1,$99,$21,$90,$54,$9f,$6e,$d5,$69,$6a,$2c,$05,$6c,$31,$54,$10);
var
ctx: TAESContext;
tag: TAESBlock;
{---------------------------------------------------------------------------}
procedure Test(var key; KL,ML: word; var st: TAESBlock; Hdr: string);
{-Test one CMAC example with key and message lenght ML, st: known tag }
{ tags are calculated two times: 1. single call of AES_CMAC_Update with}
{ complete msg, 2. AES_CMAC_Update for each byte of msg }
const
Res: array[boolean] of string[5] = ('Error', 'OK');
var
i: word;
begin
write(hdr);
if AES_CMAC_Init(key, KL, ctx)<>0 then begin
writeln('AES_CMAC_Init Error');
halt;
end;
if AES_CMAC_Update(@msg, ML, ctx)<>0 then begin
writeln('AES_CMAC_Update');
halt;
end;
AES_CMAC_Final(tag, ctx);
write(Res[CompMem(@tag, @st, sizeof(tag))]:8);
if AES_CMAC_Init(key, KL, ctx)<>0 then begin
writeln('AES_CMAC_Init Error');
halt;
end;
for i:=1 to ML do begin
if AES_CMAC_Update(@msg[i-1], 1, ctx)<>0 then begin
writeln('AES_CMAC_Update');
halt;
end;
end;
AES_CMAC_Final(tag, ctx);
writeln(Res[CompMem(@tag, @st, sizeof(tag))]:8);
end;
begin
writeln('Test program AES CMAC mode (C) 2004-2006 W.Ehrhardt');
{$ifdef USEDLL}
writeln('DLL Version: ',AES_DLL_Version);
{$endif}
writeln('KL/ML: Key/Message length in bits/bytes');
writeln('Single/Multi: process message with one/multiple call(s)');
writeln(' KL/ML Single Multi');
Test(key128, 128, 0, tag00, ' 128/00');
Test(key128, 128, 16, tag01, ' 128/16');
Test(key128, 128, 40, tag02, ' 128/40');
Test(key128, 128, 64, tag03, ' 128/64');
Test(key192, 192, 0, tag10, ' 192/00');
Test(key192, 192, 16, tag11, ' 192/16');
Test(key192, 192, 40, tag12, ' 192/40');
Test(key192, 192, 64, tag13, ' 192/64');
Test(key256, 256, 0, tag20, ' 256/00');
Test(key256, 256, 16, tag21, ' 256/16');
Test(key256, 256, 40, tag22, ' 256/40');
Test(key256, 256, 64, tag23, ' 256/64');
end.

19
Tocsg.Lib/VCL/EncLib/AES/t_cprf.pas Normal file
View File

@ -0,0 +1,19 @@
{-Test program for aes_cprf, (c) we 05.2007}
program T_CPRF;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_cprf;
begin
writeln('Selftest AES CMAC PRF-128: ', AES_CPRF128_selftest);
end.

142
Tocsg.Lib/VCL/EncLib/AES/t_eax2.pas Normal file
View File

@ -0,0 +1,142 @@
{-Test prog for EAX, we AUg.2008}
{ 1. Reproduce AES part of Tom St Denis' EAX_TV.TXT}
{ 2. All-in-one EAX functions for message length >= 60K}
program T_EAX2;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
AES_Type, AES_EAX, Mem_Util;
var
print: boolean;
{---------------------------------------------------------------------------}
procedure test;
{-Reproduce AES part of Tom St Denis' EAX_TV.TXT}
const
hex32: array[1..32] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,
$18,$19,$1a,$1b,$1c,$1d,$1e,$1f);
buf32: array[0..31] of byte = ($64,$d8,$42,$b6,$67,$96,$a7,$97,
$c2,$b4,$c6,$90,$57,$42,$fd,$f2,
$14,$8f,$fc,$44,$5e,$19,$2f,$9e,
$03,$b5,$38,$10,$c0,$82,$f7,$88);
tag32: array[0..15] of byte = ($97,$78,$b3,$45,$ec,$12,$d2,$22,
$dc,$c6,$db,$ab,$d2,$65,$17,$50);
var
err,n: integer;
ctx: TAES_EAXContext;
key, tag: TAESBlock;
buf: array[0..63] of byte;
begin
writeln('Reproduce AES part of Tom St Denis'' EAX_TV.TXT');
{Uppercase from HexStr}
HexUpper := true;
{Initial key from hex32}
move(hex32, key, sizeof(key));
for n:=0 to 32 do begin
err := AES_EAX_Init(key, 128, hex32, n, ctx);
if err=0 then err := AES_EAX_Provide_Header(@hex32,n,ctx);
if err=0 then err := AES_EAX_Encrypt(@hex32, @buf, n, ctx);
if err=0 then begin
AES_EAX_Final(tag, ctx);
if print then writeln(n:3,': ', HexStr(@buf,n), ', ', HexStr(@tag,16));
{key for step n>1 is the tag of the previous step repeated}
key := tag;
end
else begin
writeln('Error ',err);
exit;
end;
end;
{compare final values}
writeln('buf32 compares: ', compmem(@buf32, @buf, sizeof(buf32)));
writeln('tag32 compares: ', compmem(@tag32, @tag, sizeof(tag32)));
end;
{$ifndef BIT16}
const
PAKETSIZE = $23456;
{$else}
const
PAKETSIZE = $F000;
{$endif}
{---------------------------------------------------------------------------}
procedure testallin1;
type
tpaket=array[1..PAKETSIZE] of byte;
ppaket=^ tpaket;
var
pt,ct: ppaket;
tag: TAESBlock;
i: longint;
err: integer;
const
key: array[1..16] of byte = ($91, $94, $5d, $3f, $4d, $cb, $ee, $0b,
$f4, $5e, $f5, $22, $55, $f0, $95, $a4);
non: array[1..16] of byte = ($be, $ca, $f0, $43, $b0, $a2, $3d, $84,
$31, $94, $ba, $97, $2c, $66, $de, $bd);
hdr: array[1..08] of byte = ($fa, $3b, $fd, $48, $06, $eb, $53, $fa);
begin
writeln('Test all-in-one EAX functions for large message length: ',PAKETSIZE);
new(pt);
new(ct);
for i:=1 to PAKETSIZE do begin
pt^[i] := i and $ff;
ct^[i] := (i and $ff) xor $ff;
end;
err := AES_EAX_Enc_Auth(tag,Key,128,non,sizeof(non),@hdr,sizeof(hdr),pt,PAKETSIZE,ct);
if err<>0 then writeln('Error from AES_EAX_Enc_Auth: ', err)
else begin
err := AES_EAX_Dec_Veri(@tag,sizeof(tag),key,128,non,sizeof(non),@hdr,sizeof(hdr),ct,PAKETSIZE,ct);
if err<>0 then writeln('Error from AES_EAX_Dec_Veri: ', err)
else begin
{change ciphertest, veri should fail and plaintext should be untouched}
ct^[2] := ct^[2] xor $ff;
ct^[PAKETSIZE-1] := ct^[PAKETSIZE-1] xor $ff;
err := AES_EAX_Dec_Veri(@tag,sizeof(tag),key,128,non,sizeof(non),@hdr,sizeof(hdr),ct,PAKETSIZE,pt);
if err=AES_Err_EAX_Verify_Tag then begin
err := 0;
for i:=1 to PAKETSIZE do begin
if pt^[i] <> (i and $ff) then err := 42;
end;
if err<>0 then writeln('Verification failed BUT decryption done!');
end
else writeln('Detection of change in ciphertext failed!');
end;
end;
if err=0 then writeln('OK');
dispose(pt);
dispose(ct);
end;
var
{$ifdef D12Plus}
s: string;
{$else}
s: string[10];
{$endif}
i: integer;
begin
s := paramstr(1);
for i:=1 to length(s) do s[i] := upcase(s[i]);
print := s<>'TEST';
test;
writeln;
testallin1;
end.

62
Tocsg.Lib/VCL/EncLib/AES/t_ecbcts.pas Normal file
View File

@ -0,0 +1,62 @@
{-Test prog for AES ECB cipher text stealing, we Sep.2003}
program T_ECBCTS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
aes_type, aes_ECB, mem_util;
const
BSIZE = $400;
var
Context: TAESContext;
i,n,Err: integer;
pt, pt0, ct, ct0, pd: array[1..BSIZE+2] of byte;
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
begin
writeln;
writeln('=====================================');
writeln('Test for AES-ECB cipher text stealing');
for i:=1 to BSIZE do pt0[i] := random(256);
pt := pt0;
for n:=1 to BSIZE do begin
Err := AES_ECB_Init_Encr(key128, 128, context);
Err := Err or AES_ECB_Encrypt(@pt, @ct, n, context);
if not compmem(@pt,@pt0,n+2) then begin
writeln('Encr: src overwrite, n: ',n);
halt;
end;
if Err=0 then begin
ct0 := ct;
Err := AES_ECB_Init_Decr(key128, 128, context);
Err := Err or AES_ECB_Decrypt(@ct, @pd, n, context);
if Err=0 then begin
if not CompMem(@pt, @pd, n) then writeln(n:6, ' Diff');
end;
if not compmem(@ct,@ct0,n+2) then begin
writeln('Decr: src overwrite, n: ',n);
halt;
end;
end;
if Err<>0 then begin
write(n:6, ' Error: ', Err);
if (n<AESBLKSIZE) and (Err=AES_Err_Invalid_Length) then write(' (OK)');
writeln;
end;
end;
end.

153
Tocsg.Lib/VCL/EncLib/AES/t_fbmodi.pas Normal file
View File

@ -0,0 +1,153 @@
{-Test prog for AES CTR/CFB/OFB with full blocks first, we Jan.2004}
program T_FBModi;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
AES_type, AES_CTR, AES_CFB, AES_OFB, mem_util;
const
BSIZE = $400;
EXT = 15;
var
Context: TAESContext;
GErr,Err: integer;
pt, pt0, ct, ct0, pd: array[1..BSIZE+EXT] of byte;
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
IV : TAESBlock = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f);
{---------------------------------------------------------------------------}
procedure Test_CTR;
var
i,n: integer;
begin
GErr := 0;
writeln('- CTR with full blocks first');
for i:=1 to BSIZE do pt0[i] := random(256);
pt := pt0;
for n:=1 to BSIZE do begin
Err := AES_CTR_Init(key128, 128, IV, context);
Err := AES_CTR_Encrypt(@pt, @ct, n, context);
GErr:= GErr or Err;
if not compmem(@pt,@pt0,n+EXT) then begin
writeln(' Encr: src overwrite, n: ',n);
halt;
end;
if Err=0 then begin
ct0 := ct;
Err := AES_CTR_Init(key128, 128, IV, context);
Err := AES_CTR_Decrypt(@ct, @pd, n, context);
GErr:= GErr or Err;
if Err=0 then begin
if not CompMem(@pt, @pd, n) then writeln(' Diff:', n:6);
end;
if not compmem(@ct,@ct0,n+EXT) then begin
writeln(' Decr: src overwrite, n: ',n);
halt;
end;
end;
if Err<>0 then writeln(n:6, ' Error: ', Err);
end;
if GErr=0 then writeln(' OK.');
end;
{---------------------------------------------------------------------------}
procedure Test_CFB;
var
i,n: integer;
begin
GErr := 0;
writeln('- CFB with full blocks first');
for i:=1 to BSIZE do pt0[i] := random(256);
pt := pt0;
for n:=1 to BSIZE do begin
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Encrypt(@pt, @ct, n, context);
GErr:= GErr or Err;
if not compmem(@pt,@pt0,n+EXT) then begin
writeln(' Encr: src overwrite, n: ',n);
halt;
end;
if Err=0 then begin
ct0 := ct;
Err := AES_CFB_Init(key128, 128, IV, context);
Err := AES_CFB_Decrypt(@ct, @pd, n, context);
GErr:= GErr or Err;
if Err=0 then begin
if not CompMem(@pt, @pd, n) then writeln(' Diff:', n:6);
end;
if not compmem(@ct,@ct0,n+EXT) then begin
writeln(' Decr: src overwrite, n: ',n);
halt;
end;
end;
if Err<>0 then writeln(n:6, ' Error: ', Err);
end;
if GErr=0 then writeln(' OK.');
end;
{---------------------------------------------------------------------------}
procedure Test_OFB;
var
i,n: integer;
begin
GErr := 0;
writeln('- OFB with full blocks first');
for i:=1 to BSIZE do pt0[i] := random(256);
pt := pt0;
for n:=1 to BSIZE do begin
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Encrypt(@pt, @ct, n, context);
GErr:= GErr or Err;
if not compmem(@pt,@pt0,n+EXT) then begin
writeln(' Encr: src overwrite, n: ',n);
halt;
end;
if Err=0 then begin
ct0 := ct;
Err := AES_OFB_Init(key128, 128, IV, context);
Err := AES_OFB_Decrypt(@ct, @pd, n, context);
GErr:= GErr or Err;
if Err=0 then begin
if not CompMem(@pt, @pd, n) then writeln(' Diff:', n:6);
end;
if not compmem(@ct,@ct0,n+EXT) then begin
writeln(' Decr: src overwrite, n: ',n);
halt;
end;
end;
if Err<>0 then writeln(n:6, ' Error: ', Err);
end;
if GErr=0 then writeln(' OK.');
end;
begin
writeln;
writeln('Test AES CTR/CFB/OFB with full blocks first, WE Jan.2004');
Test_CTR;
Test_CFB;
Test_OFB;
end.

218
Tocsg.Lib/VCL/EncLib/AES/t_gsp128.pas Normal file
View File

@ -0,0 +1,218 @@
{-Test program to measure AES encr/decr speed for 128 bit keys, we 07.2006}
{ displays alignment info for compressed encryption table (if available)}
program t_gsp128;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
{$ifdef X_Opt}
{$x+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
AES_Type, AES_Encr, AES_Decr, hrtimer;
{$i aes_conf.inc}
const
LOOPS = 100;
var
ctx: TAESContext;
key: array[0..31] of byte;
ct : TAESBlock;
pt : TAESBlock;
{---------------------------------------------------------------------------}
procedure RandFill(var block; size: word);
var
ba: array[1..$F000] of byte absolute block;
i: word;
begin
for i:=1 to size do ba[i] := random(256);
end;
{---------------------------------------------------------------------------}
function EncrCycles(keybits: word): longint;
var
i: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
i := AES_Init_Encr(Key, KeyBits, ctx);
if i<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
AES_Encrypt(ctx, pt, ct);
c1 := MaxLongint;
c2 := MaxLongint;
for i:=1 to LOOPS do begin
RandFill(pt, sizeof(pt));
ReadTSC(cyc0);
AES_Encrypt(ctx, pt, ct);
ReadTSC(cyc1);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
EncrCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function DecrCycles(keybits: word): longint;
var
i: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
i := AES_Init_Decr(Key, KeyBits, ctx);
if i<>0 then begin
writeln('Error AES_Init_Decr');
halt;
end;
AES_Decrypt(ctx, pt, ct);
AES_Decrypt(ctx, pt, ct);
c1 := MaxLongint;
c2 := MaxLongint;
for i:=1 to LOOPS do begin
RandFill(pt, sizeof(pt));
ReadTSC(cyc0);
AES_Decrypt(ctx, pt, ct);
ReadTSC(cyc1);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
DecrCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function EncrKeyCycles(keybits: word): longint;
var
i,j: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
c1 := MaxLongint;
c2 := MaxLongint;
j := AES_Init_Encr(Key, KeyBits, ctx);
if j<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
for i:=1 to LOOPS do begin
RandFill(key, sizeof(key));
ReadTSC(cyc0);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
ReadTSC(cyc1);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
EncrKeyCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function DecrKeyCycles(keybits: word): longint;
var
i,j: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
c1 := MaxLongint;
c2 := MaxLongint;
j := AES_Init_Decr(Key, KeyBits, ctx);
if j<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
for i:=1 to LOOPS do begin
RandFill(key, sizeof(key));
ReadTSC(cyc0);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
ReadTSC(cyc1);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
DecrKeyCycles := (c2-c1+1) shr 2;
end;
var
k: word;
ec,dc : array[2..4] of longint;
ek,dk : array[2..4] of longint;
MB : array[2..4] of double;
Align : string[4];
begin
for k:=4 downto 2 do begin
ec[k] := EncrCycles(k*64);
dc[k] := DecrCycles(k*64);
ek[k] := EncrKeyCycles(k*64);
dk[k] := DecrKeyCycles(k*64);
MB[k] := 16*CPUFrequency/ec[k]/1E6;
end;
k := 2;
Align := 'N/A';
{$ifdef AES_Diag}
{$ifdef AES_ComprTab}
str(TCe_Diag,Align);
{$endif}
{$endif}
writeln(k*64:6, ec[k]:8, dc[k]:8, ek[k]:8, dk[k]:8, MB[k]:8:1, Align:6);
end.

215
Tocsg.Lib/VCL/EncLib/AES/t_gspeed.pas Normal file
View File

@ -0,0 +1,215 @@
{-Test prog to compare AES encr/decr speed with Gladmann, we 01.2004}
{ To be roughly compatible, the test layout is analog to AESTMR.CPP }
program t_gspeed;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
{$ifdef X_Opt}
{$x+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
AES_Type, AES_Encr, AES_Decr, hrtimer;
const
LOOPS = 100;
var
ctx: TAESContext;
key: array[0..31] of byte;
ct : TAESBlock;
pt : TAESBlock;
{---------------------------------------------------------------------------}
procedure RandFill(var block; size: word);
var
ba: array[1..$F000] of byte absolute block;
i: word;
begin
for i:=1 to size do ba[i] := random(256);
end;
{---------------------------------------------------------------------------}
function EncrCycles(keybits: word): longint;
var
i: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
i := AES_Init_Encr(Key, KeyBits, ctx);
if i<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
AES_Encrypt(ctx, pt, ct);
c1 := MaxLongint;
c2 := MaxLongint;
for i:=1 to LOOPS do begin
RandFill(pt, sizeof(pt));
ReadTSC(cyc0);
AES_Encrypt(ctx, pt, ct);
ReadTSC(cyc1);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
AES_Encrypt(ctx, ct, ct);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
EncrCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function DecrCycles(keybits: word): longint;
var
i: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
i := AES_Init_Decr(Key, KeyBits, ctx);
if i<>0 then begin
writeln('Error AES_Init_Decr');
halt;
end;
AES_Decrypt(ctx, pt, ct);
AES_Decrypt(ctx, pt, ct);
c1 := MaxLongint;
c2 := MaxLongint;
for i:=1 to LOOPS do begin
RandFill(pt, sizeof(pt));
ReadTSC(cyc0);
AES_Decrypt(ctx, pt, ct);
ReadTSC(cyc1);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
AES_Decrypt(ctx, ct, ct);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
DecrCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function EncrKeyCycles(keybits: word): longint;
var
i,j: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
c1 := MaxLongint;
c2 := MaxLongint;
j := AES_Init_Encr(Key, KeyBits, ctx);
if j<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
for i:=1 to LOOPS do begin
RandFill(key, sizeof(key));
ReadTSC(cyc0);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
ReadTSC(cyc1);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Encr(Key, KeyBits, ctx);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
EncrKeyCycles := (c2-c1+1) shr 2;
end;
{---------------------------------------------------------------------------}
function DecrKeyCycles(keybits: word): longint;
var
i,j: integer;
cyc0, cyc1, cyc2: comp;
t1,t2,c1,c2: longint;
begin
RandFill(key, sizeof(key));
RandFill(pt, sizeof(pt));
c1 := MaxLongint;
c2 := MaxLongint;
j := AES_Init_Decr(Key, KeyBits, ctx);
if j<>0 then begin
writeln('Error AES_Init_Encr');
halt;
end;
for i:=1 to LOOPS do begin
RandFill(key, sizeof(key));
ReadTSC(cyc0);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
ReadTSC(cyc1);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
{$ifndef X_Opt} j := {$endif} AES_Init_Decr(Key, KeyBits, ctx);
ReadTSC(cyc2);
t2 := round(cyc2-cyc1);
t1 := round(cyc1-cyc0);
if t1<c1 then c1 := t1;
if t2<c2 then c2 := t2;
end;
DecrKeyCycles := (c2-c1+1) shr 2;
end;
var
k: word;
ec,dc : array[2..4] of longint;
ek,dk : array[2..4] of longint;
MB : array[2..4] of double;
begin
{$ifdef AES_ComprTab}
writeln('AES Encr/Decr cycles [compressed tables] - (c) W.Ehrhardt 2004-2012');
{$else}
writeln('AES Encr/Decr cycles [full tables] - (c) W.Ehrhardt 2004-2012');
{$endif}
writeln('KeyBit EncCyc DecCyc EK-Cyc DK-Cyc MB/s (Enc)');
for k:=4 downto 2 do begin
ec[k] := EncrCycles(k*64);
dc[k] := DecrCycles(k*64);
ek[k] := EncrKeyCycles(k*64);
dk[k] := DecrKeyCycles(k*64);
MB[k] := 16*CPUFrequency/ec[k]/1E6;
end;
for k:=4 downto 2 do writeln(k*64:6, ec[k]:8, dc[k]:8, ek[k]:8, dk[k]:8, MB[k]:8:1);
end.

271
Tocsg.Lib/VCL/EncLib/AES/t_mcst.pas Normal file
View File

@ -0,0 +1,271 @@
{AES 'Monte Carlo Self Tests' from rijndael-vals.zip, we 06.2006}
program T_MCST;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
{$r+}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
BTypes,aes_type,aes_base,aes_cbc,aes_ecb,mem_util;
const
IMAX = 399;
JMAX = 9999;
{---------------------------------------------------------------------------}
procedure ECBEncr;
{-Reproduce ecb_e_m.txt}
procedure TestBits(kbits: word; ts: BString);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_ECB_Init_Encr(Key, kbits, ctx);
if Err<>0 then begin
writeln('AES_ECB_Init_Encr error: ', Err);
halt;
end;
for j:=0 to JMAX do begin
PT := CT;
Err := AES_ECB_Encrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_ECB_Encrypt error: ', Err);
halt;
end;
end;
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln(' ', ts=HexStr(@CT,16));
end;
const
CT128='A04377ABE259B0D0B5BA2D40A501971B';
CT192='4E46F8C5092B29E29A971A0CD1F610FB';
CT256='1F6763DF807A7E70960D4CD3118E601A';
begin
writeln('ecb_e_m');
TestBits(128, CT128);
TestBits(192, CT192);
TestBits(256, CT256);
end;
{---------------------------------------------------------------------------}
procedure ECBDecr;
{-Reproduce ecb_d_m.txt}
procedure TestBits(kbits: word; ts: BString);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_ECB_Init_Decr(Key, kbits, ctx);
if Err<>0 then begin
writeln('AES_ECB_Init_Decr error: ', Err);
halt;
end;
for j:=0 to JMAX do begin
PT := CT;
Err := AES_ECB_Decrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_ECB_Decrypt error: ', Err);
halt;
end;
end;
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln(' ', ts=HexStr(@CT,16));
end;
const
PT128='F5BF8B37136F2E1F6BEC6F572021E3BA';
PT192='F1A81B68F6E5A6271A8CB24E7D9491EF';
PT256='4DE0C6DF7CB1697284604D60271BC59A';
begin
writeln('ecb_d_m');
TestBits(128, PT128);
TestBits(192, PT192);
TestBits(256, PT256);
end;
{---------------------------------------------------------------------------}
procedure CBCEncr;
{-Reproduce cbc_e_m.txt}
procedure TestBits(kbits: word; ts: BString);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
IV, PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
fillchar(IV, sizeof(IV), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_CBC_Init_Encr(Key, kbits, IV, ctx);
if Err<>0 then begin
writeln('AES_CBC_Init_Encr error: ', Err);
halt;
end;
for j:=0 to JMAX do begin
CT := PT;
PT := ctx.IV;
Err := AES_CBC_Encrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_CBC_Encrypt error: ', Err);
halt;
end;
end;
IV := CT;
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln(' ',ts=HexStr(@CT,16));
end;
const
CT128='2F844CBF78EBA70DA7A49601388F1AB6';
CT192='BA50C94440C04A8C0899D42658E25437';
CT256='C0FEFFF07506A0B4CD7B8B0CF25D3664';
begin
writeln('cbc_e_m');
TestBits(128, CT128);
TestBits(192, CT192);
TestBits(256, CT256);
end;
{---------------------------------------------------------------------------}
procedure CBCDecr;
{-Reproduce cbc_d_m.txt}
procedure TestBits(kbits: word; ts: BString);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
IV, PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
fillchar(IV, sizeof(IV), 0);
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
CT := PT;
Err := AES_CBC_Init_Decr(Key, kbits, IV, ctx);
if Err<>0 then begin
writeln('AES_CBC_Init_Decr error: ', Err);
halt;
end;
PT := CT;
for j:=0 to JMAX do begin
CT := PT;
Err := AES_CBC_Decrypt(@PT, @PT, 16, ctx);
if Err<>0 then begin
writeln('AES_CBC_Decrypt error: ', Err);
halt;
end;
end;
IV := ctx.IV;
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor CT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor PT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor PT[j];
end;
end;
end;
writeln(' ',ts=HexStr(@PT,16));
end;
const
PT128='9B8FB71E035CEFF9CBFA1346E5ACEFE0';
PT192='6342BFDDD2F6610350458B6695463484';
PT256='CD6429CF3F81F8B4F82BC627A8283096';
begin
writeln('cbc_d_m');
TestBits(128, PT128);
TestBits(192, PT192);
TestBits(256, PT256);
end;
begin
writeln('T_MCST - AES Monte Carlo Self Tests (c) 2006 W.Ehrhardt');
HexUpper := true;
ECBEncr;
ECBDecr;
CBCEncr;
CBCDecr;
end.

374
Tocsg.Lib/VCL/EncLib/AES/t_mctful.pas Normal file
View File

@ -0,0 +1,374 @@
{AES 'Monte Carlo Tests' from rijndael-vals.zip, we 06.2006}
program T_MCTFUL;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifndef FPC}
{$N+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
BTypes,aes_type,aes_base,aes_cbc,aes_ecb,mem_util;
var
logfile: text;
const
IMAX = 399;
JMAX = 9999;
{---------------------------------------------------------------------------}
procedure output({$ifdef CONST} const {$endif} s: str255);
{-writeln to logfile}
begin
writeln(logfile,s);
end;
{---------------------------------------------------------------------------}
function i2s(L: longint): str255;
var
s: string[20];
begin
str(L,s);
i2s := s;
end;
{---------------------------------------------------------------------------}
procedure ECBEncr;
{-Reproduce ecb_e_m.txt}
procedure TestBits(kbits: word);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
output('=========================');
output('');
output('KEYSIZE='+i2s(kbits));
output('');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_ECB_Init_Encr(Key, kbits, ctx);
if Err<>0 then begin
writeln('AES_ECB_Init_Encr error: ', Err);
halt;
end;
output('I='+i2s(I));
output('KEY='+HexStr(@Key, kbits div 8));
output('PT='+HexStr(@CT,16));
for j:=0 to JMAX do begin
PT := CT;
Err := AES_ECB_Encrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_ECB_Encrypt error: ', Err);
halt;
end;
end;
output('CT='+HexStr(@CT,16));
output('');
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln;
end;
begin
assign(logfile, 'ecb_e_m.log');
rewrite(logfile);
writeln('ecb_e_m.log');
output('');
output('=========================');
output('');
output('FILENAME: "ecb_e_m.txt"');
output('');
output('Electronic Codebook (ECB) Mode - ENCRYPTION');
output('Monte Carlo Test');
output('');
output('Algorithm Name: Rijndael');
output('Principal Submitter: Joan Daemen');
output('');
TestBits(128);
TestBits(192);
TestBits(256);
output('===========');
close(logfile);
end;
{---------------------------------------------------------------------------}
procedure ECBDecr;
{-Reproduce ecb_d_m.txt}
procedure TestBits(kbits: word);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
output('=========================');
output('');
output('KEYSIZE='+i2s(kbits));
output('');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_ECB_Init_Decr(Key, kbits, ctx);
if Err<>0 then begin
writeln('AES_ECB_Init_Decr error: ', Err);
halt;
end;
output('I='+i2s(I));
output('KEY='+HexStr(@Key, kbits div 8));
output('CT='+HexStr(@CT,16));
for j:=0 to JMAX do begin
PT := CT;
Err := AES_ECB_Decrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_ECB_Decrypt error: ', Err);
halt;
end;
end;
output('PT='+HexStr(@CT,16));
output('');
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln;
end;
begin
assign(logfile, 'ecb_d_m.log');
rewrite(logfile);
writeln('ecb_d_m.log');
output('');
output('=========================');
output('');
output('FILENAME: "ecb_d_m.txt"');
output('');
output('Electronic Codebook (ECB) Mode - DECRYPTION');
output('Monte Carlo Test');
output('');
output('Algorithm Name: Rijndael');
output('Principal Submitter: Joan Daemen');
output('');
TestBits(128);
TestBits(192);
TestBits(256);
output('===========');
close(logfile);
end;
{---------------------------------------------------------------------------}
procedure CBCEncr;
{-Reproduce cbc_e_m.txt}
procedure TestBits(kbits: word);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
IV, PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
output('==========');
output('');
output('KEYSIZE='+i2s(kbits));
output('');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
fillchar(IV, sizeof(IV), 0);
CT := PT;
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
Err := AES_CBC_Init_Encr(Key, kbits, IV, ctx);
if Err<>0 then begin
writeln('AES_CBC_Init_Encr error: ', Err);
halt;
end;
output('I='+i2s(I));
output('KEY='+HexStr(@Key, kbits div 8));
output('IV='+HexStr(@IV,16));
output('PT='+HexStr(@PT,16));
for j:=0 to JMAX do begin
CT := PT;
PT := ctx.IV;
Err := AES_CBC_Encrypt(@CT, @CT, 16, ctx);
if Err<>0 then begin
writeln('AES_CBC_Encrypt error: ', Err);
halt;
end;
end;
IV := CT;
output('CT='+HexStr(@CT,16));
output('');
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor PT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor CT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor CT[j];
end;
end;
end;
writeln;
end;
begin
assign(logfile, 'cbc_e_m.log');
rewrite(logfile);
writeln('cbc_e_m.log');
output('');
output('=========================');
output('');
output('FILENAME: "cbc_e_m.txt"');
output('');
output('Cipher Block Chaining (CBC) Mode - ENCRYPTION');
output('Monte Carlo Test');
output('');
output('Algorithm Name: Rijndael');
output('Principal Submitter: Joan Daemen');
output('');
TestBits(128);
TestBits(192);
TestBits(256);
output('===========');
close(logfile);
end;
{---------------------------------------------------------------------------}
procedure CBCDecr;
{-Reproduce cbc_d_m.txt}
procedure TestBits(kbits: word);
{-generate part for keysize kbits}
var
i,j,Err: Integer;
IV, PT, CT: TAESBlock;
Key: array[0..31] of byte;
ctx: TAESContext;
begin
write(kbits, ' bits ');
output('==========');
output('');
output('KEYSIZE='+i2s(kbits));
output('');
fillchar(Key, sizeof(Key), 0);
fillchar(PT, sizeof(PT), 0);
fillchar(IV, sizeof(IV), 0);
for i:=0 to IMAX do begin
if i and 7 = 0 then write('.');
CT := PT;
Err := AES_CBC_Init_Decr(Key, kbits, IV, ctx);
if Err<>0 then begin
writeln('AES_CBC_Init_Decr error: ', Err);
halt;
end;
output('I='+i2s(I));
output('KEY='+HexStr(@Key, kbits div 8));
output('IV='+HexStr(@IV,16));
output('CT='+HexStr(@CT,16));
PT := CT;
for j:=0 to JMAX do begin
CT := PT;
Err := AES_CBC_Decrypt(@PT, @PT, 16, ctx);
if Err<>0 then begin
writeln('AES_CBC_Decrypt error: ', Err);
halt;
end;
end;
IV := ctx.IV;
output('PT='+HexStr(@PT,16));
output('');
case kbits of
128: for j:=0 to 15 do Key[j] := Key[j] xor PT[j];
192: begin
for j:=0 to 7 do Key[j] := Key[j] xor CT[8+j];
for j:=0 to 15 do Key[j+8] := Key[j+8] xor PT[j];
end;
256: begin
for j:=0 to 15 do Key[j] := Key[j] xor CT[j];
for j:=0 to 15 do Key[j+16] := Key[j+16] xor PT[j];
end;
end;
end;
writeln;
end;
begin
assign(logfile, 'cbc_d_m.log');
rewrite(logfile);
writeln('cbc_d_m.log');
output('');
output('=========================');
output('');
output('FILENAME: "cbc_d_m.txt"');
output('');
output('Cipher Block Chaining (CBC) Mode - DECRYPTION');
output('Monte Carlo Test');
output('');
output('Algorithm Name: Rijndael');
output('Principal Submitter: Joan Daemen');
output('');
TestBits(128);
TestBits(192);
TestBits(256);
output('===========');
close(logfile);
end;
begin
writeln('T_MCTFUL - Full Monte Carlo Tests to <name>.LOG (c) 2006 W.Ehrhardt');
HexUpper := true;
ECBEncr;
ECBDecr;
CBCEncr;
CBCDecr;
end.

187
Tocsg.Lib/VCL/EncLib/AES/t_mkctab.pas Normal file
View File

@ -0,0 +1,187 @@
program t_mkctab;
(*************************************************************************
DESCRIPTION : Calculate compressed AES tables
REQUIREMENTS : TP5-7, D1-D7/D9-D10, FPC, VP, WDOSX
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : [1] http://csrc.nist.gov/fips/fips-197.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 08.07.06 we Initial version using existing static tables
0.11 12.07.06 we Use (Inv)SBox bytes instead of zero fill bytes
0.12 13.07.06 we Without static tables
**************************************************************************)
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
mem_util;
{---------------------------------------------------------------------------}
{Encrypt}
{ 3 2 1 0}
{ a5 63 63 c6}
{ xx xx xx c6 63 63 a5 xx
xx xx a5 c6 63 63 xx xx
xx 63 a5 c6 63 xx xx xx
63 63 a5 c6 xx xx xx xx}
{If (b0,b1,b2,b3) are the bytes of an Te0 longint the}
{TCe entry has the 8 bytes (b1,b2,b3,b0,b1,b2,b3,SBox) }
{---------------------------------------------------------------------------}
{Decrypt}
{ 3 2 1 0}
{ 50 a7 f4 51}
{ xx xx xx 51 f4 a7 50 xx
xx xx 50 51 f4 a7 xx xx
xx a7 50 51 f4 xx xx xx
f4 a7 50 51 xx xx xx xx}
{If (b0,b1,b2,b3) are the bytes of an Td0 longint the}
{TCd entry has the 8 bytes (b1,b2,b3,b0,b1,b2,b3,InvSBox) }
{---------------------------------------------------------------------------}
{types to access table: Tex[i] = TCe[i].Ex.L, Tdx[i] = TCd[i].Ex.L}
(*
type
TH0 = packed record TH1 = packed record
b0,b1,b2: byte; b0,b1: byte;
L: longint; L: longint;
box: byte; b2,box: byte;
end; end;
TH2 = packed record TH3 = packed record
b0: byte; L: longint;
L: longint; b0,b1,b2,box: byte;
b1,b2,box: byte; end;
end;
THU = record TDU = record
case integer of case integer of
0: (E0: TH0); 0: (D0: TH0);
1: (E1: TH1); 1: (D1: TH1);
2: (E2: TH2); 2: (D2: TH2);
3: (E3: TH3); 3: (D3: TH3);
end; end;
*)
var
GLog, GPow: array[byte] of byte;
{---------------------------------------------------------------------------}
procedure CalcBaseTables;
{-Calculate dynamic tables: power, log}
var
i, p: byte;
begin
{Power/Log tables}
p := 1;
for i:=0 to 254 do begin
GPow[i] := p;
GLog[p] := i;
if p and $80 = 0 then p := (p shl 1) xor p
else p := (p shl 1) xor p xor $1B;
end;
GPow[255] := 1;
end;
{---------------------------------------------------------------------------}
function GMul(x,y: byte): byte;
{-calculate x*y in GF(2^8)}
var
i: word;
begin
if (x=0) or (y=0) then GMul := 0
else begin
i := word(GLog[x])+word(GLog[y]);
if i>=255 then dec(i,255);
GMul := GPow[i];
end;
end;
{---------------------------------------------------------------------------}
function rot(b,n: byte): byte;
{-rotate byte right n bits}
begin
rot := (b shr n) xor (b shl (8-n));
end;
{---------------------------------------------------------------------------}
procedure MakeCompressedTables;
{-Calculate and dump compressed AES tables}
var
i,j: integer;
p: byte;
b: array[0..3] of byte;
s: array[0..4] of string[4];
InvSBox: array[byte] of byte;
begin
CalcBaseTables;
writeln('const');
writeln(' TCe: packed array[0..2047] of byte = (');
for i:=0 to 255 do begin
{SBox calculation, cf. [1] 5.1.1}
if i=0 then p:=0 else p:=GPow[255-GLog[i]]; {p*i = 1}
p := p xor rot(p,4) xor rot(p,5) xor rot(p,6) xor rot(p,7) xor $63;
InvSBox[p] := i;
b[0] := GMul(2,p);
b[1] := p;
b[2] := p;
b[3] := GMul(3,p);
for j:=0 to 3 do s[j] := '$'+HexByte(b[j])+',';
s[4] := '$'+HexByte(p);
if odd(i) then begin
write(s[1],s[2],s[3],s[0],s[1],s[2],s[3],s[4]);
if i=255 then writeln(');') else writeln(',');
end
else write('':9,s[1],s[2],s[3],s[0],s[1],s[2],s[3],s[4],',');
end;
writeln;
writeln('const');
writeln(' TCd: packed array[0..2047] of byte = (');
for i:=0 to 255 do begin
p := InvSbox[i];
b[0] := GMul(14,p);
b[1] := GMul( 9,p);
b[2] := GMul(13,p);
b[3] := GMul(11,p);
for j:=0 to 3 do s[j] := '$'+HexByte(b[j])+',';
s[4] := '$'+HexByte(p);
if odd(i) then begin
write(s[1],s[2],s[3],s[0],s[1],s[2],s[3],s[4]);
if i=255 then writeln(');') else writeln(',');
end
else write('':9,s[1],s[2],s[3],s[0],s[1],s[2],s[3],s[4],',');
end;
end;
begin
MakeCompressedTables;
end.

155
Tocsg.Lib/VCL/EncLib/AES/t_omac.pas Normal file
View File

@ -0,0 +1,155 @@
{-Test prog for OMAC1/2, we 05.2004}
program T_OMAC;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{$ifdef J_OPT}
{$J+}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
AES_Type, AES_OMAC, Mem_Util;
{Common keys and msg data}
{from http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/tv/omac?-tv.txt}
const
key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
$ab,$f7,$15,$88,$09,$cf,$4f,$3c);
key192 : array[0..23] of byte = ($8e,$73,$b0,$f7,$da,$0e,$64,$52,
$c8,$10,$f3,$2b,$80,$90,$79,$e5,
$62,$f8,$ea,$d2,$52,$2c,$6b,$7b);
key256 : array[0..31] of byte = ($60,$3d,$eb,$10,$15,$ca,$71,$be,
$2b,$73,$ae,$f0,$85,$7d,$77,$81,
$1f,$35,$2c,$07,$3b,$61,$08,$d7,
$2d,$98,$10,$a3,$09,$14,$df,$f4);
const
msg : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
$e9,$3d,$7e,$11,$73,$93,$17,$2a,
$ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
$9e,$b7,$6f,$ac,$45,$af,$8e,$51,
$30,$c8,$1c,$46,$a3,$5c,$e4,$11,
$e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
$f6,$9f,$24,$45,$df,$4f,$9b,$17,
$ad,$2b,$41,$7b,$e6,$6c,$37,$10);
{from http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/tv/omac1-tv.txt}
const
tag00: TAESBlock = ($bb,$1d,$69,$29,$e9,$59,$37,$28,$7f,$a3,$7d,$12,$9b,$75,$67,$46);
tag01: TAESBlock = ($07,$0a,$16,$b4,$6b,$4d,$41,$44,$f7,$9b,$dd,$9d,$d0,$4a,$28,$7c);
tag02: TAESBlock = ($df,$a6,$67,$47,$de,$9a,$e6,$30,$30,$ca,$32,$61,$14,$97,$c8,$27);
tag03: TAESBlock = ($51,$f0,$be,$bf,$7e,$3b,$9d,$92,$fc,$49,$74,$17,$79,$36,$3c,$fe);
tag10: TAESBlock = ($d1,$7d,$df,$46,$ad,$aa,$cd,$e5,$31,$ca,$c4,$83,$de,$7a,$93,$67);
tag11: TAESBlock = ($9e,$99,$a7,$bf,$31,$e7,$10,$90,$06,$62,$f6,$5e,$61,$7c,$51,$84);
tag12: TAESBlock = ($8a,$1d,$e5,$be,$2e,$b3,$1a,$ad,$08,$9a,$82,$e6,$ee,$90,$8b,$0e);
tag13: TAESBlock = ($a1,$d5,$df,$0e,$ed,$79,$0f,$79,$4d,$77,$58,$96,$59,$f3,$9a,$11);
tag20: TAESBlock = ($02,$89,$62,$f6,$1b,$7b,$f8,$9e,$fc,$6b,$55,$1f,$46,$67,$d9,$83);
tag21: TAESBlock = ($28,$a7,$02,$3f,$45,$2e,$8f,$82,$bd,$4b,$f2,$8d,$8c,$37,$c3,$5c);
tag22: TAESBlock = ($aa,$f3,$d8,$f1,$de,$56,$40,$c2,$32,$f5,$b1,$69,$b9,$c9,$11,$e6);
tag23: TAESBlock = ($e1,$99,$21,$90,$54,$9f,$6e,$d5,$69,$6a,$2c,$05,$6c,$31,$54,$10);
{http://www.nuee.nagoya-u.ac.jp/labs/tiwata/omac/tv/omac2-tv.txt}
const
tag30: TAESBlock = ($f6,$bc,$6a,$41,$f4,$f8,$45,$93,$80,$9e,$59,$b7,$19,$29,$9c,$fe);
tag31: TAESBlock = ($07,$0a,$16,$b4,$6b,$4d,$41,$44,$f7,$9b,$dd,$9d,$d0,$4a,$28,$7c);
tag32: TAESBlock = ($23,$fd,$aa,$08,$31,$cd,$31,$44,$91,$ce,$4b,$25,$ac,$b6,$02,$3b);
tag33: TAESBlock = ($51,$f0,$be,$bf,$7e,$3b,$9d,$92,$fc,$49,$74,$17,$79,$36,$3c,$fe);
tag40: TAESBlock = ($14,$9f,$57,$9d,$f2,$12,$9d,$45,$a6,$92,$66,$89,$8f,$55,$ae,$b2);
tag41: TAESBlock = ($9e,$99,$a7,$bf,$31,$e7,$10,$90,$06,$62,$f6,$5e,$61,$7c,$51,$84);
tag42: TAESBlock = ($b3,$5e,$2d,$1b,$73,$ae,$d4,$9b,$78,$bd,$bd,$fe,$61,$f6,$46,$df);
tag43: TAESBlock = ($a1,$d5,$df,$0e,$ed,$79,$0f,$79,$4d,$77,$58,$96,$59,$f3,$9a,$11);
tag50: TAESBlock = ($47,$fb,$de,$71,$86,$6e,$ae,$60,$80,$35,$5b,$5f,$c7,$ff,$70,$4c);
tag51: TAESBlock = ($28,$a7,$02,$3f,$45,$2e,$8f,$82,$bd,$4b,$f2,$8d,$8c,$37,$c3,$5c);
tag52: TAESBlock = ($f0,$18,$e6,$05,$36,$11,$b3,$4b,$c8,$72,$d6,$b7,$ff,$24,$74,$9f);
tag53: TAESBlock = ($e1,$99,$21,$90,$54,$9f,$6e,$d5,$69,$6a,$2c,$05,$6c,$31,$54,$10);
var
ctx: TAESContext;
tag: TAESBlock;
{---------------------------------------------------------------------------}
procedure Test(Alg: integer; var key; KL,ML: word; var st: TAESBlock; Hdr: string);
{-Test for OMAC(Alg) with key and message lenght ML, st: known tag }
{ tags are calculated two times: 1. single call of AES_OMAC_Update with}
{ complete msg, 2. AES_OMAC_Update for each byte of msg }
const
Res: array[boolean] of string[5] = ('Error', 'OK');
var
i: word;
begin
write(Alg:4, hdr);
if AES_OMAC_Init(key, KL, ctx)<>0 then begin
writeln('AES_OMAC_Init Error');
halt;
end;
if AES_OMAC_Update(@msg, ML, ctx)<>0 then begin
writeln('AES_OMAC_Update Error');
halt;
end;
if Alg=2 then AES_OMAC2_Final(tag, ctx)
else AES_OMAC1_Final(tag, ctx);
write(Res[CompMem(@tag, @st, sizeof(tag))]:8);
if AES_OMAC_Init(key, KL, ctx)<>0 then begin
writeln('AES_OMAC_Init Error');
halt;
end;
for i:=1 to ML do begin
if AES_OMAC_Update(@msg[i-1], 1, ctx)<>0 then begin
writeln('AES_OMAC_Update Error');
halt;
end;
end;
if Alg=2 then AES_OMAC2_Final(tag, ctx)
else AES_OMAC1_Final(tag, ctx);
writeln(Res[CompMem(@tag, @st, sizeof(tag))]:8);
end;
begin
writeln('Test program AES OMAC 1/2 modes (C) 2004-2006 W.Ehrhardt');
writeln('KL/ML: Key/Message length in bits/bytes');
writeln('Single/Multi: process message with one/multiple call(s)');
writeln('OMAC KL/ML Single Multi');
Test(1, key128, 128, 0, tag00, ' 128/00');
Test(1, key128, 128, 16, tag01, ' 128/16');
Test(1, key128, 128, 40, tag02, ' 128/40');
Test(1, key128, 128, 64, tag03, ' 128/64');
Test(1, key192, 192, 0, tag10, ' 192/00');
Test(1, key192, 192, 16, tag11, ' 192/16');
Test(1, key192, 192, 40, tag12, ' 192/40');
Test(1, key192, 192, 64, tag13, ' 192/64');
Test(1, key256, 256, 0, tag20, ' 256/00');
Test(1, key256, 256, 16, tag21, ' 256/16');
Test(1, key256, 256, 40, tag22, ' 256/40');
Test(1, key256, 256, 64, tag23, ' 256/64');
Test(2, key128, 128, 0, tag30, ' 128/00');
Test(2, key128, 128, 16, tag31, ' 128/16');
Test(2, key128, 128, 40, tag32, ' 128/40');
Test(2, key128, 128, 64, tag33, ' 128/64');
Test(2, key192, 192, 0, tag40, ' 192/00');
Test(2, key192, 192, 16, tag41, ' 192/16');
Test(2, key192, 192, 40, tag42, ' 192/40');
Test(2, key192, 192, 64, tag43, ' 192/64');
Test(2, key256, 256, 0, tag50, ' 256/00');
Test(2, key256, 256, 16, tag51, ' 256/16');
Test(2, key256, 256, 40, tag52, ' 256/40');
Test(2, key256, 256, 64, tag53, ' 256/64');
end.

235
Tocsg.Lib/VCL/EncLib/AES/t_ppp.pas Normal file
View File

@ -0,0 +1,235 @@
{Test program for PPP unit (GRC's Perfect Paper Passwords)}
program t_ppp;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
{.$define usesha256} {demo: use sha256/hash for a Sequence Key calculation}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef usesha256}
hash, sha256,
{$endif}
mem_util, BTypes, ppp;
{Some tests: pppNET v0.9.1 from http://sourceforge.net/projects/pppnet/}
{---------------------------------------------------------------------------}
procedure dotest;
var
pctx: TPPPctx;
SeqKey: TPPPKey;
kl: word;
err,i, dcnt: integer;
si: str255;
const
testdef: array[0..69] of string[4] = ( {GRC}
'32YT', '65!@', 'S3mg', 'skAf', 'wVmK', 'nSge', 'MsXd',
'DzRA', 't%#f', 'vxDa', 'v!nz', '?S9G', 'u9Um', 'HA72',
'944=', 'Rgai', 'pNv=', 'n5FU', 'SUKU', 'C+wp', 'C+7G',
'jsKV', 'uSGn', 'EH?F', 'R3pW', 'EMd?', 'k=vv', '@+rC',
't5yt', 'c:xD', 'BmeV', 'cex4', 'Zh4t', 'J:oK', 'nUxV',
'EbA@', 'BHn%', 'G9Sa', 'Fo:i', 'MM97', '@Urg', 'fkPL',
'%EU+', 'U8GF', 'F%fY', 'dxXE', 'H5M%', ':%B7', '4YDR',
'vGYq', 'uL%5', '7#cE', 'hi+6', '99bS', '5FVh', 'ZhNr',
'#DnV', '8sr7', 'Dnj3', 'xf=U', '4%a%', 'J#sE', 'pS?e',
'CsCU', 'iYGg', 'KPFV', 'j8@2', 'dsLf', '3#yE', 'BWbj');
testext: array[0..69] of string[4] = ( {pppNET}
'(EON', 't.ix', 'L>:?', 'u|[&', '<e=T', 'nTZE', 'O)fY',
'r%Y"', 'o<bB', 'XE7]', 'm?{,', 'e=_)','''#BT', 'f/&>',
'>J[i', 'm|sk', 'H#hm', ',u:F', ';NUP', 'iSD}', '}Y6&',
'bN''c', 'pVMk', '7e^{', ':HP8', '-CMu', 'ivN:', '-(Mr',
'"L?G', 'kpru', 'q.Kk', 'NP7j', 'x6?%', 'vK!<', '>[5}',
'@WCX', 'E}qG', 'az=W', 'nLHa', '{-6G', ')Xjg', '>iW6',
'K\pU', '85E8', '9:D!', '+2-_', 'UYR5', ';LvV', 'v&[O',
'&TwS', 'mNPO', 'q6%E', 'm9gf', 'Jc@{', 'vb?R', 'L.]*',
'h<@2', '8-ef', '^Cdy', 'qjGr', 'o^Aa','''[3r', 'DRdv',
'$\?p', '=:(<', 'RHBR','G''o>', ')~Mx', 'U:D,', 'ero9');
testcst: array[0..69] of string[4] = ( {pppNET}
'hvRG', '*sXy', 'NS)X', 'nkT$', '*mu(', '=NSz', 'JisZ',
'JBW%', '!g=X', '_TJS', '~Eyh', 'whp@', '^)jr', 'uuE=',
'RiaP', 'uy*K', '?L>&', 'Tua~', 'Pttw', '(KUc', 'xhP&',
'&=e_', '*ah&', 'P*Hh', 'MDD>', 'YC_A', 'UrTh', 'UhAh',
'W!=h', 'tdqH', 'hfJH', 's$GE', 'a$FU', 'LtsG', 'Ae&+',
'FcJk', 'nF_k', '^ZrC', 'VefW', '<noq', '@t!i', 'b+Bc',
'*FHw', 'u@Ct', '>wq-', 'nNFx', 'Nkzd', 'a*Sv', 'r=mG',
'pV%P', '_j$d', 'G_<L', 'rNNC', ')<HH', 'RtRg', 'V%tB',
'bq<?', 'oP=%', 'wunA', '*j)p', 'LwJ&', '+htR', 'Kq*$',
'%^fK', 'JcFg', 'hMxT', '%LVh', 'CLpT', 'Li?(', '!wkV');
test1400: array[0..69] of string[4] = ( {pppNET}
'Vv?u', 'zC7u', 'cX+N', 'Vvtf', 'JthW', '?c9v', '@WVL',
'jcpw', 'icjD', '=wCV', 'HZGB', 'cV2Z', 'V=5G', 'Mwau',
'2Xm@', 't4g%', 'g@5V', 'GuDF', 'oAVo', 'ewPR', 'NgtD',
'Dbj#', 'C6Xm', 'i2gT', '3pDV', '8BZ%', 'ATJJ', 'nKZ8',
'?9b%', '7B3k', 'fJ6C', 'KYyJ', ':s@m', 'z2c6', 'T577',
'Jdnj', '6K4K', 'y4u7', 'yort', 'Wzvw', '9W7j', 'LxwC',
'8=SF', '%AnU', '%WgA', 'uFpm', 'Ao7t', 'E3?%', 'VNyF',
'Dz!W', '#D!m', 'jYL8', '8uvr', 'maR?', 'De=K', 'ENd2',
'iHv3', '%Aae', 'fpCM', '6j2d', 'ovo#', 'cmsP', '9e?M',
'zpSm', '@N!m', '@rT7', '4apF', 'dMaG', '?f=D', 'DRh#');
test6c3: array[0..49] of string[6] = ( {GRC}
'+2WVHb', '#m6se+', 'JeCgXS', '=ksxW9', '9ssSqG',
'nHjKZx', 'PxNpY4', 'B6nYjq', 'S@:%M+', '5NvX=r',
'WhhF:4', 'ydw?Jj', '=U:7oL', 'p=eZEf', 'bnooy=',
'FG+2fn', 'dA!?gY', 'NojUov', 'fR8NPM', 'toJYch',
'2ifS9d', 'Jcn89N', 'G:Y!Gj', 'VFbCbZ', 'KbNV:L',
'PdoRzX', 'ZgJq5G', 'N4zLqd', 'y+Ec6A', 'B=BDTR',
'@FVRCb', '+:cJT+', 'KBw#w7', 'DRzFbY', 'JGmAy:',
'fw3oxk', 'dKoCag', 'pNeYEs', 'Y=2Beu', '#C+abd',
'CGi?8n', '5AMXDW', 'Th982q', '+gaP7i', '3J7tTZ',
'ifX4UF', 'NUX?B=', 'Ysr8g?', '5mAv%D', 'xWxBA!');
{$ifdef usesha256}
const
zombie: packed array[0..5] of char8 = 'zombie';
{$endif}
const
key1h = '53303f97ddcf91ed74391fc5c366124632427e1c93c1a2e2836d006fa2653dc1';
key2h = '49460b7bbbd3aad3f2cba09864f5e8b01a220ea8c077e9fa996de367e7984af0'; {sha256('zombie')}
cmap = '~!@#$%^&*()_+-=<>?ABCDEFGHJKLMNPRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
procedure ShowDiff(ts: str255);
begin
inc(dcnt);
writeln('** Diff! `',si,'` should be `',ts,'`');
end;
begin
dcnt := 0;
Hex2Mem(key1h, @SeqKey, sizeof(SeqKey), kl);
PPP_Init4Standard(pctx, SeqKey, Err);
if Err<>0 then begin
writeln(' *** PPP_Init4Standard = ', Err);
end
else begin
writeln('-------------------------------------');
writeln('Test 1 with Standard 64-character set');
writeln('-------------------------------------');
si := PPP_First32(pctx,0);
write(si,' ');
i:=0;
if si<>testdef[i] then ShowDiff(testdef[i]);
for i:=1 to 69 do begin
si := PPP_Next(pctx);
write(si,' ');
if si<>testdef[i] then ShowDiff(testdef[i]);
if i mod 7 = 6 then writeln;
end;
writeln;
end;
Hex2Mem(key1h, @SeqKey, sizeof(SeqKey), kl);
PPP_Init(pctx, SeqKey, map64, 6, Err);
if Err<>0 then begin
writeln(' *** PPP_Init error = ', Err);
end
else begin
PPP_SetCodesPerCard(pctx, 50);
writeln('-------------------------------------');
writeln('Test 2 with Standard 64-character set');
writeln('-------------------------------------');
si := PPP_FirstCard(pctx,3);
write(si,' ');
i:=0;
if si<>test6c3[i] then ShowDiff(test6c3[i]);
for i:=1 to 49 do begin
si := PPP_Next(pctx);
write(si,' ');
if si<>test6c3[i] then ShowDiff(test6c3[i]);
if i mod 5 = 4 then writeln;
end;
writeln;
end;
{$ifdef usesha256}
{demo: simple sha256('zombie')}
SHA256Full(TSHA256Digest(SeqKey), @zombie, sizeof(zombie));
{$else}
Hex2Mem(key2h, @SeqKey, sizeof(SeqKey), kl);
{$endif}
PPP_Init4Extended(pctx, SeqKey, Err);
if Err<>0 then begin
writeln(' *** PPP_Init4Extended error = ', Err);
end
else begin
writeln('-------------------------------------');
writeln('Test 3 with Extended 88-character set');
writeln('-------------------------------------');
si := PPP_FirstCard(pctx,3);
write(si,' ');
i:=0;
if si<>testext[i] then ShowDiff(testext[i]);
for i:=1 to 69 do begin
si := PPP_Next(pctx);
write(si,' ');
if si<>testext[i] then ShowDiff(testext[i]);
if i mod 7 = 6 then writeln;
end;
writeln;
end;
Hex2Mem(key2h, @SeqKey, sizeof(SeqKey), kl);
PPP_Init(pctx, SeqKey, cmap, 4, Err);
if Err<>0 then begin
writeln(' *** PPP_Init error = ', Err);
end
else begin
writeln('-------------------------------------');
writeln('Test 4 with a custom 66-character set');
writeln('-------------------------------------');
si := PPP_FirstCard(pctx,2);
write(si,' ');
i:=0;
if si<>testcst[i] then ShowDiff(testcst[i]);
for i:=1 to 69 do begin
si := PPP_Next(pctx);
write(si,' ');
if si<>testcst[i] then ShowDiff(testcst[i]);
if i mod 7 = 6 then writeln;
end;
writeln;
end;
Hex2Mem(key2h, @SeqKey, sizeof(SeqKey), kl);
PPP_Init4Standard(pctx, SeqKey, Err);
if Err<>0 then begin
writeln(' *** PPP_Init4Standard error = ', Err);
end
else begin
writeln('-------------------------------------');
writeln('Test 5: CardNr 1400 with standard set');
writeln('-------------------------------------');
si := PPP_FirstCard(pctx,1400);
write(si,' ');
i:=0;
if si<>test1400[i] then ShowDiff(test1400[i]);
for i:=1 to 69 do begin
si := PPP_Next(pctx);
write(si,' ');
if si<>test1400[i] then ShowDiff(test1400[i]);
if i mod 7 = 6 then writeln;
end;
writeln;
end;
if dcnt=0 then writeln('All tests passed.')
else writeln('*** test failed, ',dcnt,' differences found!')
end;
begin
writeln('T_PPP - Test PPP unit [Perfect Paper Passwords] (c) 2010 W.Ehrhardt');
writeln;
dotest;
end.

521
Tocsg.Lib/VCL/EncLib/AES/t_xts.pas Normal file
View File

@ -0,0 +1,521 @@
{Test program AES XTS mode functions, we Oct.2007}
program T_XTS;
{$i STD.INC}
{$ifdef APPCONS}
{$apptype console}
{$endif}
uses
{$ifdef WINCRT}
wincrt,
{$endif}
{$ifdef USEDLL}
{$ifdef VirtualPascal}
AES_Intv,
{$else}
AES_Intf,
{$endif}
{$else}
aes_type, aes_xts,
{$endif}
mem_util;
var
ctx: TAES_XTSContext;
tmp: array[0..511] of byte;
{Test vectors from IEEE P1619}
{---------------------------------------------------------------------------}
procedure test_v01;
var
pt: array[0..31] of byte;
k1,k2: array[0..15] of byte;
twk: TAESBlock;
err: integer;
const
ct: array[0..31] of byte = ($91,$7c,$f6,$9e,$bd,$68,$b2,$ec,
$9b,$9f,$e9,$a3,$ea,$dd,$a6,$92,
$cd,$43,$d2,$f5,$95,$98,$ed,$85,
$8c,$02,$c2,$65,$2f,$bf,$92,$2e);
begin
fillchar(pt,sizeof(pt),0);
fillchar(k1,sizeof(k1),0);
fillchar(k2,sizeof(k2),0);
fillchar(twk,sizeof(twk),0);
writeln('Test vector 01');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v02;
const
k1 : array[0..15] of byte = ($11,$11,$11,$11,$11,$11,$11,$11,
$11,$11,$11,$11,$11,$11,$11,$11);
k2 : array[0..15] of byte = ($22,$22,$22,$22,$22,$22,$22,$22,
$22,$22,$22,$22,$22,$22,$22,$22);
twk: TAESBlock = ($33,$33,$33,$33,$33,0,0,0,0,0,0,0,0,0,0,0);
pt : array[0..31] of byte = ($44,$44,$44,$44,$44,$44,$44,$44,
$44,$44,$44,$44,$44,$44,$44,$44,
$44,$44,$44,$44,$44,$44,$44,$44,
$44,$44,$44,$44,$44,$44,$44,$44);
ct : array[0..31] of byte = ($c4,$54,$18,$5e,$6a,$16,$93,$6e,
$39,$33,$40,$38,$ac,$ef,$83,$8b,
$fb,$18,$6f,$ff,$74,$80,$ad,$c4,
$28,$93,$82,$ec,$d6,$d3,$94,$f0);
var
err: integer;
begin
writeln('Test vector 02');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v04;
const
k1 : array[0..15] of byte = ($27,$18,$28,$18,$28,$45,$90,$45,$23,$53,$60,$28,$74,$71,$35,$26);
k2 : array[0..15] of byte = ($31,$41,$59,$26,$53,$58,$97,$93,$23,$84,$62,$64,$33,$83,$27,$95);
pt : array[0..511] of byte =(
$00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
$20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f,
$40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$5f,
$60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
$70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f,
$80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
$90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
$a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
$c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
$d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df,
$e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
$f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff,
$00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
$20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f,
$40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$5f,
$60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
$70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f,
$80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
$90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
$a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
$c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
$d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df,
$e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
$f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
ct : array[0..511] of byte = (
$27,$a7,$47,$9b,$ef,$a1,$d4,$76,$48,$9f,$30,$8c,$d4,$cf,$a6,$e2,
$a9,$6e,$4b,$be,$32,$08,$ff,$25,$28,$7d,$d3,$81,$96,$16,$e8,$9c,
$c7,$8c,$f7,$f5,$e5,$43,$44,$5f,$83,$33,$d8,$fa,$7f,$56,$00,$00,
$05,$27,$9f,$a5,$d8,$b5,$e4,$ad,$40,$e7,$36,$dd,$b4,$d3,$54,$12,
$32,$80,$63,$fd,$2a,$ab,$53,$e5,$ea,$1e,$0a,$9f,$33,$25,$00,$a5,
$df,$94,$87,$d0,$7a,$5c,$92,$cc,$51,$2c,$88,$66,$c7,$e8,$60,$ce,
$93,$fd,$f1,$66,$a2,$49,$12,$b4,$22,$97,$61,$46,$ae,$20,$ce,$84,
$6b,$b7,$dc,$9b,$a9,$4a,$76,$7a,$ae,$f2,$0c,$0d,$61,$ad,$02,$65,
$5e,$a9,$2d,$c4,$c4,$e4,$1a,$89,$52,$c6,$51,$d3,$31,$74,$be,$51,
$a1,$0c,$42,$11,$10,$e6,$d8,$15,$88,$ed,$e8,$21,$03,$a2,$52,$d8,
$a7,$50,$e8,$76,$8d,$ef,$ff,$ed,$91,$22,$81,$0a,$ae,$b9,$9f,$91,
$72,$af,$82,$b6,$04,$dc,$4b,$8e,$51,$bc,$b0,$82,$35,$a6,$f4,$34,
$13,$32,$e4,$ca,$60,$48,$2a,$4b,$a1,$a0,$3b,$3e,$65,$00,$8f,$c5,
$da,$76,$b7,$0b,$f1,$69,$0d,$b4,$ea,$e2,$9c,$5f,$1b,$ad,$d0,$3c,
$5c,$cf,$2a,$55,$d7,$05,$dd,$cd,$86,$d4,$49,$51,$1c,$eb,$7e,$c3,
$0b,$f1,$2b,$1f,$a3,$5b,$91,$3f,$9f,$74,$7a,$8a,$fd,$1b,$13,$0e,
$94,$bf,$f9,$4e,$ff,$d0,$1a,$91,$73,$5c,$a1,$72,$6a,$cd,$0b,$19,
$7c,$4e,$5b,$03,$39,$36,$97,$e1,$26,$82,$6f,$b6,$bb,$de,$8e,$cc,
$1e,$08,$29,$85,$16,$e2,$c9,$ed,$03,$ff,$3c,$1b,$78,$60,$f6,$de,
$76,$d4,$ce,$cd,$94,$c8,$11,$98,$55,$ef,$52,$97,$ca,$67,$e9,$f3,
$e7,$ff,$72,$b1,$e9,$97,$85,$ca,$0a,$7e,$77,$20,$c5,$b3,$6d,$c6,
$d7,$2c,$ac,$95,$74,$c8,$cb,$bc,$2f,$80,$1e,$23,$e5,$6f,$d3,$44,
$b0,$7f,$22,$15,$4b,$eb,$a0,$f0,$8c,$e8,$89,$1e,$64,$3e,$d9,$95,
$c9,$4d,$9a,$69,$c9,$f1,$b5,$f4,$99,$02,$7a,$78,$57,$2a,$ee,$bd,
$74,$d2,$0c,$c3,$98,$81,$c2,$13,$ee,$77,$0b,$10,$10,$e4,$be,$a7,
$18,$84,$69,$77,$ae,$11,$9f,$7a,$02,$3a,$b5,$8c,$ca,$0a,$d7,$52,
$af,$e6,$56,$bb,$3c,$17,$25,$6a,$9f,$6e,$9b,$f1,$9f,$dd,$5a,$38,
$fc,$82,$bb,$e8,$72,$c5,$53,$9e,$db,$60,$9e,$f4,$f7,$9c,$20,$3e,
$bb,$14,$0f,$2e,$58,$3c,$b2,$ad,$15,$b4,$aa,$5b,$65,$50,$16,$a8,
$44,$92,$77,$db,$d4,$77,$ef,$2c,$8d,$6c,$01,$7d,$b7,$38,$b1,$8d,
$eb,$4a,$42,$7d,$19,$23,$ce,$3f,$f2,$62,$73,$57,$79,$a4,$18,$f2,
$0a,$28,$2d,$f9,$20,$14,$7b,$ea,$be,$42,$1e,$e5,$31,$9d,$05,$68);
twk: TAESBlock = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 04');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' * Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v10;
const
k1 : array[0.. 31] of byte = ($27,$18,$28,$18,$28,$45,$90,$45,$23,$53,$60,$28,$74,$71,$35,$26,
$62,$49,$77,$57,$24,$70,$93,$69,$99,$59,$57,$49,$66,$96,$76,$27);
k2 : array[0.. 31] of byte = ($31,$41,$59,$26,$53,$58,$97,$93,$23,$84,$62,$64,$33,$83,$27,$95,
$02,$88,$41,$97,$16,$93,$99,$37,$51,$05,$82,$09,$74,$94,$45,$92);
pt : array[0..511] of byte =(
$00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
$20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f,
$40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$5f,
$60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
$70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f,
$80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
$90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
$a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
$c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
$d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df,
$e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
$f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff,
$00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
$20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2a,$2b,$2c,$2d,$2e,$2f,
$30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3a,$3b,$3c,$3d,$3e,$3f,
$40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$5b,$5c,$5d,$5e,$5f,
$60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
$70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$7b,$7c,$7d,$7e,$7f,
$80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
$90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
$a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
$b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
$c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
$d0,$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df,
$e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
$f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
ct : array[0..511] of byte = (
$1c,$3b,$3a,$10,$2f,$77,$03,$86,$e4,$83,$6c,$99,$e3,$70,$cf,$9b,
$ea,$00,$80,$3f,$5e,$48,$23,$57,$a4,$ae,$12,$d4,$14,$a3,$e6,$3b,
$5d,$31,$e2,$76,$f8,$fe,$4a,$8d,$66,$b3,$17,$f9,$ac,$68,$3f,$44,
$68,$0a,$86,$ac,$35,$ad,$fc,$33,$45,$be,$fe,$cb,$4b,$b1,$88,$fd,
$57,$76,$92,$6c,$49,$a3,$09,$5e,$b1,$08,$fd,$10,$98,$ba,$ec,$70,
$aa,$a6,$69,$99,$a7,$2a,$82,$f2,$7d,$84,$8b,$21,$d4,$a7,$41,$b0,
$c5,$cd,$4d,$5f,$ff,$9d,$ac,$89,$ae,$ba,$12,$29,$61,$d0,$3a,$75,
$71,$23,$e9,$87,$0f,$8a,$cf,$10,$00,$02,$08,$87,$89,$14,$29,$ca,
$2a,$3e,$7a,$7d,$7d,$f7,$b1,$03,$55,$16,$5c,$8b,$9a,$6d,$0a,$7d,
$e8,$b0,$62,$c4,$50,$0d,$c4,$cd,$12,$0c,$0f,$74,$18,$da,$e3,$d0,
$b5,$78,$1c,$34,$80,$3f,$a7,$54,$21,$c7,$90,$df,$e1,$de,$18,$34,
$f2,$80,$d7,$66,$7b,$32,$7f,$6c,$8c,$d7,$55,$7e,$12,$ac,$3a,$0f,
$93,$ec,$05,$c5,$2e,$04,$93,$ef,$31,$a1,$2d,$3d,$92,$60,$f7,$9a,
$28,$9d,$6a,$37,$9b,$c7,$0c,$50,$84,$14,$73,$d1,$a8,$cc,$81,$ec,
$58,$3e,$96,$45,$e0,$7b,$8d,$96,$70,$65,$5b,$a5,$bb,$cf,$ec,$c6,
$dc,$39,$66,$38,$0a,$d8,$fe,$cb,$17,$b6,$ba,$02,$46,$9a,$02,$0a,
$84,$e1,$8e,$8f,$84,$25,$20,$70,$c1,$3e,$9f,$1f,$28,$9b,$e5,$4f,
$bc,$48,$14,$57,$77,$8f,$61,$60,$15,$e1,$32,$7a,$02,$b1,$40,$f1,
$50,$5e,$b3,$09,$32,$6d,$68,$37,$8f,$83,$74,$59,$5c,$84,$9d,$84,
$f4,$c3,$33,$ec,$44,$23,$88,$51,$43,$cb,$47,$bd,$71,$c5,$ed,$ae,
$9b,$e6,$9a,$2f,$fe,$ce,$b1,$be,$c9,$de,$24,$4f,$be,$15,$99,$2b,
$11,$b7,$7c,$04,$0f,$12,$bd,$8f,$6a,$97,$5a,$44,$a0,$f9,$0c,$29,
$a9,$ab,$c3,$d4,$d8,$93,$92,$72,$84,$c5,$87,$54,$cc,$e2,$94,$52,
$9f,$86,$14,$dc,$d2,$ab,$a9,$91,$92,$5f,$ed,$c4,$ae,$74,$ff,$ac,
$6e,$33,$3b,$93,$eb,$4a,$ff,$04,$79,$da,$9a,$41,$0e,$44,$50,$e0,
$dd,$7a,$e4,$c6,$e2,$91,$09,$00,$57,$5d,$a4,$01,$fc,$07,$05,$9f,
$64,$5e,$8b,$7e,$9b,$fd,$ef,$33,$94,$30,$54,$ff,$84,$01,$14,$93,
$c2,$7b,$34,$29,$ea,$ed,$b4,$ed,$53,$76,$44,$1a,$77,$ed,$43,$85,
$1a,$d7,$7f,$16,$f5,$41,$df,$d2,$69,$d5,$0d,$6a,$5f,$14,$fb,$0a,
$ab,$1c,$bb,$4c,$15,$50,$be,$97,$f7,$ab,$40,$66,$19,$3c,$4c,$aa,
$77,$3d,$ad,$38,$01,$4b,$d2,$09,$2f,$a7,$55,$c8,$24,$bb,$5e,$54,
$c4,$f3,$6f,$fd,$a9,$fc,$ea,$70,$b9,$c6,$e6,$93,$e1,$48,$c1,$51);
twk: TAESBlock = ($ff,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 10');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v15;
const
k1 : array[0..15] of byte = ($ff,$fe,$fd,$fc,$fb,$fa,$f9,$f8,
$f7,$f6,$f5,$f4,$f3,$f2,$f1,$f0);
k2 : array[0..15] of byte = ($bf,$be,$bd,$bc,$bb,$ba,$b9,$b8,
$b7,$b6,$b5,$b4,$b3,$b2,$b1,$b0);
pt : array[0..16] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,$10);
ct : array[0..16] of byte = ($6c,$16,$25,$db,$46,$71,$52,$2d,
$3d,$75,$99,$60,$1d,$e7,$ca,$09,$ed);
twk: TAESBlock = ($9a,$78,$56,$34,$12,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 15');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v16;
const
k1 : array[0..15] of byte = ($ff,$fe,$fd,$fc,$fb,$fa,$f9,$f8,
$f7,$f6,$f5,$f4,$f3,$f2,$f1,$f0);
k2 : array[0..15] of byte = ($bf,$be,$bd,$bc,$bb,$ba,$b9,$b8,
$b7,$b6,$b5,$b4,$b3,$b2,$b1,$b0);
pt : array[0..17] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,$10,$11);
ct : array[0..17] of byte = ($d0,$69,$44,$4b,$7a,$7e,$0c,$ab,
$09,$e2,$44,$47,$d2,$4d,$eb,$1f,$ed,$bf);
twk: TAESBlock = ($9a,$78,$56,$34,$12,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 16');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v17;
const
k1 : array[0..15] of byte = ($ff,$fe,$fd,$fc,$fb,$fa,$f9,$f8,
$f7,$f6,$f5,$f4,$f3,$f2,$f1,$f0);
k2 : array[0..15] of byte = ($bf,$be,$bd,$bc,$bb,$ba,$b9,$b8,
$b7,$b6,$b5,$b4,$b3,$b2,$b1,$b0);
pt : array[0..18] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,$10,$11,$12);
ct : array[0..18] of byte = ($e5,$df,$13,$51,$c0,$54,$4b,$a1,
$35,$0b,$33,$63,$cd,$8e,$f4,$be,$ed,$bf,$9d);
twk: TAESBlock = ($9a,$78,$56,$34,$12,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 17');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
{---------------------------------------------------------------------------}
procedure test_v18;
const
k1 : array[0..15] of byte = ($ff,$fe,$fd,$fc,$fb,$fa,$f9,$f8,
$f7,$f6,$f5,$f4,$f3,$f2,$f1,$f0);
k2 : array[0..15] of byte = ($bf,$be,$bd,$bc,$bb,$ba,$b9,$b8,
$b7,$b6,$b5,$b4,$b3,$b2,$b1,$b0);
pt : array[0..19] of byte = ($00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,$10,$11,$12,$13);
ct : array[0..19] of byte = ($9d,$84,$c8,$13,$f7,$19,$aa,$2c,
$7b,$e3,$f6,$61,$71,$c7,$c5,$c2,$ed,$bf,$9d,$ac);
twk: TAESBlock = ($9a,$78,$56,$34,$12,0,0,0,0,0,0,0,0,0,0,0);
var
err: integer;
begin
writeln('Test vector 18');
err := AES_XTS_Init_Encr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Encr = ', err);
halt;
end;
err := AES_XTS_Encrypt(@pt, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Encrypt = ', err);
halt;
end;
writeln(' Enc: ',CompMem(@ct, @tmp, sizeof(ct)));
err := AES_XTS_Init_Decr(k1,k2,sizeof(k1)*8,ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Init_Decr = ', err);
halt;
end;
err := AES_XTS_Decrypt(@tmp, @tmp, sizeof(pt), twk, ctx);
if err<>0 then begin
writeln(' - Error AES_XTS_Decrypt = ', err);
halt;
end;
writeln(' Dec: ',CompMem(@pt, @tmp, sizeof(pt)));
end;
begin
writeln('Test program AES-XTS mode (c) 2007 W.Ehrhardt');
{$ifdef USEDLL}
writeln('DLL Version: ',AES_DLL_Version);
{$endif}
writeln('Test vectors from IEEE P1619:');
test_v01;
test_v02;
test_v04;
test_v10;
test_v15;
test_v16;
test_v17;
test_v18;
end.

133
Tocsg.Lib/VCL/EncLib/EM.CRC32.pas Normal file
View File

@ -0,0 +1,133 @@
unit EM.CRC32;
interface
uses
Windows, Classes, SysUtils;
procedure CRC32File(FileName: String; var CRC32: dword);
procedure CRC32String(S: String; var CRC32: dword);
procedure CRC32Data(var Data; Size: Integer; var CRC32: dword);
implementation
const Table: Array[0..255] of DWord =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// type Buffer = Array[1..65521] of byte;
{largest buffer that can be allocated on heap }
procedure CRC32File(FileName: String; var CRC32: dword);
var
F: file;
BytesRead: dword;
Buffer: Array[1..65521] of byte;
i: Word;
begin
FileMode := 0;
CRC32 := $ffffffff;
{$I-}
AssignFile(F, FileName); Reset(F, 1);
if IOResult = 0 then begin
repeat
BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
for i := 1 to BytesRead do
CRC32 := (CRC32 shr 8) xor Table[Buffer[i] xor (CRC32 and $000000FF)];
until BytesRead = 0;
end;
CloseFile(F);
{$I+}
CRC32 := not CRC32;
end;
procedure CRC32String(S: String; var CRC32: dword);
var
// Buffer: Array[1..65521] of byte;
i: Word;
begin
CRC32 := $ffffffff;
{$I-}
for i := 1 to Length(S) do
CRC32 := (CRC32 shr 8) xor Table[Byte(S[i]) xor (CRC32 and $000000FF)];
{$I+}
CRC32 := not CRC32;
end;
//procedure CRC32Data(var Data; Size: Integer; var CRC32: dword);
procedure CRC32Data;
var
// Buffer: Array[1..65521] of byte;
i: Word;
begin
CRC32 := $ffffffff;
{$I-}
for i := 0 to Size-1 do
CRC32 := (CRC32 shr 8) xor Table[PByteArray(@Data)[i] xor (CRC32 and $000000FF)];
{$I+}
CRC32 := not CRC32;
end;
end.

393
Tocsg.Lib/VCL/EncLib/EM.MD5.pas Normal file
View File

@ -0,0 +1,393 @@
// tabs = 2
// -----------------------------------------------------------------------------------------------
//
// MD5 Message-Digest for Delphi 4
//
// Delphi 4 Unit implementing the
// RSA Data Security, Inc. MD5 Message-Digest Algorithm
//
// Implementation of Ronald L. Rivest's RFC 1321
//
// Copyright ?1997-1999 Medienagentur Fichtner & Meyer
// Written by Matthias Fichtner
//
// -----------------------------------------------------------------------------------------------
// See RFC 1321 for RSA Data Security's copyright and license notice!
// -----------------------------------------------------------------------------------------------
//
// 14-Jun-97 mf Implemented MD5 according to RFC 1321 RFC 1321
// 16-Jun-97 mf Initial release of the compiled unit (no source code) RFC 1321
// 28-Feb-99 mf Added MD5Match function for comparing two digests RFC 1321
// 13-Sep-99 mf Reworked the entire unit RFC 1321
// 17-Sep-99 mf Reworked the "Test Driver" project RFC 1321
// 19-Sep-99 mf Release of sources for MD5 unit and "Test Driver" project RFC 1321
//
// -----------------------------------------------------------------------------------------------
// The latest release of md5.pas will always be available from
// the distribution site at: http://www.fichtner.net/delphi/md5/
// -----------------------------------------------------------------------------------------------
// Please send questions, bug reports and suggestions
// regarding this code to: mfichtner@fichtner-meyer.com
// -----------------------------------------------------------------------------------------------
// This code is provided "as is" without express or
// implied warranty of any kind. Use it at your own risk.
// -----------------------------------------------------------------------------------------------
unit EM.MD5;
// -----------------------------------------------------------------------------------------------
INTERFACE
// -----------------------------------------------------------------------------------------------
uses
Windows;
type
TMD5Count = array[0..1] of DWORD;
TMD5State = array[0..3] of DWORD;
TMD5Block = array[0..15] of DWORD;
TMD5CBits = array[0..7] of Byte;
TMD5Digest = array[0..15] of Byte;
TMD5Buffer = array[0..63] of Byte;
TMD5Context = record
State : TMD5State;
Count : TMD5Count;
Buffer : TMD5Buffer;
end;
procedure MD5Init(var Context: TMD5Context);
procedure MD5Update(var Context: TMD5Context; Input: PAnsiChar; Length: longword);
procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest);
function MD5String(M: AnsiString): TMD5Digest;
function MD5File(N: string): TMD5Digest;
function MD5Print(D: TMD5Digest): string;
function MD5Match(D1, D2: TMD5Digest): boolean;
// -----------------------------------------------------------------------------------------------
IMPLEMENTATION
// -----------------------------------------------------------------------------------------------
var
PADDING: TMD5Buffer = (
$80, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00
);
function F(x, y, z: DWORD): DWORD;
begin
Result := (x and y) or ((not x) and z);
end;
function G(x, y, z: DWORD): DWORD;
begin
Result := (x and z) or (y and (not z));
end;
function H(x, y, z: DWORD): DWORD;
begin
Result := x xor y xor z;
end;
function I(x, y, z: DWORD): DWORD;
begin
Result := y xor (x or (not z));
end;
procedure rot(var x: DWORD; n: BYTE);
begin
x := (x shl n) or (x shr (32 - n));
end;
procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, F(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, G(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, H(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, I(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
// -----------------------------------------------------------------------------------------------
// Encode Count bytes at Source into (Count / 4) DWORDs at Target
procedure Encode(Source, Target: pointer; Count: longword);
var
S: PByte;
T: PDWORD;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count div 4 do begin
T^ := S^;
inc(S);
T^ := T^ or (S^ shl 8);
inc(S);
T^ := T^ or (S^ shl 16);
inc(S);
T^ := T^ or (S^ shl 24);
inc(S);
inc(T);
end;
end;
// Decode Count DWORDs at Source into (Count * 4) Bytes at Target
procedure Decode(Source, Target: pointer; Count: longword);
var
S: PDWORD;
T: PByte;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count do begin
T^ := S^ and $ff;
inc(T);
T^ := (S^ shr 8) and $ff;
inc(T);
T^ := (S^ shr 16) and $ff;
inc(T);
T^ := (S^ shr 24) and $ff;
inc(T);
inc(S);
end;
end;
// Transform State according to first 64 bytes at Buffer
procedure Transform(Buffer: pointer; var State: TMD5State);
var
a, b, c, d: DWORD;
Block: TMD5Block;
begin
Encode(Buffer, @Block, 64);
a := State[0];
b := State[1];
c := State[2];
d := State[3];
FF (a, b, c, d, Block[ 0], 7, $d76aa478);
FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
FF (c, d, a, b, Block[ 2], 17, $242070db);
FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
FF (a, b, c, d, Block[ 4], 7, $f57c0faf);
FF (d, a, b, c, Block[ 5], 12, $4787c62a);
FF (c, d, a, b, Block[ 6], 17, $a8304613);
FF (b, c, d, a, Block[ 7], 22, $fd469501);
FF (a, b, c, d, Block[ 8], 7, $698098d8);
FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
FF (c, d, a, b, Block[10], 17, $ffff5bb1);
FF (b, c, d, a, Block[11], 22, $895cd7be);
FF (a, b, c, d, Block[12], 7, $6b901122);
FF (d, a, b, c, Block[13], 12, $fd987193);
FF (c, d, a, b, Block[14], 17, $a679438e);
FF (b, c, d, a, Block[15], 22, $49b40821);
GG (a, b, c, d, Block[ 1], 5, $f61e2562);
GG (d, a, b, c, Block[ 6], 9, $c040b340);
GG (c, d, a, b, Block[11], 14, $265e5a51);
GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
GG (a, b, c, d, Block[ 5], 5, $d62f105d);
GG (d, a, b, c, Block[10], 9, $2441453);
GG (c, d, a, b, Block[15], 14, $d8a1e681);
GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
GG (a, b, c, d, Block[ 9], 5, $21e1cde6);
GG (d, a, b, c, Block[14], 9, $c33707d6);
GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
GG (b, c, d, a, Block[ 8], 20, $455a14ed);
GG (a, b, c, d, Block[13], 5, $a9e3e905);
GG (d, a, b, c, Block[ 2], 9, $fcefa3f8);
GG (c, d, a, b, Block[ 7], 14, $676f02d9);
GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
HH (a, b, c, d, Block[ 5], 4, $fffa3942);
HH (d, a, b, c, Block[ 8], 11, $8771f681);
HH (c, d, a, b, Block[11], 16, $6d9d6122);
HH (b, c, d, a, Block[14], 23, $fde5380c);
HH (a, b, c, d, Block[ 1], 4, $a4beea44);
HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
HH (b, c, d, a, Block[10], 23, $bebfbc70);
HH (a, b, c, d, Block[13], 4, $289b7ec6);
HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
HH (b, c, d, a, Block[ 6], 23, $4881d05);
HH (a, b, c, d, Block[ 9], 4, $d9d4d039);
HH (d, a, b, c, Block[12], 11, $e6db99e5);
HH (c, d, a, b, Block[15], 16, $1fa27cf8);
HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
II (a, b, c, d, Block[ 0], 6, $f4292244);
II (d, a, b, c, Block[ 7], 10, $432aff97);
II (c, d, a, b, Block[14], 15, $ab9423a7);
II (b, c, d, a, Block[ 5], 21, $fc93a039);
II (a, b, c, d, Block[12], 6, $655b59c3);
II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
II (c, d, a, b, Block[10], 15, $ffeff47d);
II (b, c, d, a, Block[ 1], 21, $85845dd1);
II (a, b, c, d, Block[ 8], 6, $6fa87e4f);
II (d, a, b, c, Block[15], 10, $fe2ce6e0);
II (c, d, a, b, Block[ 6], 15, $a3014314);
II (b, c, d, a, Block[13], 21, $4e0811a1);
II (a, b, c, d, Block[ 4], 6, $f7537e82);
II (d, a, b, c, Block[11], 10, $bd3af235);
II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
II (b, c, d, a, Block[ 9], 21, $eb86d391);
inc(State[0], a);
inc(State[1], b);
inc(State[2], c);
inc(State[3], d);
end;
// -----------------------------------------------------------------------------------------------
// Initialize given Context
procedure MD5Init(var Context: TMD5Context);
begin
with Context do begin
State[0] := $67452301;
State[1] := $efcdab89;
State[2] := $98badcfe;
State[3] := $10325476;
Count[0] := 0;
Count[1] := 0;
ZeroMemory(@Buffer, SizeOf(TMD5Buffer));
end;
end;
// Update given Context to include Length bytes of Input
procedure MD5Update(var Context: TMD5Context; Input: PAnsiChar; Length: longword);
var
Index: longword;
PartLen: longword;
I: longword;
begin
with Context do begin
Index := (Count[0] shr 3) and $3f;
inc(Count[0], Length shl 3);
if Count[0] < (Length shl 3) then inc(Count[1]);
inc(Count[1], Length shr 29);
end;
PartLen := 64 - Index;
if Length >= PartLen then begin
CopyMemory(@Context.Buffer[Index], Input, PartLen);
Transform(@Context.Buffer, Context.State);
I := PartLen;
while I + 63 < Length do begin
Transform(@Input[I], Context.State);
inc(I, 64);
end;
Index := 0;
end else I := 0;
CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
end;
// Finalize given Context, create Digest and zeroize Context
procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest);
var
Bits: TMD5CBits;
Index: longword;
PadLen: longword;
begin
Decode(@Context.Count, @Bits, 2);
Index := (Context.Count[0] shr 3) and $3f;
if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
MD5Update(Context, @PADDING, PadLen);
MD5Update(Context, @Bits, 8);
Decode(@Context.State, @Digest, 4);
ZeroMemory(@Context, SizeOf(TMD5Context));
end;
// -----------------------------------------------------------------------------------------------
// Create digest of given Message
function MD5String(M: AnsiString): TMD5Digest;
var
Context: TMD5Context;
begin
MD5Init(Context);
MD5Update(Context, PAnsiChar(M), length(M));
MD5Final(Context, Result);
end;
// Create digest of file with given Name
function MD5File(N: string): TMD5Digest;
var
FileHandle: THandle;
MapHandle: THandle;
ViewPointer: pointer;
Context: TMD5Context;
begin
MD5Init(Context);
FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if FileHandle <> INVALID_HANDLE_VALUE then try
MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if MapHandle <> 0 then try
ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
if ViewPointer <> nil then try
MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
finally
UnmapViewOfFile(ViewPointer);
end;
finally
CloseHandle(MapHandle);
end;
finally
CloseHandle(FileHandle);
end;
MD5Final(Context, Result);
end;
// Create hex representation of given Digest
function MD5Print(D: TMD5Digest): string;
var
I: byte;
const
Digits: array[0..15] of char =
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
Result := '';
for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
end;
// -----------------------------------------------------------------------------------------------
// Compare two Digests
function MD5Match(D1, D2: TMD5Digest): boolean;
var
I: byte;
begin
I := 0;
Result := TRUE;
while Result and (I < 16) do begin
Result := D1[I] = D2[I];
inc(I);
end;
end;
end.

139
Tocsg.Lib/VCL/EncLib/EM.RC4.pas Normal file
View File

@ -0,0 +1,139 @@
{
***************************************************
* A binary compatible RC4 implementation *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* Stream encryption *
* Variable size key - up to 2048bit *
***************************************************
}
unit EM.RC4;
interface
uses
Windows, Sysutils;
type
TRC4Data= record
Key: array[0..255] of byte; { current key }
OrgKey: array[0..255] of byte; { original key }
end;
function RC4SelfTest: boolean;
{ performs a self test on this implementation }
procedure RC4Init(var Data: TRC4Data; Key: pointer; Len: integer);
{ initializes the TRC4Data structure with the key information }
procedure RC4Burn(var Data: TRC4Data);
{ erases all information about the key }
procedure RC4Crypt(var Data: TRC4Data; InData, OutData: pointer; Len: integer);
{ encrypts/decrypts Len bytes of data }
procedure RC4Reset(var Data: TRC4Data);
{ resets the key information }
procedure RC4CryptData(PrivateKey: String; KeySize: Integer;
var InData, OutData; Size: Integer);
{******************************************************************************}
implementation
function RC4SelfTest;
const
InBlock: array[0..4] of byte= ($dc,$ee,$4c,$f9,$2c);
OutBlock: array[0..4] of byte= ($f1,$38,$29,$c9,$de);
Key: array[0..4] of byte= ($61,$8a,$63,$d2,$fb);
var
Block: array[0..4] of byte;
Data: TRC4Data;
begin
RC4Init(Data,@Key,5);
RC4Crypt(Data,@InBlock,@Block,5);
Result:= CompareMem(@Block,@OutBlock,5);
RC4Reset(Data);
RC4Crypt(Data,@Block,@Block,5);
Result:= Result and CompareMem(@Block,@InBlock,5);
RC4Burn(Data);
end;
procedure RC4Init;
var
xKey: array[0..255] of byte;
i, j: integer;
t: byte;
begin
if (Len<= 0) or (Len> 256) then
raise Exception.Create('RC4: Invalid key length');
for i:= 0 to 255 do
begin
Data.Key[i]:= i;
xKey[i]:= PByte(integer(Key)+(i mod Len))^;
end;
j:= 0;
i := 0;
while i <= 255 do
begin
j:= (j+Data.Key[i]+xKey[i]) and $FF;
t:= Data.Key[i];
Data.Key[i]:= Data.Key[j];
Data.Key[j]:= t;
Inc(i);
end;
// for i:= 0 to 255 do
// begin
// j:= (j+Data.Key[i]+xKey[i]) and $FF;
// t:= Data.Key[i];
// Data.Key[i]:= Data.Key[j];
// Data.Key[j]:= t;
// end;
Move(Data.Key,Data.OrgKey,256);
end;
procedure RC4Burn;
begin
FillChar(Data,Sizeof(Data),$FF);
end;
procedure RC4Crypt;
var
t, i, j: byte;
k: integer;
begin
i:= 0;
j:= 0;
for k:= 0 to Len-1 do
begin
i:= (i+1) and $FF;
j:= (j+Data.Key[i]) and $FF;
t:= Data.Key[i];
Data.Key[i]:= Data.Key[j];
Data.Key[j]:= t;
t:= (Data.Key[i]+Data.Key[j]) and $FF;
PByteArray(OutData)[k]:= PByteArray(InData)[k] xor Data.Key[t];
end;
end;
procedure RC4Reset;
begin
Move(Data.OrgKey,Data.Key,256);
end;
procedure RC4CryptData(PrivateKey: String; KeySize: Integer;
var InData, OutData; Size: Integer);
var
RC4Data: TRC4Data;
begin
RC4Init(RC4Data,PAnsiChar(PrivateKey),KeySize);
RC4Crypt(RC4Data,@InData,@OutData, Size);
RC4Burn(RC4Data);
end;
end.

184
Tocsg.Lib/VCL/EncLib/EM.SHA1.pas Normal file
View File

@ -0,0 +1,184 @@
 {
***************************************************
* A binary compatible SHA1 implementation *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 160bit hash size *
***************************************************
}
unit EM.SHA1;
interface
uses
Windows, Sysutils, EM.Tools;
type
TSHA1Digest = array[0..19] of Byte;
TSHA1Context= record
Hash : array[0..4] of DWORD;
Hi, Lo : Integer;
Buffer : array[0..63] of Byte;
Index : Integer;
end;
//function SHA1SelfTest: boolean;
procedure SHA1Init(var Context: TSHA1Context);
procedure SHA1Update(var Context: TSHA1Context; Buffer: Pointer; Len: Integer);
procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest);
//******************************************************************************
implementation
{$R-}
//function SHA1SelfTest: boolean;
//const
// s: string= 'abc';
// OutDigest: TSHA1Digest=
// ($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d);
//var
// Context: TSHA1Context;
// Digest: TSHA1Digest;
//begin
// SHA1Init(Context);
// SHA1Update(Context,@s[1],length(s));
// SHA1Final(Context,Digest);
// if CompareMem(@Digest,@OutDigest,Sizeof(Digest)) then
// Result:= true
// else
// Result:= false;
//end;
//******************************************************************************
function F1(x, y, z: DWORD): DWORD;
begin
Result:= z xor (x and (y xor z));
end;
function F2(x, y, z: DWORD): DWORD;
begin
Result:= x xor y xor z;
end;
function F3(x, y, z: DWORD): DWORD;
begin
Result:= (x and y) or (z and (x or y));
end;
//******************************************************************************
function RB(A: DWORD): DWORD;
begin
Result:= (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
end;
procedure SHA1Compress(var Data: TSHA1Context);
var
A, B, C, D, E, T: DWORD;
W: array[0..79] of DWORD;
i: integer;
begin
Move(Data.Buffer,W,Sizeof(Data.Buffer));
for i:= 0 to 15 do
W[i]:= RB(W[i]);
for i:= 16 to 79 do
W[i]:= LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16],1);
A:= Data.Hash[0]; B:= Data.Hash[1]; C:= Data.Hash[2]; D:= Data.Hash[3]; E:= Data.Hash[4];
for i:= 0 to 19 do
begin
T:= LRot32(A,5) + F1(B,C,D) + E + W[i] + $5A827999;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 20 to 39 do
begin
T:= LRot32(A,5) + F2(B,C,D) + E + W[i] + $6ED9EBA1;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 40 to 59 do
begin
T:= LRot32(A,5) + F3(B,C,D) + E + W[i] + $8F1BBCDC;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 60 to 79 do
begin
T:= LRot32(A,5) + F2(B,C,D) + E + W[i] + $CA62C1D6;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
Data.Hash[0]:= Data.Hash[0] + A;
Data.Hash[1]:= Data.Hash[1] + B;
Data.Hash[2]:= Data.Hash[2] + C;
Data.Hash[3]:= Data.Hash[3] + D;
Data.Hash[4]:= Data.Hash[4] + E;
FillChar(W,Sizeof(W),0);
FillChar(Data.Buffer,Sizeof(Data.Buffer),0);
end;
//******************************************************************************
procedure SHA1Init(var Context: TSHA1Context);
begin
Context.Hi:= 0; Context.Lo:= 0;
Context.Index:= 0;
FillChar(Context.Buffer,Sizeof(Context.Buffer),0);
Context.Hash[0]:= $67452301;
Context.Hash[1]:= $EFCDAB89;
Context.Hash[2]:= $98BADCFE;
Context.Hash[3]:= $10325476;
Context.Hash[4]:= $C3D2E1F0;
end;
//******************************************************************************
procedure SHA1UpdateLen(var Context: TSHA1Context; Len: integer);
var
i, k: integer;
begin
for k:= 0 to 7 do
begin
i:= Context.Lo;
Inc(Context.Lo,Len);
if Context.Lo< i then
Inc(Context.Hi);
end;
end;
//******************************************************************************
procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer);
type
PByte= ^Byte;
begin
SHA1UpdateLen(Context,Len);
while Len> 0 do
begin
Context.Buffer[Context.Index]:= PByte(Buffer)^;
Inc(PByte(Buffer));
Inc(Context.Index);
Dec(Len);
if Context.Index= 64 then
begin
Context.Index:= 0;
SHA1Compress(Context);
end;
end;
end;
//******************************************************************************
procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest);
type
PDWORD= ^DWORD;
begin
Context.Buffer[Context.Index]:= $80;
if Context.Index>= 56 then
SHA1Compress(Context);
PDWORD(@Context.Buffer[56])^:= RB(Context.Hi);
PDWORD(@Context.Buffer[60])^:= RB(Context.Lo);
SHA1Compress(Context);
Context.Hash[0]:= RB(Context.Hash[0]);
Context.Hash[1]:= RB(Context.Hash[1]);
Context.Hash[2]:= RB(Context.Hash[2]);
Context.Hash[3]:= RB(Context.Hash[3]);
Context.Hash[4]:= RB(Context.Hash[4]);
Move(Context.Hash,Digest,Sizeof(Digest));
FillChar(Context,Sizeof(Context),0);
end;
end.

413
Tocsg.Lib/VCL/EncLib/EM.Tocsg.hash.pas Normal file
View File

@ -0,0 +1,413 @@
unit EM.Tocsg.Hash;
{General Hash Unit: This unit defines the common types, functions, and
procedures. Via Hash descriptors and corresponding pointers, algorithms
can be searched by name or by ID. More important: all supported algorithms
can be used in the HMAC and KDF constructions.}
interface
(*************************************************************************
DESCRIPTION : General hash unit: defines Algo IDs, digest types, etc
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : ---
REMARK : TTgHashContext does not directly map the structure of the
context for SHA3 algorithms, a typecast with TSHA3State
from unit SHA3 should be used to access the fields.
Version Date Author Modification
------- -------- ------- ------------------------------------------
0.10 15.01.06 W.Ehrhardt Initial version
0.11 15.01.06 we FindHash_by_ID, $ifdef DLL: stdcall
0.12 16.01.06 we FindHash_by_Name
0.13 18.01.06 we Descriptor fields HAlgNum, HSig
0.14 22.01.06 we Removed HSelfTest from descriptor
0.14 31.01.06 we RIPEMD-160, C_MinHash, C_MaxHash
0.15 11.02.06 we Fields: HDSize, HVersion, HPtrOID, HLenOID
0.16 02.08.06 we Packed arrays
0.17 07.08.06 we $ifdef BIT32: (const fname: shortstring...)
0.18 07.08.06 we C_HashVers = $00010002
0.19 10.02.07 we HashFile: no eof, XL and filemode via $ifdef
0.20 18.02.07 we MD4, C_HashVers = $00010003
0.21 22.02.07 we POID_Vec=^TOID_Vec, typed HPtrOID
0.22 24.02.07 we added some checks for HSig=C_HashSig
0.23 04.10.07 we TTgHashContext.Index now longint
0.24 02.05.08 we type PHashDigest, function HashSameDigest
0.25 04.05.08 we BitAPI_Mask, BitAPI_PBit
0.26 05.05.08 we Descriptor with HFinalBit, C_HashVers=$00010004
0.27 20.05.08 we RMD160 as alias for RIPEMD160
0.28 12.11.08 we uses BTypes and Str255
0.29 19.07.09 we D12 fix: assign with typecast string(fname)
0.30 08.03.12 we SHA512/224 and SHA512/256, C_HashVers=$00010005
0.31 10.03.12 we HashFile: {$ifndef BIT16} instead of {$ifdef WIN32}
0.32 08.08.18 we New enlarged padded context, _SHA3_224 .. _SHA3_512
0.33 08.08.18 we THMacBuffer, assert HASHCTXSIZE
0.34 16.08.15 we Removed $ifdef DLL / stdcall
0.35 15.05.17 we Changes for Blake2s
0.36 16.05.17 we MaxOIDLen = 11 and MaxC_HashVers = $00020002
0.37 03.11.17 we TBlake2B_384/512Digest
0.38 29.11.17 we HashFile - fname: string
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2006-2017 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{$i STD.INC}
uses
BTypes;
type
THashAlgorithm = (_MD4, _MD5, _RIPEMD160, _SHA1,
_SHA224, _SHA256, _SHA384, _SHA512,
_Whirlpool, _SHA512_224, _SHA512_256,
_SHA3_224, _SHA3_256, _SHA3_384, _SHA3_512,
_Blake2S_224, _Blake2S_256,
_Blake2B_384, _Blake2B_512); {Supported hash algorithms}
const
_RMD160 = _RIPEMD160; {Alias}
const
MaxBlockLen = 128; {Max. block length (buffer size), multiple of 4}
MaxDigestLen = 64; {Max. length of hash digest}
MaxStateLen = 16; {Max. size of internal state}
MaxOIDLen = 11; {Current max. OID length}
C_HashSig = $3D7A; {Signature for Hash descriptor}
C_HashVers = $00020002; {Version of Hash definitions}
C_MinHash = _MD4; {Lowest hash in THashAlgorithm}
C_MaxHash = _Blake2B_512;{Highest hash in THashAlgorithm}
type
THashState = packed array[0..MaxStateLen-1] of longint; {Internal state}
THashBuffer = packed array[0..MaxBlockLen-1] of byte; {hash buffer block}
THashDigest = packed array[0..MaxDigestLen-1] of byte; {hash digest}
PHashDigest = ^THashDigest; {pointer to hash digest}
THashBuf32 = packed array[0..MaxBlockLen div 4 -1] of longint; {type cast helper}
THashDig32 = packed array[0..MaxDigestLen div 4 -1] of longint; {type cast helper}
THMacBuffer = packed array[0..143] of byte; {hmac buffer block}
const
HASHCTXSIZE = 448; {Common size of enlarged padded old context}
{and new padded SHA3/SHAKE/Keccak context }
type
TTgHashContext = packed record
Hash : THashState; {Working hash}
MLen : packed array[0..3] of longint; {max 128 bit msg length}
Buffer: THashBuffer; {Block buffer}
Index : longint; {Index in buffer}
Fill2 : packed array[213..HASHCTXSIZE] of byte;
end;
type
TMD4Digest = packed array[0..15] of byte; {MD4 digest }
TMD5Digest = packed array[0..15] of byte; {MD5 digest }
TRMD160Digest = packed array[0..19] of byte; {RMD160 digest }
TSHA1Digest = packed array[0..19] of byte; {SHA1 digest }
TSHA224Digest = packed array[0..27] of byte; {SHA224 digest }
TSHA256Digest = packed array[0..31] of byte; {SHA256 digest }
TSHA384Digest = packed array[0..47] of byte; {SHA384 digest }
TSHA512Digest = packed array[0..63] of byte; {SHA512 digest }
TSHA5_224Digest = packed array[0..27] of byte; {SHA512/224 digest}
TSHA5_256Digest = packed array[0..31] of byte; {SHA512/256 digest}
TWhirlDigest = packed array[0..63] of byte; {Whirlpool digest }
TSHA3_224Digest = packed array[0..27] of byte; {SHA3_224 digest }
TSHA3_256Digest = packed array[0..31] of byte; {SHA3_256 digest }
TSHA3_384Digest = packed array[0..47] of byte; {SHA3_384 digest }
TSHA3_512Digest = packed array[0..63] of byte; {SHA3_512 digest }
TBlake2S_224Digest = packed array[0..27] of byte; {Blake2S digest }
TBlake2S_256Digest = packed array[0..31] of byte; {Blake2S digest }
TBlake2B_384Digest = packed array[0..47] of byte; {Blake2B-384 digest}
TBlake2B_512Digest = packed array[0..63] of byte; {Blake2B-512 digest}
type
HashInitProc = procedure(var Context: TTgHashContext);
{-initialize context}
HashUpdateXLProc = procedure(var Context: TTgHashContext; Msg: pointer; Len: longint);
{-update context with Msg data}
HashFinalProc = procedure(var Context: TTgHashContext; var Digest: THashDigest);
{-finalize calculation, clear context}
HashFinalBitProc = procedure(var Context: TTgHashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
{-finalize calculation with bitlen bits from BData, clear context}
type
TOID_Vec = packed array[1..MaxOIDLen] of longint; {OID vector}
POID_Vec = ^TOID_Vec; {ptr to OID vector}
Ptr2Inc = pByte; {Type cast to increment untyped pointer}
Str127 = string[127];
type
THashName = string[19]; {Hash algo name type }
PHashDesc = ^THashDesc; {Ptr to descriptor }
THashDesc = packed record
HSig : word; {Signature=C_HashSig }
HDSize : word; {sizeof(THashDesc) }
HDVersion : longint; {THashDesc Version }
HBlockLen : word; {Blocklength of hash, rate div 8 for SHA3}
HDigestlen: word; {Digestlength of hash}
HInit : HashInitProc; {Init procedure }
HFinal : HashFinalProc; {Final procedure }
HUpdateXL : HashUpdateXLProc; {Update procedure }
HAlgNum : longint; {Algo ID, longint avoids problems with enum size/DLL}
HName : THashName; {Name of hash algo }
HPtrOID : POID_Vec; {Pointer to OID vec }
HLenOID : word; {Length of OID vec }
HFill : word;
HFinalBit : HashFinalBitProc; {Bit-API Final proc }
HReserved : packed array[0..19] of byte;
end;
const
BitAPI_Mask: array[0..7] of byte = ($00,$80,$C0,$E0,$F0,$F8,$FC,$FE);
BitAPI_PBit: array[0..7] of byte = ($80,$40,$20,$10,$08,$04,$02,$01);
procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc);
{-Register algorithm with AlgID and Hash descriptor PHash^}
function FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc;
{-Return PHashDesc of AlgoID, nil if not found/registered}
function FindHash_by_Name(AlgoName: THashName): PHashDesc;
{-Return PHashDesc of Algo with AlgoName, nil if not found/registered}
procedure HashFile({$ifdef CONST} const {$endif} fname: string; PHash: PHashDesc;
var Digest: THashDigest; var buf; bsize: word; var Err: word);
{-Calculate hash digest of file, buf: buffer with at least bsize bytes}
procedure HashUpdate(PHash: PHashDesc; var Context: TTgHashContext; Msg: pointer; Len: word);
{-update context with Msg data}
procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint);
{-Calulate hash digest of Msg with init/update/final}
procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word);
{-Calulate hash digest of Msg with init/update/final}
function HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean;
{-Return true if same digests, using HDigestlen of PHash}
implementation
var
PHashVec : array[THashAlgorithm] of PHashDesc;
{Hash descriptor pointers of all defined hash algorithms}
{---------------------------------------------------------------------------}
procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc);
{-Register algorithm with AlgID and Hash descriptor PHash^}
begin
if (PHash<>nil) and
(PHash^.HAlgNum=longint(AlgId)) and
(PHash^.HSig=C_HashSig) and
(PHash^.HDVersion=C_HashVers) and
(PHash^.HDSize=sizeof(THashDesc)) then PHashVec[AlgId] := PHash;
end;
{---------------------------------------------------------------------------}
function FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc;
{-Return PHashDesc of AlgoID, nil if not found/registered}
var
p: PHashDesc;
A: longint;
begin
A := longint(AlgoID);
FindHash_by_ID := nil;
if (A>=ord(C_MinHash)) and (A<=ord(C_MaxHash)) then begin
p := PHashVec[AlgoID];
if (p<>nil) and (p^.HSig=C_HashSig) and (p^.HAlgNum=A) then FindHash_by_ID := p;
end;
end;
{---------------------------------------------------------------------------}
function FindHash_by_Name(AlgoName: THashName): PHashDesc;
{-Return PHashDesc of Algo with AlgoName, nil if not found/registered}
var
algo : THashAlgorithm;
phash: PHashDesc;
function StrUpcase(s: THashName): THashName;
{-Upcase for strings}
var
i: integer;
begin
for i:=1 to length(s) do s[i] := upcase(s[i]);
StrUpcase := s;
end;
begin
AlgoName := StrUpcase(Algoname);
{Transform RMD160 alias to standard name}
if AlgoName='RMD160' then AlgoName:='RIPEMD160';
FindHash_by_Name := nil;
for algo := C_MinHash to C_MaxHash do begin
phash := PHashVec[algo];
if (phash<>nil) and (AlgoName=StrUpcase(phash^.HName))
and (phash^.HSig=C_HashSig) and (phash^.HAlgNum=longint(algo))
then begin
FindHash_by_Name := phash;
exit;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure HashUpdate(PHash: PHashDesc; var Context: TTgHashContext; Msg: pointer; Len: word);
{-update context with Msg data}
begin
if PHash<>nil then with PHash^ do begin
if HSig=C_HashSig then HUpdateXL(Context, Msg, Len);
end;
end;
{---------------------------------------------------------------------------}
procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint);
{-Calulate hash digest of Msg with init/update/final}
var
Context: TTgHashContext;
begin
if PHash<>nil then with PHash^ do begin
if HSig=C_HashSig then begin
HInit(Context);
HUpdateXL(Context, Msg, Len);
HFinal(Context, Digest);
end;
end;
end;
{---------------------------------------------------------------------------}
procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word);
{-Calulate hash digest of Msg with init/update/final}
begin
{test PHash<>nil in HashFullXL}
HashFullXL(PHash, Digest, Msg, Len);
end;
{---------------------------------------------------------------------------}
function HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean;
{-Return true if same digests, using HDigestlen of PHash}
var
i: integer;
begin
HashSameDigest := false;
if PHash<>nil then with PHash^ do begin
if (HSig=C_HashSig) and (HDigestlen>0) then begin
for i:=0 to pred(HDigestlen) do begin
if PD1^[i]<>PD2^[i] then exit;
end;
HashSameDigest := true;
end;
end;
end;
{$i-} {Force I-}
{---------------------------------------------------------------------------}
procedure HashFile({$ifdef CONST} const {$endif} fname: string; PHash: PHashDesc;
var Digest: THashDigest; var buf; bsize: word; var Err: word);
{-Calculate hash digest of file, buf: buffer with at least bsize bytes}
var
{$ifdef VirtualPascal}
fms: word;
{$else}
fms: byte;
{$endif}
{$ifndef BIT16}
L: longint;
{$else}
L: word;
{$endif}
var
Context: TTgHashContext;
f: file;
begin
if (PHash=nil) or (Phash^.HSig<>C_HashSig) then begin
Err := 204; {Invalid pointer}
exit;
end;
fms := FileMode;
{$ifdef VirtualPascal}
FileMode := $40; {open_access_ReadOnly or open_share_DenyNone;}
{$else}
FileMode := 0;
{$endif}
system.assign(f,{$ifdef D12Plus} string {$endif} (fname));
system.reset(f,1);
Err := IOResult;
FileMode := fms;
if Err<>0 then exit;
with PHash^ do begin
HInit(Context);
L := bsize;
while (Err=0) and (L=bsize) do begin
system.blockread(f,buf,bsize,L);
Err := IOResult;
HUpdateXL(Context, @buf, L);
end;
system.close(f);
if IOResult=0 then {};
HFinal(Context, Digest);
end;
end;
begin
{$ifdef HAS_ASSERT}
assert(sizeof(TTgHashContext)=HASHCTXSIZE , '** Invalid sizeof(TTgHashContext)');
{$else}
if sizeof(TTgHashContext)<>HASHCTXSIZE then RunError(227);
{$endif}
{Paranoia: initialize all descriptor pointers to nil (should}
{be done by compiler/linker because array is in global data)}
fillchar(PHashVec,sizeof(PHashVec),0);
end.

905
Tocsg.Lib/VCL/EncLib/EM.Tocsg.sha1.pas Normal file
View File

@ -0,0 +1,905 @@
unit EM.Tocsg.SHA1;
{SHA1 - 160 bit Secure Hash Function}
interface
(*************************************************************************
DESCRIPTION : SHA1 - 160 bit Secure Hash Function
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP
EXTERNAL DATA : ---
MEMORY USAGE : ---
DISPLAY MODE : ---
REFERENCES : - Latest specification of Secure Hash Standard:
http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf
- Test vectors and intermediate values:
http://csrc.nist.gov/groups/ST/toolkit/documents/Examples/SHA_All.pdf
Version Date Author Modification
------- -------- ------- ------------------------------------------
1.00 03.01.02 W.Ehrhardt BP7 implementation
1.01 14.03.02 we D1-D6, FPC, VP
1.02 14.03.02 we TP6
1.03 14.03.02 we TP6/7 386-Code
1.04 14.03.02 we TP5.5
1.10 15.03.02 we self test with 2 strings
1.11 02.01.03 we const SFA with @ for FPC 1.0.6
1.20 23.07.03 we With SHA1File, SHA1Full
1.21 26.07.03 we With SHA1Full in self test
2.00 26.07.03 we common vers., longint for word32, D4+ - warnings
2.01 03.08.03 we type TSHA1Block for HMAC
2.02 23.08.03 we SHA1Compress in interface for prng
2.10 29.08.03 we XL versions for Win32
2.20 27.09.03 we FPC/go32v2
2.30 05.10.03 we STD.INC, TP5.0
2.40 10.10.03 we common version, english comments
2.45 11.10.03 we Speedup: partial unroll, no function calls
2.50 16.11.03 we Speedup in update, don't clear W in compress
2.51 17.11.03 we BIT16: partial unroll, BIT32: inline rot
2.52 17.11.03 we ExpandMessageBlocks
2.53 18.11.03 we LRot32, RB mit inline()
2.54 20.11.03 we Full range UpdateLen
2.55 30.11.03 we BIT16: {$F-}
2.56 30.11.03 we BIT16: LRot_5, LRot_30
3.00 01.12.03 we Common version 3.0
3.01 22.12.03 we BIT16: Two INCs
3.02 22.12.03 we BASM16: asm Lrot30
3.03 22.12.03 we TP5/5.5: LRot, RA inline
3.04 22,12.03 we Changed UpdateLen: Definition and TP5/5.5 inline
3.05 05.03.04 we Update fips180-2 URL
3.06 26.02.05 we With {$ifdef StrictLong}
3.07 05.05.05 we Use longint() in SH1Init to avoid D9 errors if $R+
3.08 17.12.05 we Force $I- in SHA1File
3.09 08.01.06 we SHA1Compress removed from interface
3.10 15.01.06 we uses Hash unit and THashDesc
3.11 18.01.06 we Descriptor fields HAlgNum, HSig
3.12 22.01.06 we Removed HSelfTest from descriptor
3.13 11.02.06 we Descriptor as typed const
3.14 26.03.06 we Round constants K1..K4, code reordering
3.15 07.08.06 we $ifdef BIT32: (const fname: shortstring...)
3.16 22.02.07 we values for OID vector
3.17 30.06.07 we Use conditional define FPC_ProcVar
3.18 04.10.07 we FPC: {$asmmode intel}
3.19 02.05.08 we Bit-API: SHA1FinalBits/Ex
3.20 05.05.08 we THashDesc constant with HFinalBit field
3.21 12.11.08 we uses BTypes, Ptr2Inc and/or Str255/Str127
3.22 12.03.10 we Fix VP feature in ExpandMessageBlocks
3.23 11.03.12 we Updated references
3.24 26.12.12 we D17 and PurePascal
3.25 16.08.15 we Removed $ifdef DLL / stdcall
3.26 15.05.17 we adjust OID to new MaxOIDLen
3.27 29.11.17 we SHA1File - fname: string
**************************************************************************)
(*-------------------------------------------------------------------------
(C) Copyright 2002-2017 Wolfgang Ehrhardt
This software is provided 'as-is', without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
----------------------------------------------------------------------------*)
{NOTE: FIPS Ch and May functions can be optimized. Wei Dai (Crypto++ 3.1)
credits Rich Schroeppel (rcs@cs.arizona.edu), V 5.1 does not!?}
{$i STD.INC}
{$ifdef BIT64}
{$ifndef PurePascal}
{$define PurePascal}
{$endif}
{$endif}
uses
// BTypes,Hash;
EM.Tocsg.Hash;
procedure SHA1Init(var Context: TTgHashContext);
{-initialize context}
procedure SHA1Update(var Context: TTgHashContext; Msg: pointer; Len: word);
{-update context with Msg data}
procedure SHA1UpdateXL(var Context: TTgHashContext; Msg: pointer; Len: longint);
{-update context with Msg data}
procedure SHA1Final(var Context: TTgHashContext; var Digest: TSHA1Digest);
{-finalize SHA1 calculation, clear context}
procedure SHA1FinalEx(var Context: TTgHashContext; var Digest: THashDigest);
{-finalize SHA1 calculation, clear context}
procedure SHA1FinalBitsEx(var Context: TTgHashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
{-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context}
procedure SHA1FinalBits(var Context: TTgHashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer);
{-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context}
function SHA1SelfTest: boolean;
{-self test SHA1: compare with known value}
procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word);
{-SHA1 of Msg with init/update/final}
procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint);
{-SHA1 of Msg with init/update/final}
procedure SHA1File({$ifdef CONST} const {$endif} fname: string;
var Digest: TSHA1Digest; var buf; bsize: word; var Err: word);
{-SHA1 of file, buf: buffer with at least bsize bytes}
implementation
{$ifdef BIT16}
{$F-}
{$endif}
const
SHA1_BlockLen = 64;
const {round constants}
K1 = longint($5A827999); {round 00..19}
K2 = longint($6ED9EBA1); {round 20..39}
K3 = longint($8F1BBCDC); {round 40..59}
K4 = longint($CA62C1D6); {round 60..79}
{Internal types}
type
TWorkBuf = array[0..79] of longint;
{1.3.14.3.2.26}
{iso(1) identified-organization(3) oiw(14) secsig(3) algorithms(2) hashAlgorithmIdentifier(26)}
const
SHA1_OID : TOID_Vec = (1,3,14,3,2,26,-1,-1,-1,-1,-1); {Len=6}
{$ifndef VER5X}
const
SHA1_Desc: THashDesc = (
HSig : C_HashSig;
HDSize : sizeof(THashDesc);
HDVersion : C_HashVers;
HBlockLen : SHA1_BlockLen;
HDigestlen: sizeof(TSHA1Digest);
{$ifdef FPC_ProcVar}
HInit : @SHA1Init;
HFinal : @SHA1FinalEx;
HUpdateXL : @SHA1UpdateXL;
{$else}
HInit : SHA1Init;
HFinal : SHA1FinalEx;
HUpdateXL : SHA1UpdateXL;
{$endif}
HAlgNum : longint(_SHA1);
HName : 'SHA1';
HPtrOID : @SHA1_OID;
HLenOID : 6;
HFill : 0;
{$ifdef FPC_ProcVar}
HFinalBit : @SHA1FinalBitsEx;
{$else}
HFinalBit : SHA1FinalBitsEx;
{$endif}
HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
);
{$else}
var
SHA1_Desc: THashDesc;
{$endif}
{$ifndef BIT16}
{$ifdef PurePascal}
{---------------------------------------------------------------------------}
procedure UpdateLen(var whi, wlo: longint; BLen: longint);
{-Add BLen to 64 bit value (wlo, whi)}
var
tmp: int64;
begin
tmp := int64(cardinal(wlo))+Blen;
wlo := longint(tmp and $FFFFFFFF);
inc(whi,longint(tmp shr 32));
end;
{---------------------------------------------------------------------------}
function RB(A: longint): longint;
{-reverse byte order in longint}
begin
RB := ((A and $FF) shl 24) or ((A and $FF00) shl 8) or ((A and $FF0000) shr 8) or ((A and longint($FF000000)) shr 24);
end;
{---------------------------------------------------------------------------}
procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer);
{-Calculate "expanded message blocks"}
var
i,T: longint;
begin
{Part 1: Transfer buffer with little -> big endian conversion}
for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]);
{Part 2: Calculate remaining "expanded message blocks"}
for i:= 16 to 79 do begin
T := W[i-3] xor W[i-8] xor W[i-14] xor W[i-16];
W[i] := (T shl 1) or (T shr 31);
end;
end;
{$else}
{---------------------------------------------------------------------------}
procedure UpdateLen(var whi, wlo: longint; BLen: longint);
{-Add BLen to 64 bit value (wlo, whi)}
begin
asm
mov edx, [wlo]
mov ecx, [whi]
mov eax, [Blen]
add [edx], eax
adc dword ptr [ecx], 0
end;
end;
{---------------------------------------------------------------------------}
function RB(A: longint): longint; assembler;
{-reverse byte order in longint}
asm
{$ifdef LoadArgs}
mov eax,[A]
{$endif}
xchg al,ah
rol eax,16
xchg al,ah
end;
{---------------------------------------------------------------------------}
procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); assembler;
{-Calculate "expanded message blocks"}
asm
{$ifdef LoadArgs}
mov edx,Buf
mov ecx,W {load W before push ebx to avoid VP crash}
push ebx {if compiling with no ASM stack frames}
mov ebx,ecx
{$else}
push ebx
mov ebx,eax
{$endif}
{part1: W[i]:= RB(TW32Buf(Buf)[i])}
mov ecx,16
@@1: mov eax,[edx]
xchg al,ah
rol eax,16
xchg al,ah
mov [ebx],eax
add ebx,4
add edx,4
dec ecx
jnz @@1
{part2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);}
mov ecx,64
@@2: mov eax,[ebx- 3*4]
xor eax,[ebx- 8*4]
xor eax,[ebx-14*4]
xor eax,[ebx-16*4]
rol eax,1
mov [ebx],eax
add ebx,4
dec ecx
jnz @@2
pop ebx
end;
{$endif}
{---------------------------------------------------------------------------}
procedure SHA1Compress(var Data: TTgHashContext);
{-Actual hashing function}
var
i: integer;
A, B, C, D, E: longint;
W: TWorkBuf;
begin
ExpandMessageBlocks(W, Data.Buffer);
A := Data.Hash[0];
B := Data.Hash[1];
C := Data.Hash[2];
D := Data.Hash[3];
E := Data.Hash[4];
{SHA1 compression function}
{Partial unroll for more speed, full unroll is only slightly faster}
{BIT32: rotateleft via inline}
i := 0;
while i<20 do begin
inc(E, (A shl 5 or A shr 27) + (D xor (B and (C xor D))) + W[i ] + K1); B := B shr 2 or B shl 30;
inc(D, (E shl 5 or E shr 27) + (C xor (A and (B xor C))) + W[i+1] + K1); A := A shr 2 or A shl 30;
inc(C, (D shl 5 or D shr 27) + (B xor (E and (A xor B))) + W[i+2] + K1); E := E shr 2 or E shl 30;
inc(B, (C shl 5 or C shr 27) + (A xor (D and (E xor A))) + W[i+3] + K1); D := D shr 2 or D shl 30;
inc(A, (B shl 5 or B shr 27) + (E xor (C and (D xor E))) + W[i+4] + K1); C := C shr 2 or C shl 30;
inc(i,5);
end;
while i<40 do begin
inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K2); B := B shr 2 or B shl 30;
inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K2); A := A shr 2 or A shl 30;
inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K2); E := E shr 2 or E shl 30;
inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K2); D := D shr 2 or D shl 30;
inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K2); C := C shr 2 or C shl 30;
inc(i,5);
end;
while i<60 do begin
inc(E, (A shl 5 or A shr 27) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := B shr 2 or B shl 30;
inc(D, (E shl 5 or E shr 27) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := A shr 2 or A shl 30;
inc(C, (D shl 5 or D shr 27) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := E shr 2 or E shl 30;
inc(B, (C shl 5 or C shr 27) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := D shr 2 or D shl 30;
inc(A, (B shl 5 or B shr 27) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := C shr 2 or C shl 30;
inc(i,5);
end;
while i<80 do begin
inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K4); B := B shr 2 or B shl 30;
inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K4); A := A shr 2 or A shl 30;
inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K4); E := E shr 2 or E shl 30;
inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K4); D := D shr 2 or D shl 30;
inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K4); C := C shr 2 or C shl 30;
inc(i,5);
end;
{Calculate new working hash}
inc(Data.Hash[0], A);
inc(Data.Hash[1], B);
inc(Data.Hash[2], C);
inc(Data.Hash[3], D);
inc(Data.Hash[4], E);
end;
{$else}
{$ifdef BASM16}
{TP6-7/Delphi1 for 386+}
{---------------------------------------------------------------------------}
procedure UpdateLen(var whi, wlo: longint; BLen: longint); assembler;
{-Add BLen to 64 bit value (wlo, whi)}
asm
les di,[wlo]
db $66; mov ax,word ptr [BLen]
db $66; sub dx,dx
db $66; add es:[di],ax
les di,[whi]
db $66; adc es:[di],dx
end;
{---------------------------------------------------------------------------}
function LRot_5(x: longint): longint;
{-Rotate left 5}
inline(
$66/$58/ {pop eax }
$66/$C1/$C0/$05/ {rol eax,5 }
$66/$8B/$D0/ {mov edx,eax}
$66/$C1/$EA/$10); {shr edx,16 }
{---------------------------------------------------------------------------}
function RB(A: longint): longint;
{-reverse byte order in longint}
inline(
$58/ {pop ax }
$5A/ {pop dx }
$86/$C6/ {xchg dh,al }
$86/$E2); {xchg dl,ah }
{---------------------------------------------------------------------------}
procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); assembler;
{-Calculate "expanded message blocks"}
asm
push ds
{part 1: W[i]:= RB(TW32Buf(Buf)[i])}
les di,[Buf]
lds si,[W]
mov cx,16
@@1: db $66; mov ax,es:[di]
xchg al,ah
db $66; rol ax,16
xchg al,ah
db $66; mov [si],ax
add si,4
add di,4
dec cx
jnz @@1
{part 2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);}
mov cx,64
@@2: db $66; mov ax,[si- 3*4]
db $66; xor ax,[si- 8*4]
db $66; xor ax,[si-14*4]
db $66; xor ax,[si-16*4]
db $66; rol ax,1
db $66; mov [si],ax
add si,4
dec cx
jnz @@2
pop ds
end;
{---------------------------------------------------------------------------}
procedure SHA1Compress(var Data: TTgHashContext);
{-Actual hashing function}
var
i: integer;
A, B, C, D, E: longint;
W: TWorkBuf;
begin
ExpandMessageBlocks(W, Data.Buffer);
{Assign old working hash to variables A..E}
A := Data.Hash[0];
B := Data.Hash[1];
C := Data.Hash[2];
D := Data.Hash[3];
E := Data.Hash[4];
{SHA1 compression function}
{Partial unroll for more speed, full unroll only marginally faster}
{Two INCs, LRot_30 via BASM}
i := 0;
while i<20 do begin
inc(E,LRot_5(A)); inc(E,(D xor (B and (C xor D))) + W[i ] + K1); asm db $66; rol word[B],30 end;
inc(D,LRot_5(E)); inc(D,(C xor (A and (B xor C))) + W[i+1] + K1); asm db $66; rol word[A],30 end;
inc(C,LRot_5(D)); inc(C,(B xor (E and (A xor B))) + W[i+2] + K1); asm db $66; rol word[E],30 end;
inc(B,LRot_5(C)); inc(B,(A xor (D and (E xor A))) + W[i+3] + K1); asm db $66; rol word[D],30 end;
inc(A,LRot_5(B)); inc(A,(E xor (C and (D xor E))) + W[i+4] + K1); asm db $66; rol word[C],30 end;
inc(i,5);
end;
while i<40 do begin
inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K2); asm db $66; rol word[B],30 end;
inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K2); asm db $66; rol word[A],30 end;
inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K2); asm db $66; rol word[E],30 end;
inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K2); asm db $66; rol word[D],30 end;
inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K2); asm db $66; rol word[C],30 end;
inc(i,5);
end;
while i<60 do begin
inc(E,LRot_5(A)); inc(E,((B and C) or (D and (B or C))) + W[i ] + K3); asm db $66; rol word[B],30 end;
inc(D,LRot_5(E)); inc(D,((A and B) or (C and (A or B))) + W[i+1] + K3); asm db $66; rol word[A],30 end;
inc(C,LRot_5(D)); inc(C,((E and A) or (B and (E or A))) + W[i+2] + K3); asm db $66; rol word[E],30 end;
inc(B,LRot_5(C)); inc(B,((D and E) or (A and (D or E))) + W[i+3] + K3); asm db $66; rol word[D],30 end;
inc(A,LRot_5(B)); inc(A,((C and D) or (E and (C or D))) + W[i+4] + K3); asm db $66; rol word[C],30 end;
inc(i,5);
end;
while i<80 do begin
inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K4); asm db $66; rol word[B],30 end;
inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K4); asm db $66; rol word[A],30 end;
inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K4); asm db $66; rol word[E],30 end;
inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K4); asm db $66; rol word[D],30 end;
inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K4); asm db $66; rol word[C],30 end;
inc(i,5);
end;
{Calculate new working hash}
inc(Data.Hash[0], A);
inc(Data.Hash[1], B);
inc(Data.Hash[2], C);
inc(Data.Hash[3], D);
inc(Data.Hash[4], E);
end;
{$else}
{TP5/5.5}
{---------------------------------------------------------------------------}
procedure UpdateLen(var whi, wlo: longint; BLen: longint);
{-Add BLen to 64 bit value (wlo, whi)}
inline(
$58/ {pop ax }
$5A/ {pop dx }
$5B/ {pop bx }
$07/ {pop es }
$26/$01/$07/ {add es:[bx],ax }
$26/$11/$57/$02/ {adc es:[bx+02],dx}
$5B/ {pop bx }
$07/ {pop es }
$26/$83/$17/$00/ {adc es:[bx],0 }
$26/$83/$57/$02/$00);{adc es:[bx+02],0 }
{---------------------------------------------------------------------------}
function RB(A: longint): longint;
{-reverse byte order in longint}
inline(
$58/ { pop ax }
$5A/ { pop dx }
$86/$C6/ { xchg dh,al}
$86/$E2); { xchg dl,ah}
{---------------------------------------------------------------------------}
function LRot_1(x: longint): longint;
{-Rotate left 1}
inline(
$58/ { pop ax }
$5A/ { pop dx }
$2B/$C9/ { sub cx,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1); { adc ax,cx}
{---------------------------------------------------------------------------}
function LRot_5(x: longint): longint;
{-Rotate left 5}
inline(
$58/ { pop ax }
$5A/ { pop dx }
$2B/$C9/ { sub cx,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1/ { adc ax,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1/ { adc ax,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1/ { adc ax,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1/ { adc ax,cx}
$D1/$D0/ { rcl ax,1 }
$D1/$D2/ { rcl dx,1 }
$13/$C1); { adc ax,cx}
{---------------------------------------------------------------------------}
function LRot_30(x: longint): longint;
{-Rotate left 30 = rot right 2}
inline(
$58/ { pop ax }
$5A/ { pop dx }
$8B/$CA/ { mov cx,dx}
$D1/$E9/ { shr cx,1 }
$D1/$D8/ { rcr ax,1 }
$D1/$DA/ { rcr dx,1 }
$8B/$CA/ { mov cx,dx}
$D1/$E9/ { shr cx,1 }
$D1/$D8/ { rcr ax,1 }
$D1/$DA); { rcr dx,1 }
{---------------------------------------------------------------------------}
procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer);
{-Calculate "expanded message blocks"}
var
i: integer;
begin
{Part 1: Transfer buffer with little -> big endian conversion}
for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]);
{Part 2: Calculate remaining "expanded message blocks"}
for i:= 16 to 79 do W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);
end;
{---------------------------------------------------------------------------}
procedure SHA1Compress(var Data: TTgHashContext);
{-Actual hashing function}
var
i: integer;
A, B, C, D, E: longint;
W: TWorkBuf;
begin
ExpandMessageBlocks(W, Data.Buffer);
{Assign old working hash to variables A..E}
A := Data.Hash[0];
B := Data.Hash[1];
C := Data.Hash[2];
D := Data.Hash[3];
E := Data.Hash[4];
{SHA1 compression function}
{Partial unroll for more speed, full unroll only marginally faster}
{BIT16: rotateleft via function call}
i := 0;
while i<20 do begin
inc(E,LRot_5(A) + (D xor (B and (C xor D))) + W[i ] + K1); B := LRot_30(B);
inc(D,LRot_5(E) + (C xor (A and (B xor C))) + W[i+1] + K1); A := LRot_30(A);
inc(C,LRot_5(D) + (B xor (E and (A xor B))) + W[i+2] + K1); E := LRot_30(E);
inc(B,LRot_5(C) + (A xor (D and (E xor A))) + W[i+3] + K1); D := LRot_30(D);
inc(A,LRot_5(B) + (E xor (C and (D xor E))) + W[i+4] + K1); C := LRot_30(C);
inc(i,5);
end;
while i<40 do begin
inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K2); B := LRot_30(B);
inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K2); A := LRot_30(A);
inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K2); E := LRot_30(E);
inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K2); D := LRot_30(D);
inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K2); C := LRot_30(C);
inc(i,5);
end;
while i<60 do begin
inc(E,LRot_5(A) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := LRot_30(B);
inc(D,LRot_5(E) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := LRot_30(A);
inc(C,LRot_5(D) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := LRot_30(E);
inc(B,LRot_5(C) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := LRot_30(D);
inc(A,LRot_5(B) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := LRot_30(C);
inc(i,5);
end;
while i<80 do begin
inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K4); B := LRot_30(B);
inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K4); A := LRot_30(A);
inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K4); E := LRot_30(E);
inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K4); D := LRot_30(D);
inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K4); C := LRot_30(C);
inc(i,5);
end;
{Calculate new working hash}
inc(Data.Hash[0], A);
inc(Data.Hash[1], B);
inc(Data.Hash[2], C);
inc(Data.Hash[3], D);
inc(Data.Hash[4], E);
end;
{$endif BASM16}
{$endif BIT16}
{---------------------------------------------------------------------------}
procedure SHA1Init(var Context: TTgHashContext);
{-initialize context}
begin
{Clear context, buffer=0!!}
fillchar(Context,sizeof(Context),0);
with Context do begin
Hash[0] := longint($67452301);
Hash[1] := longint($EFCDAB89);
Hash[2] := longint($98BADCFE);
Hash[3] := longint($10325476);
Hash[4] := longint($C3D2E1F0);
end;
end;
{---------------------------------------------------------------------------}
procedure SHA1UpdateXL(var Context: TTgHashContext; Msg: pointer; Len: longint);
{-update context with Msg data}
var
i: integer;
begin
{Update message bit length}
if Len<=$1FFFFFFF then UpdateLen(Context.MLen[1], Context.MLen[0], Len shl 3)
else begin
for i:=1 to 8 do UpdateLen(Context.MLen[1], Context.MLen[0], Len)
end;
while Len > 0 do begin
{fill block with msg data}
Context.Buffer[Context.Index]:= pByte(Msg)^;
inc(Ptr2Inc(Msg));
inc(Context.Index);
dec(Len);
if Context.Index=SHA1_BlockLen then begin
{If 512 bit transferred, compress a block}
Context.Index:= 0;
SHA1Compress(Context);
while Len>=SHA1_BlockLen do begin
move(Msg^,Context.Buffer,SHA1_BlockLen);
SHA1Compress(Context);
inc(Ptr2Inc(Msg),SHA1_BlockLen);
dec(Len,SHA1_BlockLen);
end;
end;
end;
end;
{---------------------------------------------------------------------------}
procedure SHA1Update(var Context: TTgHashContext; Msg: pointer; Len: word);
{-update context with Msg data}
begin
SHA1UpdateXL(Context, Msg, Len);
end;
{---------------------------------------------------------------------------}
procedure SHA1FinalBitsEx(var Context: TTgHashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
{-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context}
var
i: integer;
begin
{Message padding}
{append bits from BData and a single '1' bit}
if (bitlen>0) and (bitlen<=7) then begin
Context.Buffer[Context.Index]:= (BData and BitAPI_Mask[bitlen]) or BitAPI_PBit[bitlen];
UpdateLen(Context.MLen[1], Context.MLen[0], bitlen);
end
else Context.Buffer[Context.Index]:= $80;
for i:=Context.Index+1 to 63 do Context.Buffer[i] := 0;
{2. Compress if more than 448 bits, (no room for 64 bit length}
if Context.Index>= 56 then begin
SHA1Compress(Context);
fillchar(Context.Buffer,56,0);
end;
{Write 64 bit msg length into the last bits of the last block}
{(in big endian format) and do a final compress}
THashBuf32(Context.Buffer)[14] := RB(Context.MLen[1]);
THashBuf32(Context.Buffer)[15] := RB(Context.MLen[0]);
SHA1Compress(Context);
{Hash->Digest to little endian format}
fillchar(Digest, sizeof(Digest), 0);
for i:=0 to 4 do THashDig32(Digest)[i]:= RB(Context.Hash[i]);
{Clear context}
fillchar(Context,sizeof(Context),0);
end;
{---------------------------------------------------------------------------}
procedure SHA1FinalBits(var Context: TTgHashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer);
{-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context}
var
tmp: THashDigest;
begin
SHA1FinalBitsEx(Context, tmp, BData, bitlen);
move(tmp, Digest, sizeof(Digest));
end;
{---------------------------------------------------------------------------}
procedure SHA1FinalEx(var Context: TTgHashContext; var Digest: THashDigest);
{-finalize SHA1 calculation, clear context}
begin
SHA1FinalBitsEx(Context,Digest,0,0);
end;
{---------------------------------------------------------------------------}
procedure SHA1Final(var Context: TTgHashContext; var Digest: TSHA1Digest);
{-finalize SHA1 calculation, clear context}
var
tmp: THashDigest;
begin
SHA1FinalBitsEx(Context, tmp, 0, 0);
move(tmp, Digest, sizeof(Digest));
end;
{---------------------------------------------------------------------------}
function SHA1SelfTest: boolean;
{-self test SHA1: compare with known value}
const
s1: string[ 3] = 'abc';
s2: string[56] = 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq';
D1: TSHA1Digest= ($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d);
D2: TSHA1Digest= ($84,$98,$3E,$44,$1C,$3B,$D2,$6E,$BA,$AE,$4A,$A1,$F9,$51,$29,$E5,$E5,$46,$70,$F1);
D3: TSHA1Digest= ($bb,$6b,$3e,$18,$f0,$11,$5b,$57,$92,$52,$41,$67,$6f,$5b,$1a,$e8,$87,$47,$b0,$8a);
D4: TSHA1Digest= ($98,$23,$2a,$15,$34,$53,$14,$9a,$f8,$d5,$2a,$61,$50,$3a,$50,$74,$b8,$59,$70,$e8);
var
Context: TTgHashContext;
Digest : TSHA1Digest;
function SingleTest(s: Str127; TDig: TSHA1Digest): boolean;
{-do a single test, const not allowed for VER<7}
{ Two sub tests: 1. whole string, 2. one update per char}
var
i: integer;
begin
SingleTest := false;
{1. Hash complete string}
SHA1Full(Digest, @s[1],length(s));
{Compare with known value}
if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit;
{2. one update call for all chars}
SHA1Init(Context);
for i:=1 to length(s) do SHA1Update(Context,@s[i],1);
SHA1Final(Context,Digest);
{Compare with known value}
if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit;
SingleTest := true;
end;
begin
SHA1SelfTest := false;
{1 Zero bit from NESSIE test vectors}
SHA1Init(Context);
SHA1FinalBits(Context,Digest,0,1);
if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit;
{4 hightest bits of $50, D4 calculated with program shatest from RFC 4634}
SHA1Init(Context);
SHA1FinalBits(Context,Digest,$50,4);
if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D4)) then exit;
{strings from SHA1 document}
SHA1SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2)
end;
{---------------------------------------------------------------------------}
procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint);
{-SHA1 of Msg with init/update/final}
var
Context: TTgHashContext;
begin
SHA1Init(Context);
SHA1UpdateXL(Context, Msg, Len);
SHA1Final(Context, Digest);
end;
{---------------------------------------------------------------------------}
procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word);
{-SHA1 of Msg with init/update/final}
begin
SHA1FullXL(Digest, Msg, Len);
end;
{---------------------------------------------------------------------------}
procedure SHA1File({$ifdef CONST} const {$endif} fname: string;
var Digest: TSHA1Digest; var buf; bsize: word; var Err: word);
{-SHA1 of file, buf: buffer with at least bsize bytes}
var
tmp: THashDigest;
begin
HashFile(fname, @SHA1_Desc, tmp, buf, bsize, Err);
move(tmp, Digest, sizeof(Digest));
end;
begin
{$ifdef VER5X}
fillchar(SHA1_Desc, sizeof(SHA1_Desc), 0);
with SHA1_Desc do begin
HSig := C_HashSig;
HDSize := sizeof(THashDesc);
HDVersion := C_HashVers;
HBlockLen := SHA1_BlockLen;
HDigestlen:= sizeof(TSHA1Digest);
HInit := SHA1Init;
HFinal := SHA1FinalEx;
HUpdateXL := SHA1UpdateXL;
HAlgNum := longint(_SHA1);
HName := 'SHA1';
HPtrOID := @SHA1_OID;
HLenOID := 6;
HFinalBit := SHA1FinalBitsEx;
end;
{$endif}
RegisterHash(_SHA1, @SHA1_Desc);
end.

1051
Tocsg.Lib/VCL/EncLib/EM.Tocsg.sha256.pas Normal file
View File

File diff suppressed because it is too large Load Diff

74
Tocsg.Lib/VCL/EncLib/EM.Tools.pas Normal file
View File

@ -0,0 +1,74 @@
unit EM.Tools;
interface
uses
Windows, Sysutils;
//type
//{$IFDEF VER120}
// dword= longword;
//{$ELSE}
// dword= longint;
//{$ENDIF}
function LRot16(X: word; c: integer): word; assembler;
function RRot16(X: word; c: integer): word; assembler;
function LRot32(X: dword; c: integer): dword; assembler;
function RRot32(X: dword; c: integer): dword; assembler;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
procedure IncBlock(P: PByteArray; Len: integer);
implementation
function LRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
rol ax,cl
mov &Result,ax
end;
function RRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
ror ax,cl
mov &Result,ax
end;
function LRot32(X: dword; c: integer): dword; register; assembler;
asm
{$IFDEF CPUX64}
mov rax, rcx;
{$ENDIF}
mov ecx, edx
rol eax, cl
end;
function RRot32(X: dword; c: integer): dword; register; assembler;
asm
{$IFDEF CPUX64}
mov rax, rcx;
{$ENDIF}
mov ecx, edx
ror eax, cl
end;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
var
i: integer;
begin
for i:= 0 to Len-1 do
O1[i]:= I1[i] xor I2[i];
end;
procedure IncBlock(P: PByteArray; Len: integer);
begin
Inc(P[Len-1]);
if (P[Len-1]= 0) and (Len> 1) then
IncBlock(P,Len-1);
end;
end.

802
Tocsg.Lib/VCL/EncLib/EM.WtsApi32.pas Normal file
View File

@ -0,0 +1,802 @@
unit EM.WtsApi32;
interface
uses Windows, Messages, SysUtils, Controls;
// Windows Terminal Server public APIs
//
// Copyright 1995-1999, Citrix Systems Inc.
// Copyright (c) 1997-1999 Microsoft Corporation
//==============================================================================
// Defines
//==============================================================================
//
// Specifies the current server
//
const
WTS_CURRENT_SERVER = THandle(0);
{$EXTERNALSYM WTS_CURRENT_SERVER}
WTS_CURRENT_SERVER_HANDLE = THandle(0);
{$EXTERNALSYM WTS_CURRENT_SERVER_HANDLE}
WTS_CURRENT_SERVER_NAME = '';
{$EXTERNALSYM WTS_CURRENT_SERVER_NAME}
//
// Specifies the current session (SessionId)
//
WTS_CURRENT_SESSION = DWORD(-1);
{$EXTERNALSYM WTS_CURRENT_SESSION}
//
// Possible pResponse values from WTSSendMessage()
//
IDTIMEOUT = 32000;
{$EXTERNALSYM IDTIMEOUT}
IDASYNC = 32001;
{$EXTERNALSYM IDASYNC}
//
// Shutdown flags
//
WTS_WSD_LOGOFF = $00000001; // log off all users except
{$EXTERNALSYM WTS_WSD_LOGOFF} // current user; deletes
// WinStations (a reboot is
// required to recreate the
// WinStations)
WTS_WSD_SHUTDOWN = $00000002; // shutdown system
{$EXTERNALSYM WTS_WSD_SHUTDOWN}
WTS_WSD_REBOOT = $00000004; // shutdown and reboot
{$EXTERNALSYM WTS_WSD_REBOOT}
WTS_WSD_POWEROFF = $00000008; // shutdown and power off (on
{$EXTERNALSYM WTS_WSD_POWEROFF}
// machines that support power
// off through software)
WTS_WSD_FASTREBOOT = $00000010; // reboot without logging users
{$EXTERNALSYM WTS_WSD_FASTREBOOT} // off or shutting down
//==============================================================================
// WTS_CONNECTSTATE_CLASS - Session connect state
//==============================================================================
type
_WTS_CONNECTSTATE_CLASS = (
WTSActive, // User logged on to WinStation
WTSConnected, // WinStation connected to client
WTSConnectQuery, // In the process of connecting to client
WTSShadow, // Shadowing another WinStation
WTSDisconnected, // WinStation logged on without client
WTSIdle, // Waiting for client to connect
WTSListen, // WinStation is listening for connection
WTSReset, // WinStation is being reset
WTSDown, // WinStation is down due to error
WTSInit); // WinStation in initialization
{$EXTERNALSYM _WTS_CONNECTSTATE_CLASS}
WTS_CONNECTSTATE_CLASS = _WTS_CONNECTSTATE_CLASS;
{$EXTERNALSYM WTS_CONNECTSTATE_CLASS}
TWtsConnectStateClass = WTS_CONNECTSTATE_CLASS;
HANDLE = THANDLE;
PVOID = Pointer;
//==============================================================================
// WTS_SERVER_INFO - returned by WTSEnumerateServers (version 1)
//==============================================================================
//
// WTSEnumerateServers() returns two variables: pServerInfo and Count.
// The latter is the number of WTS_SERVER_INFO structures contained in
// the former. In order to read each server, iterate i from 0 to
// Count-1 and reference the server name as
// pServerInfo[i].pServerName; for example:
//
// for ( i=0; i < Count; i++ ) {
// _tprintf( TEXT("%s "), pServerInfo[i].pServerName );
// }
//
// The memory returned looks like the following. P is a pServerInfo
// pointer, and D is the string data for that pServerInfo:
//
// P1 P2 P3 P4 ... Pn D1 D2 D3 D4 ... Dn
//
// This makes it easier to iterate the servers, using code similar to
// the above.
//
type
PWTS_SERVER_INFOW = ^WTS_SERVER_INFOW;
{$EXTERNALSYM PWTS_SERVER_INFOW}
_WTS_SERVER_INFOW = record
pServerName: LPWSTR; // server name
end;
{$EXTERNALSYM _WTS_SERVER_INFOW}
WTS_SERVER_INFOW = _WTS_SERVER_INFOW;
{$EXTERNALSYM WTS_SERVER_INFOW}
TWtsServerInfoW = WTS_SERVER_INFOW;
PWtsServerInfoW = PWTS_SERVER_INFOW;
PWTS_SERVER_INFOA = ^WTS_SERVER_INFOA;
{$EXTERNALSYM PWTS_SERVER_INFOA}
_WTS_SERVER_INFOA = record
pServerName: LPSTR; // server name
end;
{$EXTERNALSYM _WTS_SERVER_INFOA}
WTS_SERVER_INFOA = _WTS_SERVER_INFOA;
{$EXTERNALSYM WTS_SERVER_INFOA}
TWtsServerInfoA = WTS_SERVER_INFOA;
PWtsServerInfoA = PWTS_SERVER_INFOA;
{$IFDEF UNICODE}
WTS_SERVER_INFO = WTS_SERVER_INFOW;
{$EXTERNALSYM WTS_SERVER_INFO}
PWTS_SERVER_INFO = PWTS_SERVER_INFOW;
{$EXTERNALSYM PWTS_SERVER_INFO}
TWtsServerInfo = TWtsServerInfoW;
PWtsServerInfo = PWtsServerInfoW;
{$ELSE}
WTS_SERVER_INFO = WTS_SERVER_INFOA;
{$EXTERNALSYM WTS_SERVER_INFO}
PWTS_SERVER_INFO = PWTS_SERVER_INFOA;
{$EXTERNALSYM PWTS_SERVER_INFO}
TWtsServerInfo = TWtsServerInfoA;
PWtsServerInfo = PWtsServerInfoA;
{$ENDIF}
//==============================================================================
// WTS_SESSION_INFO - returned by WTSEnumerateSessions (version 1)
//==============================================================================
//
// WTSEnumerateSessions() returns data in a similar format to the above
// WTSEnumerateServers(). It returns two variables: pSessionInfo and
// Count. The latter is the number of WTS_SESSION_INFO structures
// contained in the former. Iteration is similar, except that there
// are three parts to each entry, so it would look like this:
//
// for ( i=0; i < Count; i++ ) {
// _tprintf( TEXT("%-5u %-20s %u\n"),
// pSessionInfo[i].SessionId,
// pSessionInfo[i].pWinStationName,
// pSessionInfo[i].State );
// }
//
// The memory returned is also segmented as the above, with all the
// structures allocated at the start and the string data at the end.
// We'll use S for the SessionId, P for the pWinStationName pointer
// and D for the string data, and C for the connect State:
//
// S1 P1 C1 S2 P2 C2 S3 P3 C3 S4 P4 C4 ... Sn Pn Cn D1 D2 D3 D4 ... Dn
//
// As above, this makes it easier to iterate the sessions.
//
type
PWTS_SESSION_INFOW = ^WTS_SESSION_INFOW;
{$EXTERNALSYM PWTS_SESSION_INFOW}
_WTS_SESSION_INFOW = record
SessionId: DWORD; // session id
pWinStationName: LPWSTR; // name of WinStation this session is connected to
State: WTS_CONNECTSTATE_CLASS; // connection state (see enum)
end;
{$EXTERNALSYM _WTS_SESSION_INFOW}
WTS_SESSION_INFOW = _WTS_SESSION_INFOW;
{$EXTERNALSYM WTS_SESSION_INFOW}
TWtsSessionInfoW = WTS_SESSION_INFOW;
PWtsSessionInfoW = PWTS_SESSION_INFOW;
PWTS_SESSION_INFOA = ^WTS_SESSION_INFOA;
{$EXTERNALSYM PWTS_SESSION_INFOA}
_WTS_SESSION_INFOA = record
SessionId: DWORD; // session id
pWinStationName: LPSTR; // name of WinStation this session is connected to
State: WTS_CONNECTSTATE_CLASS; // connection state (see enum)
end;
{$EXTERNALSYM _WTS_SESSION_INFOA}
WTS_SESSION_INFOA = _WTS_SESSION_INFOA;
{$EXTERNALSYM WTS_SESSION_INFOA}
TWtsSessionInfoA = WTS_SESSION_INFOA;
PWtsSessionInfoA = PWTS_SESSION_INFOA;
{$IFDEF UNICODE}
WTS_SESSION_INFO = WTS_SESSION_INFOW;
PWTS_SESSION_INFO = PWTS_SESSION_INFOW;
TWtsSessionInfo = TWtsSessionInfoW;
PWtsSessionInfo = PWtsSessionInfoW;
{$ELSE}
WTS_SESSION_INFO = WTS_SESSION_INFOA;
PWTS_SESSION_INFO = PWTS_SESSION_INFOA;
TWtsSessionInfo = TWtsSessionInfoA;
PWtsSessionInfo = PWtsSessionInfoA;
{$ENDIF}
//==============================================================================
// WTS_PROCESS_INFO - returned by WTSEnumerateProcesses (version 1)
//==============================================================================
//
// WTSEnumerateProcesses() also returns data similar to
// WTSEnumerateServers(). It returns two variables: pProcessInfo and
// Count. The latter is the number of WTS_PROCESS_INFO structures
// contained in the former. Iteration is similar, except that there
// are four parts to each entry, so it would look like this:
//
// for ( i=0; i < Count; i++ ) {
// GetUserNameFromSid( pProcessInfo[i].pUserSid, UserName,
// sizeof(UserName) );
// _tprintf( TEXT("%-5u %-20s %-5u %s\n"),
// pProcessInfo[i].SessionId,
// UserName,
// pProcessInfo[i].ProcessId,
// pProcessInfo[i].pProcessName );
// }
//
// The memory returned is also segmented as the above, with all the
// structures allocated at the start and the string data at the end.
// We'll use S for the SessionId, R for the ProcessId, P for the
// pProcessName pointer and D for the string data, and U for pUserSid:
//
// S1 R1 P1 U1 S2 R2 P2 U2 S3 R3 P3 U3 ... Sn Rn Pn Un D1 D2 D3 ... Dn
//
// As above, this makes it easier to iterate the processes.
//
type
PWTS_PROCESS_INFOW = ^WTS_PROCESS_INFOW;
{$EXTERNALSYM PWTS_PROCESS_INFOW}
_WTS_PROCESS_INFOW = record
SessionId: DWORD; // session id
ProcessId: DWORD; // process id
pProcessName: LPWSTR; // name of process
pUserSid: PSID; // user's SID
end;
{$EXTERNALSYM _WTS_PROCESS_INFOW}
WTS_PROCESS_INFOW = _WTS_PROCESS_INFOW;
{$EXTERNALSYM WTS_PROCESS_INFOW}
TWtsProcessInfoW = WTS_PROCESS_INFOW;
PWtsProcessInfoW = PWTS_PROCESS_INFOW;
PWTS_PROCESS_INFOA = ^WTS_PROCESS_INFOA;
{$EXTERNALSYM PWTS_PROCESS_INFOA}
_WTS_PROCESS_INFOA = record
SessionId: DWORD; // session id
ProcessId: DWORD; // process id
pProcessName: LPSTR; // name of process
pUserSid: PSID; // user's SID
end;
{$EXTERNALSYM _WTS_PROCESS_INFOA}
WTS_PROCESS_INFOA = _WTS_PROCESS_INFOA;
{$EXTERNALSYM WTS_PROCESS_INFOA}
TWtsProcessInfoA = WTS_PROCESS_INFOA;
PWtsProcessInfoA = PWTS_PROCESS_INFOA;
{$IFDEF UNICODE}
WTS_PROCESS_INFO = WTS_PROCESS_INFOW;
{$EXTERNALSYM WTS_PROCESS_INFO}
PWTS_PROCESS_INFO = PWTS_PROCESS_INFOW;
{$EXTERNALSYM PWTS_PROCESS_INFO}
TWtsProcessInfo = TWtsProcessInfoW;
PWtsProcessInfo = PWtsProcessInfoW;
{$ELSE}
WTS_PROCESS_INFO = WTS_PROCESS_INFOA;
{$EXTERNALSYM WTS_PROCESS_INFO}
PWTS_PROCESS_INFO = PWTS_PROCESS_INFOA;
{$EXTERNALSYM PWTS_PROCESS_INFO}
TWtsProcessInfo = TWtsProcessInfoA;
PWtsProcessInfo = PWtsProcessInfoA;
{$ENDIF}
//==============================================================================
// WTS_INFO_CLASS - WTSQuerySessionInformation
// (See additional typedefs for more info on structures)
//==============================================================================
const
WTS_PROTOCOL_TYPE_CONSOLE = 0; // Console
{$EXTERNALSYM WTS_PROTOCOL_TYPE_CONSOLE}
WTS_PROTOCOL_TYPE_ICA = 1; // ICA Protocol
{$EXTERNALSYM WTS_PROTOCOL_TYPE_ICA}
WTS_PROTOCOL_TYPE_RDP = 2; // RDP Protocol
{$EXTERNALSYM WTS_PROTOCOL_TYPE_RDP}
{$IFDEF false}
type
_WTS_INFO_CLASS = (
WTSInitialProgram,
WTSApplicationName,
WTSWorkingDirectory,
WTSOEMId,
WTSSessionId,
WTSUserName,
WTSWinStationName,
WTSDomainName,
WTSConnectState,
WTSClientBuildNumber,
WTSClientName,
WTSClientDirectory,
WTSClientProductId,
WTSClientHardwareId,
WTSClientAddress,
WTSClientDisplay,
WTSClientProtocolType);
{$EXTERNALSYM _WTS_INFO_CLASS}
WTS_INFO_CLASS = _WTS_INFO_CLASS;
TWtsInfoClass = WTS_INFO_CLASS;
{$ELSE}
// xe2에서 위처럼 선언하고 하면.. WTSQuerySessionInformation에서 자꾸 87에러 뱉는다 14_0319 16:26:01 sunk
const
WTSInitialProgram = 0;
WTSApplicationName = 1;
WTSWorkingDirectory = 2;
WTSOEMId = 3;
WTSSessionId = 4;
WTSUserName = 5;
WTSWinStationName = 6;
WTSDomainName = 7;
WTSConnectState = 8;
WTSClientBuildNumber = 9;
WTSClientName = 10;
WTSClientDirectory = 11;
WTSClientProductId = 12;
WTSClientHardwareId = 13;
WTSClientAddress = 14;
WTSClientDisplay = 15;
WTSClientProtocolType = 16;
type
WTS_INFO_CLASS = DWORD;
TWtsInfoClass = WTS_INFO_CLASS;
{$ENDIF}
//==============================================================================
// WTSQuerySessionInformation - (WTSClientAddress)
//==============================================================================
type
PWTS_CLIENT_ADDRESS = ^WTS_CLIENT_ADDRESS;
{$EXTERNALSYM PWTS_CLIENT_ADDRESS}
_WTS_CLIENT_ADDRESS = record
AddressFamily: DWORD; // AF_INET, AF_IPX, AF_NETBIOS, AF_UNSPEC
Address: array [0..19] of BYTE; // client network address
end;
{$EXTERNALSYM _WTS_CLIENT_ADDRESS}
WTS_CLIENT_ADDRESS = _WTS_CLIENT_ADDRESS;
{$EXTERNALSYM WTS_CLIENT_ADDRESS}
TWtsClientAddress = WTS_CLIENT_ADDRESS;
PWtsClientAddress = PWTS_CLIENT_ADDRESS;
//==============================================================================
// WTSQuerySessionInformation - (WTSClientDisplay)
//==============================================================================
type
PWTS_CLIENT_DISPLAY = ^WTS_CLIENT_DISPLAY;
{$EXTERNALSYM PWTS_CLIENT_DISPLAY}
_WTS_CLIENT_DISPLAY = record
HorizontalResolution: DWORD; // horizontal dimensions, in pixels
VerticalResolution: DWORD; // vertical dimensions, in pixels
ColorDepth: DWORD; // 1=16, 2=256, 4=64K, 8=16M
end;
{$EXTERNALSYM _WTS_CLIENT_DISPLAY}
WTS_CLIENT_DISPLAY = _WTS_CLIENT_DISPLAY;
{$EXTERNALSYM WTS_CLIENT_DISPLAY}
TWtsClientDisplay = WTS_CLIENT_DISPLAY;
PWtsClientDisplay = PWTS_CLIENT_DISPLAY;
//==============================================================================
// WTS_CONFIG_CLASS - WTSQueryUserConfig/WTSSetUserConfig
//==============================================================================
type
_WTS_CONFIG_CLASS = (
//Initial program settings
WTSUserConfigInitialProgram, // string returned/expected
WTSUserConfigWorkingDirectory, // string returned/expected
WTSUserConfigfInheritInitialProgram, // DWORD returned/expected
//
WTSUserConfigfAllowLogonTerminalServer, //DWORD returned/expected
//Timeout settings
WTSUserConfigTimeoutSettingsConnections, //DWORD returned/expected
WTSUserConfigTimeoutSettingsDisconnections, //DWORD returned/expected
WTSUserConfigTimeoutSettingsIdle, //DWORD returned/expected
//Client device settings
WTSUserConfigfDeviceClientDrives, //DWORD returned/expected
WTSUserConfigfDeviceClientPrinters, //DWORD returned/expected
WTSUserConfigfDeviceClientDefaultPrinter, //DWORD returned/expected
//Connection settings
WTSUserConfigBrokenTimeoutSettings, //DWORD returned/expected
WTSUserConfigReconnectSettings, //DWORD returned/expected
//Modem settings
WTSUserConfigModemCallbackSettings, //DWORD returned/expected
WTSUserConfigModemCallbackPhoneNumber, // string returned/expected
//Shadow settings
WTSUserConfigShadowingSettings, //DWORD returned/expected
//User Profile settings
WTSUserConfigTerminalServerProfilePath, // string returned/expected
//Terminal Server home directory
WTSUserConfigTerminalServerHomeDir, // string returned/expected
WTSUserConfigTerminalServerHomeDirDrive, // string returned/expected
WTSUserConfigfTerminalServerRemoteHomeDir); // DWORD 0:LOCAL 1:REMOTE
{$EXTERNALSYM _WTS_CONFIG_CLASS}
WTS_CONFIG_CLASS = _WTS_CONFIG_CLASS;
TWtsConfigClass = WTS_CONFIG_CLASS;
PWTS_USER_CONFIG_SET_NWSERVERW = ^WTS_USER_CONFIG_SET_NWSERVERW;
{$EXTERNALSYM PWTS_USER_CONFIG_SET_NWSERVERW}
_WTS_USER_CONFIG_SET_NWSERVERW = record
pNWServerName: LPWSTR;
pNWDomainAdminName: LPWSTR;
pNWDomainAdminPassword: LPWSTR;
end;
{$EXTERNALSYM _WTS_USER_CONFIG_SET_NWSERVERW}
WTS_USER_CONFIG_SET_NWSERVERW = _WTS_USER_CONFIG_SET_NWSERVERW;
{$EXTERNALSYM WTS_USER_CONFIG_SET_NWSERVERW}
TWtsUserConfigSetNwserverW = WTS_USER_CONFIG_SET_NWSERVERW;
PWtsUserConfigSetNwserverW = PWTS_USER_CONFIG_SET_NWSERVERW;
PWTS_USER_CONFIG_SET_NWSERVERA = ^WTS_USER_CONFIG_SET_NWSERVERA;
{$EXTERNALSYM PWTS_USER_CONFIG_SET_NWSERVERA}
_WTS_USER_CONFIG_SET_NWSERVERA = record
pNWServerName: LPSTR;
pNWDomainAdminName: LPSTR;
pNWDomainAdminPassword: LPSTR;
end;
{$EXTERNALSYM _WTS_USER_CONFIG_SET_NWSERVERA}
WTS_USER_CONFIG_SET_NWSERVERA = _WTS_USER_CONFIG_SET_NWSERVERA;
{$EXTERNALSYM WTS_USER_CONFIG_SET_NWSERVERA}
TWtsUserConfigSetNwserverA = WTS_USER_CONFIG_SET_NWSERVERA;
PWtsUserConfigSetNwserverA = PWTS_USER_CONFIG_SET_NWSERVERA;
{$IFDEF UNICODE}
WTS_USER_CONFIG_SET_NWSERVER = WTS_USER_CONFIG_SET_NWSERVERW;
{$EXTERNALSYM WTS_USER_CONFIG_SET_NWSERVER}
PWTS_USER_CONFIG_SET_NWSERVER = PWTS_USER_CONFIG_SET_NWSERVERW;
{$EXTERNALSYM PWTS_USER_CONFIG_SET_NWSERVER}
TWtsUserConfigSetNwserver = TWtsUserConfigSetNwserverW;
PWtsUserConfigSetNwserver = PWtsUserConfigSetNwserverW;
{$ELSE}
WTS_USER_CONFIG_SET_NWSERVER = WTS_USER_CONFIG_SET_NWSERVERA;
{$EXTERNALSYM WTS_USER_CONFIG_SET_NWSERVER}
PWTS_USER_CONFIG_SET_NWSERVER = PWTS_USER_CONFIG_SET_NWSERVERA;
{$EXTERNALSYM PWTS_USER_CONFIG_SET_NWSERVER}
TWtsUserConfigSetNwserver = TWtsUserConfigSetNwserverA;
PWtsUserConfigSetNwserver = PWtsUserConfigSetNwserverA;
{$ENDIF}
//==============================================================================
// WTS_EVENT - Event flags for WTSWaitSystemEvent
//==============================================================================
const
WTS_EVENT_NONE = $00000000; // return no event
{$EXTERNALSYM WTS_EVENT_NONE}
WTS_EVENT_CREATE = $00000001; // new WinStation created
{$EXTERNALSYM WTS_EVENT_CREATE}
WTS_EVENT_DELETE = $00000002; // existing WinStation deleted
{$EXTERNALSYM WTS_EVENT_DELETE}
WTS_EVENT_RENAME = $00000004; // existing WinStation renamed
{$EXTERNALSYM WTS_EVENT_RENAME}
WTS_EVENT_CONNECT = $00000008; // WinStation connect to client
{$EXTERNALSYM WTS_EVENT_CONNECT}
WTS_EVENT_DISCONNECT = $00000010; // WinStation logged on without client
{$EXTERNALSYM WTS_EVENT_DISCONNECT}
WTS_EVENT_LOGON = $00000020; // user logged on to existing WinStation
{$EXTERNALSYM WTS_EVENT_LOGON}
WTS_EVENT_LOGOFF = $00000040; // user logged off from existing WinStation
{$EXTERNALSYM WTS_EVENT_LOGOFF}
WTS_EVENT_STATECHANGE = $00000080; // WinStation state change
{$EXTERNALSYM WTS_EVENT_STATECHANGE}
WTS_EVENT_LICENSE = $00000100; // license state change
{$EXTERNALSYM WTS_EVENT_LICENSE}
WTS_EVENT_ALL = $7fffffff; // wait for all event types
{$EXTERNALSYM WTS_EVENT_ALL}
WTS_EVENT_FLUSH = DWORD($80000000); // unblock all waiters
{$EXTERNALSYM WTS_EVENT_FLUSH}
//==============================================================================
// WTS_VIRTUAL_CLASS - WTSVirtualChannelQuery
//==============================================================================
type
_WTS_VIRTUAL_CLASS = (WTSVirtualClientData); // Virtual channel client module data (C2H data)
{$EXTERNALSYM _WTS_VIRTUAL_CLASS}
WTS_VIRTUAL_CLASS = _WTS_VIRTUAL_CLASS;
{$EXTERNALSYM WTS_VIRTUAL_CLASS}
TWtsVirtualClass = WTS_VIRTUAL_CLASS;
//==============================================================================
// Windows Terminal Server public APIs
//==============================================================================
function WTSEnumerateServersA(pDomainName: LPSTR; Reserved, Version: DWORD;
var ppServerInfo: PWTS_SERVER_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateServersA}
function WTSEnumerateServersW(pDomainName: LPWSTR; Reserved, Version: DWORD;
var ppServerInfo: PWTS_SERVER_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateServersW}
{$IFDEF UNICODE}
function WTSEnumerateServers(pDomainName: LPWSTR; Reserved, Version: DWORD;
var ppServerInfo: PWTS_SERVER_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateServers}
{$ELSE}
function WTSEnumerateServers(pDomainName: LPSTR; Reserved, Version: DWORD;
var ppServerInfo: PWTS_SERVER_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateServers}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSOpenServerA(pServerName: LPSTR): HANDLE; stdcall;
{$EXTERNALSYM WTSOpenServerA}
function WTSOpenServerW(pServerName: LPWSTR): HANDLE; stdcall;
{$EXTERNALSYM WTSOpenServerW}
{$IFDEF UNICODE}
function WTSOpenServer(pServerName: LPWSTR): HANDLE; stdcall;
{$EXTERNALSYM WTSOpenServer}
{$ELSE}
function WTSOpenServer(pServerName: LPSTR): HANDLE; stdcall;
{$EXTERNALSYM WTSOpenServer}
{$ENDIF}
//------------------------------------------------------------------------------
procedure WTSCloseServer(hServer: HANDLE); stdcall;
{$EXTERNALSYM WTSCloseServer}
//------------------------------------------------------------------------------
function WTSEnumerateSessionsA(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppSessionInfo: PWTS_SESSION_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateSessionsA}
function WTSEnumerateSessionsW(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppSessionInfo: PWTS_SESSION_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateSessionsW}
{$IFDEF UNICODE}
function WTSEnumerateSessions(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppSessionInfo: PWTS_SESSION_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateSessions}
{$ELSE}
function WTSEnumerateSessions(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppSessionInfo: PWTS_SESSION_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateSessions}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSEnumerateProcessesA(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppProcessInfo: PWTS_PROCESS_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateProcessesA}
function WTSEnumerateProcessesW(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppProcessInfo: PWTS_PROCESS_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateProcessesW}
{$IFDEF UNICODE}
function WTSEnumerateProcesses(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppProcessInfo: PWTS_PROCESS_INFOW; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateProcesses}
{$ELSE}
function WTSEnumerateProcesses(hServer: HANDLE; Reserved: DWORD; Version: DWORD;
var ppProcessInfo: PWTS_PROCESS_INFOA; var pCount: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSEnumerateProcesses}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSTerminateProcess(hServer: HANDLE; ProcessId, ExitCode: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSTerminateProcess}
//------------------------------------------------------------------------------
function WTSQuerySessionInformationA(hServer: HANDLE; SessionId: DWORD;
WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQuerySessionInformationA}
function WTSQuerySessionInformationW(hServer: HANDLE; SessionId: DWORD;
WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQuerySessionInformationW}
{$IFDEF UNICODE}
function WTSQuerySessionInformation(hServer: HANDLE; SessionId: DWORD;
WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQuerySessionInformation}
{$ELSE}
function WTSQuerySessionInformation(hServer: HANDLE; SessionId: DWORD;
WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQuerySessionInformation}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSQueryUserConfigA(pServerName, pUserName: LPSTR; WTSConfigClass: WTS_CONFIG_CLASS;
var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQueryUserConfigA}
function WTSQueryUserConfigW(pServerName, pUserName: LPWSTR; WTSConfigClass: WTS_CONFIG_CLASS;
var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQueryUserConfigW}
{$IFDEF UNICODE}
function WTSQueryUserConfig(pServerName, pUserName: LPWSTR; WTSConfigClass: WTS_CONFIG_CLASS;
var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQueryUserConfig}
{$ELSE}
function WTSQueryUserConfig(pServerName, pUserName: LPSTR; WTSConfigClass: WTS_CONFIG_CLASS;
var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSQueryUserConfig}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSSetUserConfigA(pServerName, pUserName: LPSTR; WTSConfigClass: WTS_CONFIG_CLASS;
pBuffer: LPSTR; DataLength: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSSetUserConfigA}
function WTSSetUserConfigW(pServerName, pUserName: LPWSTR; WTSConfigClass: WTS_CONFIG_CLASS;
pBuffer: LPWSTR; DataLength: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSSetUserConfigW}
{$IFDEF UNICODE}
function WTSSetUserConfig(pServerName, pUserName: LPWSTR; WTSConfigClass: WTS_CONFIG_CLASS;
pBuffer: LPWSTR; DataLength: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSSetUserConfig}
{$ELSE}
function WTSSetUserConfig(pServerName, pUserName: LPSTR; WTSConfigClass: WTS_CONFIG_CLASS;
pBuffer: LPSTR; DataLength: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSSetUserConfig}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSSendMessageA(hServer: HANDLE; SessionId: DWORD; pTitle: LPSTR;
TitleLength: DWORD; pMessage: LPSTR; MessageLength: DWORD; Style: DWORD;
Timeout: DWORD; var pResponse: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSSendMessageA}
function WTSSendMessageW(hServer: HANDLE; SessionId: DWORD; pTitle: LPWSTR;
TitleLength: DWORD; pMessage: LPWSTR; MessageLength: DWORD; Style: DWORD;
Timeout: DWORD; var pResponse: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSSendMessageW}
{$IFDEF UNICODE}
function WTSSendMessage(hServer: HANDLE; SessionId: DWORD; pTitle: LPWSTR;
TitleLength: DWORD; pMessage: LPWSTR; MessageLength: DWORD; Style: DWORD;
Timeout: DWORD; var pResponse: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSSendMessage}
{$ELSE}
function WTSSendMessage(hServer: HANDLE; SessionId: DWORD; pTitle: LPSTR;
TitleLength: DWORD; pMessage: LPSTR; MessageLength: DWORD; Style: DWORD;
Timeout: DWORD; var pResponse: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSSendMessage}
{$ENDIF}
//------------------------------------------------------------------------------
function WTSDisconnectSession(hServer: HANDLE; SessionId: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSDisconnectSession}
//------------------------------------------------------------------------------
function WTSLogoffSession(hServer: HANDLE; SessionId: DWORD; bWait: BOOL): BOOL; stdcall;
{$EXTERNALSYM WTSLogoffSession}
//------------------------------------------------------------------------------
function WTSShutdownSystem(hServer: HANDLE; ShutdownFlag: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSShutdownSystem}
//------------------------------------------------------------------------------
function WTSWaitSystemEvent(hServer: HANDLE; EventMask: DWORD;
var pEventFlags: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSWaitSystemEvent}
//------------------------------------------------------------------------------
function WTSVirtualChannelOpen(hServer: HANDLE; SessionId: DWORD;
pVirtualName: LPSTR): HANDLE; stdcall;
{$EXTERNALSYM WTSVirtualChannelOpen}
function WTSVirtualChannelClose(hChannelHandle: HANDLE): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelClose}
function WTSVirtualChannelRead(hChannelHandle: HANDLE; TimeOut: ULONG;
Buffer: PCHAR; BufferSize: ULONG; var pBytesRead: ULONG): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelRead}
function WTSVirtualChannelWrite(hChannelHandle: HANDLE; Buffer: PCHAR;
Length: ULONG; var pBytesWritten: ULONG): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelWrite}
function WTSVirtualChannelPurgeInput(hChannelHandle: HANDLE): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelPurgeInput}
function WTSVirtualChannelPurgeOutput(hChannelHandle: HANDLE): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelPurgeOutput}
function WTSVirtualChannelQuery(hChannelHandle: HANDLE; VirtualClass: WTS_VIRTUAL_CLASS;
ppBuffer: PVOID; var pBytesReturned: DWORD): BOOL; stdcall;
{$EXTERNALSYM WTSVirtualChannelQuery}
//------------------------------------------------------------------------------
procedure WTSFreeMemory(pMemory: PVOID); stdcall;
{$EXTERNALSYM WTSFreeMemory}
implementation
const
wtsapi = 'wtsapi32.dll';
function WTSEnumerateServersA; external wtsapi name 'WTSEnumerateServersA';
function WTSEnumerateServersW; external wtsapi name 'WTSEnumerateServersW';
{$IFDEF UNICODE}
function WTSEnumerateServers; external wtsapi name 'WTSEnumerateServersW';
{$ELSE}
function WTSEnumerateServers; external wtsapi name 'WTSEnumerateServersA';
{$ENDIF}
function WTSOpenServerA; external wtsapi name 'WTSOpenServerA';
function WTSOpenServerW; external wtsapi name 'WTSOpenServerW';
{$IFDEF UNICODE}
function WTSOpenServer; external wtsapi name 'WTSOpenServerW';
{$ELSE}
function WTSOpenServer; external wtsapi name 'WTSOpenServerA';
{$ENDIF}
procedure WTSCloseServer; external wtsapi name 'WTSCloseServer';
function WTSEnumerateSessionsA; external wtsapi name 'WTSEnumerateSessionsA';
function WTSEnumerateSessionsW; external wtsapi name 'WTSEnumerateSessionsW';
{$IFDEF UNICODE}
function WTSEnumerateSessions; external wtsapi name 'WTSEnumerateSessionsW';
{$ELSE}
function WTSEnumerateSessions; external wtsapi name 'WTSEnumerateSessionsA';
{$ENDIF}
function WTSEnumerateProcessesA; external wtsapi name 'WTSEnumerateProcessesA';
function WTSEnumerateProcessesW; external wtsapi name 'WTSEnumerateProcessesW';
{$IFDEF UNICODE}
function WTSEnumerateProcesses; external wtsapi name 'WTSEnumerateProcessesW';
{$ELSE}
function WTSEnumerateProcesses; external wtsapi name 'WTSEnumerateProcessesA';
{$ENDIF}
function WTSTerminateProcess; external wtsapi name 'WTSTerminateProcess';
function WTSQuerySessionInformationA; external wtsapi name 'WTSQuerySessionInformationA';
function WTSQuerySessionInformationW; external wtsapi name 'WTSQuerySessionInformationW';
{$IFDEF UNICODE}
function WTSQuerySessionInformation; external wtsapi name 'WTSQuerySessionInformationW';
{$ELSE}
function WTSQuerySessionInformation; external wtsapi name 'WTSQuerySessionInformationA
{$ENDIF}
function WTSQueryUserConfigA; external wtsapi name 'WTSQueryUserConfigA';
function WTSQueryUserConfigW; external wtsapi name 'WTSQueryUserConfigW';
{$IFDEF UNICODE}
function WTSQueryUserConfig; external wtsapi name 'WTSQueryUserConfigW';
{$ELSE}
function WTSQueryUserConfig; external wtsapi name 'WTSQueryUserConfigA;
{$ENDIF}
function WTSSetUserConfigA; external wtsapi name 'WTSSetUserConfigA';
function WTSSetUserConfigW; external wtsapi name 'WTSSetUserConfigW';
{$IFDEF UNICODE}
function WTSSetUserConfig; external wtsapi name 'WTSSetUserConfigW';
{$ELSE}
function WTSSetUserConfig; external wtsapi name 'WTSSetUserConfigA;
{$ENDIF}
function WTSSendMessageA; external wtsapi name 'WTSSendMessageA';
function WTSSendMessageW; external wtsapi name 'WTSSendMessageW';
{$IFDEF UNICODE}
function WTSSendMessage; external wtsapi name 'WTSSendMessageW'
{$ELSE}
function WTSSendMessage; external wtsapi name 'WTSSendMessageA';
{$ENDIF}
function WTSDisconnectSession; external wtsapi name 'WTSDisconnectSession';
function WTSLogoffSession; external wtsapi name 'WTSLogoffSession';
function WTSShutdownSystem; external wtsapi name 'WTSShutdownSystem';
function WTSWaitSystemEvent; external wtsapi name 'WTSWaitSystemEvent';
function WTSVirtualChannelOpen; external wtsapi name 'WTSVirtualChannelOpen';
function WTSVirtualChannelClose; external wtsapi name 'WTSVirtualChannelClose';
function WTSVirtualChannelRead; external wtsapi name 'WTSVirtualChannelRead';
function WTSVirtualChannelWrite; external wtsapi name 'WTSVirtualChannelWrite';
function WTSVirtualChannelPurgeInput; external wtsapi name 'WTSVirtualChannelPurgeInput';
function WTSVirtualChannelPurgeOutput; external wtsapi name 'WTSVirtualChannelPurgeOutput';
function WTSVirtualChannelQuery; external wtsapi name 'WTSVirtualChannelQuery';
procedure WTSFreeMemory; external wtsapi name 'WTSFreeMemory';
end.

Some files were not shown because too many files have changed in this diff Show More