Vichingo455-RePacks/xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

source upload

Browse Source
This commit is contained in:
Razor12911
2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

157
contrib/DelphiEncryptionCompendium/Source/BuildAll.cmd Normal file
View File

@@ -0,0 +1,157 @@
@echo off
cls
setlocal enableextensions
setlocal enabledelayedexpansion
echo.
echo Compiles for all Delphis in %ProgramFiles(x86)%\Embarcadero
echo TODO : switch to paths read out of registry
echo HKCU\Software\Embarcadero\BDS\*.0 : RootDir
echo.
echo Compiles as well for Lazarus/FPC in C:\lazarus
echo.
echo creates one directory per DelphiVersion+ProjectConfig with the DCUs
echo ..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config)
echo.
title CLEAR
echo.
echo ##### CLEAR #####
echo.
echo delete "..\Compiled"
echo.
del "%~dpn0.log"
rd /s /q "%~dp0..\Compiled"
cd /d "%ProgramFiles(x86)%\Embarcadero"
for /r %%X in (rsvars*.bat) do call :run_compiler "%%X"
echo.
title %comspec%
type "%~dpn0.log"
echo.
find /c "FAIL " "%~dpn0.log" >nul
if not errorlevel 1 pause
exit /b
:run_compiler
title COMPILE
echo.
echo ##### %~dp1 #####
echo.
setlocal
call "%~1"
set IDEVER=unknown
for /f "delims=" %%E in ("%BDS%") do set IDEVER=%%~nxE
echo. >> "%~dpn0.log"
echo ### Delphi %IDEVER% ### >> "%~dpn0.log"
echo. >> "%~dpn0.log"
::::: Lazarus-DCUs :::::
title COMPILE Lazarus x86_64 win64 : Source\DEC60Lazarus.lpk
echo ### Lazarus x86_64 win64 # Source\DEC60Lazarus.lpk
C:\lazarus\lazbuild.exe --build-all --cpu=x86_64 --build-mode=Default "%~dp0\DEC60Lazarus.lpk"
if errorlevel 1 (
echo FAIL Source\DEC60Lazarus.lpk : x86_64 win64 >> "%~dpn0.log"
rundll32 user32.dll,MessageBeep
timeout 11
) else (
echo OK Source\DEC60Lazarus.lpk : x86_64 win64 >> "%~dpn0.log"
)
echo.
title COMPILE Lazarus i386 win32 : Source\DEC60Lazarus.lpk
echo ### Lazarus i386 win32 # Source\DEC60Lazarus.lpk
C:\lazarus\lazbuild.exe --build-all --cpu=i386 --build-mode=Default "%~dp0\DEC60Lazarus.lpk"
if errorlevel 1 (
echo FAIL Source\DEC60Lazarus.lpk : i386 win32 >> "%~dpn0.log"
rundll32 user32.dll,MessageBeep
timeout 11
) else (
echo OK Source\DEC60Lazarus.lpk : i386 win32 >> "%~dpn0.log"
)
echo.
::::: Delphi-DCUs :::::
for %%P in (Win32,Win64,Linux64,Android,Android64,iOSDevice64,iOSSimulator,OSX32,OSX64) do (
for %%C in (Debug,Release) do (
call :do_compile "Source\DEC60.dproj" %%P %%C
)
)
::::: TestApps :::::
echo. >> "%~dpn0.log"
for %%P in (Win32) do (
for %%C in (Debug,Console) do (
call :do_compile "Unit Tests\DECDUnitTestSuite.dproj" %%P %%C
)
for %%C in (Debug,GUI,MobileGUI,TestInsight) do (
call :do_compile "Unit Tests\DECDUnitXTestSuite.dproj" %%P %%C
)
)
::::: DemoApps :::::
echo. >> "%~dpn0.log"
call :do_compile "Demos\Cipher_Console\Cipher_Console.dproj"
call :do_compile "Demos\Cipher_FMX\Cipher_FMX.dproj"
call :do_compile "Demos\CryptoWorkbench_VCL\CryptoWorkbench_VCL.dproj"
call :do_compile "Demos\Format_Console\Format_Console.dproj"
call :do_compile "Demos\Hash_Console\Hash_Console.dproj"
call :do_compile "Demos\Hash_FMX\Hash_FMX.dproj"
call :do_compile "Demos\Progress_VCL\Progress_VCL.dproj"
call :do_compile "Demos\Random_Console\Random_Console.dproj"
echo. >> "%~dpn0.log"
title RUN Tests
echo ##### RUN Tests #####
echo.
REM for %%C in (Debug,Console,GUI) do (
REM for %%P in (Win32) do (
REM call :do_execute DECDUnitTestSuite.exe %%P %%C
REM call :do_execute DECDUnitXTestSuite.exe %%P %%C
REM )
REM )
call :do_execute DECDUnitTestSuite.exe Win32 Console
call :do_execute DECDUnitTestSuite.exe Win32 Debug
call :do_execute DECDUnitXTestSuite.exe Win32 Debug
call :do_execute DECDUnitXTestSuite.exe Win32 GUI
endlocal
exit /b
:do_compile
title COMPILE %IDEVER% %2 %3 : %~1
echo ### %IDEVER% %2 %3 # %~1
set params=
if not "%2" == "" set params=/p:Platform=%2 /p:Config=%3
REM msbuild "%~dp0..\%~1" /t:Rebuild %params% :: $(ProductVersion) is missing in msbuild, but is present in InlineCompiler of the IDE
msbuild "%~dp0..\%~1" /t:Rebuild %params% /p:ProductVersion=%IDEVER%
if errorlevel 1 (
echo FAIL %~1 : %2 %3 >> "%~dpn0.log"
rundll32 user32.dll,MessageBeep
timeout 11
) else (
echo OK %~1 : %2 %3 >> "%~dpn0.log"
)
:: remove dir if empty
if not "%2" == "" (
rd /q "%~dp0..\Compiled\BIN_IDE%IDEVER%_%2_%3" >nul
rd /q "%~dp0..\Compiled\DCP_IDE%IDEVER%_%2_%3" >nul
rd /q "%~dp0..\Compiled\DCU_IDE%IDEVER%_%2_%3" >nul
)
echo.
exit /b
:do_execute
title EXECUTE %IDEVER% %2 %3 : %~1
echo ### %IDEVER% %2 %3 # %~1
"%~dp0..\Compiled\BIN_IDE%IDEVER%_%2_%3\%~1"
set "ERR=%ERRORLEVEL% "
echo RUN:%ERR:~0,6% %~1 : %2 %3 >> "%~dpn0.log"
echo EXITCODE:%ERR%
echo.
exit /b

56
contrib/DelphiEncryptionCompendium/Source/DEC60.dpr Normal file
View File

@@ -0,0 +1,56 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
// Simple project group for easier DEC development
program DEC60;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
DECBaseClass in 'DECBaseClass.pas',
DECCipherBase in 'DECCipherBase.pas',
DECCipherFormats in 'DECCipherFormats.pas',
DECCipherModes in 'DECCipherModes.pas',
DECCipherInterface in 'DECCipherInterface.pas',
DECCiphers in 'DECCiphers.pas',
DECCRC in 'DECCRC.pas',
DECData in 'DECData.pas',
DECDataCipher in 'DECDataCipher.pas',
DECDataHash in 'DECDataHash.pas',
DECFormat in 'DECFormat.pas',
DECFormatBase in 'DECFormatBase.pas',
DECHash in 'DECHash.pas',
DECHashBase in 'DECHashBase.pas',
DECHashInterface in 'DECHashInterface.pas',
DECRandom in 'DECRandom.pas',
DECTypes in 'DECTypes.pas',
DECUtil in 'DECUtil.pas',
DECUtilRawByteStringHelper in 'DECUtilRawByteStringHelper.pas',
DECHashAuthentication in 'DECHashAuthentication.pas',
DECHashBitBase in 'DECHashBitBase.pas';
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;
end.

1367
contrib/DelphiEncryptionCompendium/Source/DEC60.dproj Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
contrib/DelphiEncryptionCompendium/Source/DEC60.res Normal file
View File

Binary file not shown.

156
contrib/DelphiEncryptionCompendium/Source/DEC60Complete.groupproj Normal file
View File

@@ -0,0 +1,156 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{46A7B5B1-D413-4DB1-A118-2403457B463A}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="DEC60.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Unit Tests\DECDUnitTestSuite.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Unit Tests\DECDUnitXTestSuite.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Cipher_Console\Cipher_Console.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Cipher_FMX\Cipher_FMX.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Format_Console\Format_Console.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Hash_Console\Hash_Console.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Hash_FMX\Hash_FMX.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Random_Console\Random_Console.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\Progress_VCL\ProgressDemoVCL.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\Demos\HashBenchmark_FMX\HashBenchmark.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="DEC60">
<MSBuild Projects="DEC60.dproj"/>
</Target>
<Target Name="DEC60:Clean">
<MSBuild Projects="DEC60.dproj" Targets="Clean"/>
</Target>
<Target Name="DEC60:Make">
<MSBuild Projects="DEC60.dproj" Targets="Make"/>
</Target>
<Target Name="DECDUnitTestSuite">
<MSBuild Projects="..\Unit Tests\DECDUnitTestSuite.dproj"/>
</Target>
<Target Name="DECDUnitTestSuite:Clean">
<MSBuild Projects="..\Unit Tests\DECDUnitTestSuite.dproj" Targets="Clean"/>
</Target>
<Target Name="DECDUnitTestSuite:Make">
<MSBuild Projects="..\Unit Tests\DECDUnitTestSuite.dproj" Targets="Make"/>
</Target>
<Target Name="DECDUnitXTestSuite">
<MSBuild Projects="..\Unit Tests\DECDUnitXTestSuite.dproj"/>
</Target>
<Target Name="DECDUnitXTestSuite:Clean">
<MSBuild Projects="..\Unit Tests\DECDUnitXTestSuite.dproj" Targets="Clean"/>
</Target>
<Target Name="DECDUnitXTestSuite:Make">
<MSBuild Projects="..\Unit Tests\DECDUnitXTestSuite.dproj" Targets="Make"/>
</Target>
<Target Name="Cipher_Console">
<MSBuild Projects="..\Demos\Cipher_Console\Cipher_Console.dproj"/>
</Target>
<Target Name="Cipher_Console:Clean">
<MSBuild Projects="..\Demos\Cipher_Console\Cipher_Console.dproj" Targets="Clean"/>
</Target>
<Target Name="Cipher_Console:Make">
<MSBuild Projects="..\Demos\Cipher_Console\Cipher_Console.dproj" Targets="Make"/>
</Target>
<Target Name="Cipher_FMX">
<MSBuild Projects="..\Demos\Cipher_FMX\Cipher_FMX.dproj"/>
</Target>
<Target Name="Cipher_FMX:Clean">
<MSBuild Projects="..\Demos\Cipher_FMX\Cipher_FMX.dproj" Targets="Clean"/>
</Target>
<Target Name="Cipher_FMX:Make">
<MSBuild Projects="..\Demos\Cipher_FMX\Cipher_FMX.dproj" Targets="Make"/>
</Target>
<Target Name="Format_Console">
<MSBuild Projects="..\Demos\Format_Console\Format_Console.dproj"/>
</Target>
<Target Name="Format_Console:Clean">
<MSBuild Projects="..\Demos\Format_Console\Format_Console.dproj" Targets="Clean"/>
</Target>
<Target Name="Format_Console:Make">
<MSBuild Projects="..\Demos\Format_Console\Format_Console.dproj" Targets="Make"/>
</Target>
<Target Name="Hash_Console">
<MSBuild Projects="..\Demos\Hash_Console\Hash_Console.dproj"/>
</Target>
<Target Name="Hash_Console:Clean">
<MSBuild Projects="..\Demos\Hash_Console\Hash_Console.dproj" Targets="Clean"/>
</Target>
<Target Name="Hash_Console:Make">
<MSBuild Projects="..\Demos\Hash_Console\Hash_Console.dproj" Targets="Make"/>
</Target>
<Target Name="Hash_FMX">
<MSBuild Projects="..\Demos\Hash_FMX\Hash_FMX.dproj"/>
</Target>
<Target Name="Hash_FMX:Clean">
<MSBuild Projects="..\Demos\Hash_FMX\Hash_FMX.dproj" Targets="Clean"/>
</Target>
<Target Name="Hash_FMX:Make">
<MSBuild Projects="..\Demos\Hash_FMX\Hash_FMX.dproj" Targets="Make"/>
</Target>
<Target Name="Random_Console">
<MSBuild Projects="..\Demos\Random_Console\Random_Console.dproj"/>
</Target>
<Target Name="Random_Console:Clean">
<MSBuild Projects="..\Demos\Random_Console\Random_Console.dproj" Targets="Clean"/>
</Target>
<Target Name="Random_Console:Make">
<MSBuild Projects="..\Demos\Random_Console\Random_Console.dproj" Targets="Make"/>
</Target>
<Target Name="ProgressDemoVCL">
<MSBuild Projects="..\Demos\Progress_VCL\ProgressDemoVCL.dproj"/>
</Target>
<Target Name="ProgressDemoVCL:Clean">
<MSBuild Projects="..\Demos\Progress_VCL\ProgressDemoVCL.dproj" Targets="Clean"/>
</Target>
<Target Name="ProgressDemoVCL:Make">
<MSBuild Projects="..\Demos\Progress_VCL\ProgressDemoVCL.dproj" Targets="Make"/>
</Target>
<Target Name="HashBenchmark">
<MSBuild Projects="..\Demos\HashBenchmark_FMX\HashBenchmark.dproj"/>
</Target>
<Target Name="HashBenchmark:Clean">
<MSBuild Projects="..\Demos\HashBenchmark_FMX\HashBenchmark.dproj" Targets="Clean"/>
</Target>
<Target Name="HashBenchmark:Make">
<MSBuild Projects="..\Demos\HashBenchmark_FMX\HashBenchmark.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="DEC60;DECDUnitTestSuite;DECDUnitXTestSuite;Cipher_Console;Cipher_FMX;Format_Console;Hash_Console;Hash_FMX;Random_Console;ProgressDemoVCL;HashBenchmark"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="DEC60:Clean;DECDUnitTestSuite:Clean;DECDUnitXTestSuite:Clean;Cipher_Console:Clean;Cipher_FMX:Clean;Format_Console:Clean;Hash_Console:Clean;Hash_FMX:Clean;Random_Console:Clean;ProgressDemoVCL:Clean;HashBenchmark:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="DEC60:Make;DECDUnitTestSuite:Make;DECDUnitXTestSuite:Make;Cipher_Console:Make;Cipher_FMX:Make;Format_Console:Make;Hash_Console:Make;Hash_FMX:Make;Random_Console:Make;ProgressDemoVCL:Make;HashBenchmark:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

2
contrib/DelphiEncryptionCompendium/Source/DEC60Complete_prjgroup.tvsconfig Normal file
View File

@@ -0,0 +1,2 @@
<?xml version="1.0"?>
<TgConfig Version="3" SubLevelDisabled="False" />

120
contrib/DelphiEncryptionCompendium/Source/DEC60Lazarus.lpk Normal file
View File

@@ -0,0 +1,120 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="DEC60Lazarus"/>
<Author Value="geheimniswelten"/>
<AutoUpdate Value="Manually"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="$(PkgDir)\..\Compiled\DCU_Lazarus_$(TargetCPU)_$(TargetOS)_$(BuildMode)\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="DelphiUnicode"/>
</SyntaxOptions>
</Parsing>
</CompilerOptions>
<Description Value="Delphi Encryption Compendium (DEC)"/>
<License Value="AFL 2.0"/>
<Version Major="6"/>
<Files Count="21">
<Item1>
<Filename Value="DECBaseClass.pas"/>
<UnitName Value="DECBaseClass"/>
</Item1>
<Item2>
<Filename Value="DECCipherBase.pas"/>
<UnitName Value="DECCipherBase"/>
</Item2>
<Item3>
<Filename Value="DECCipherFormats.pas"/>
<UnitName Value="DECCipherFormats"/>
</Item3>
<Item4>
<Filename Value="DECCipherInterface.pas"/>
<UnitName Value="DECCipherInterface"/>
</Item4>
<Item5>
<Filename Value="DECCipherModes.pas"/>
<UnitName Value="DECCipherModes"/>
</Item5>
<Item6>
<Filename Value="DECCiphers.pas"/>
<UnitName Value="DECCiphers"/>
</Item6>
<Item7>
<Filename Value="DECCRC.pas"/>
<UnitName Value="DECCRC"/>
</Item7>
<Item8>
<Filename Value="DECData.pas"/>
<UnitName Value="DECData"/>
</Item8>
<Item9>
<Filename Value="DECDataCipher.pas"/>
<UnitName Value="DECDataCipher"/>
</Item9>
<Item10>
<Filename Value="DECDataHash.pas"/>
<UnitName Value="DECDataHash"/>
</Item10>
<Item11>
<Filename Value="DECFormat.pas"/>
<UnitName Value="DECFormat"/>
</Item11>
<Item12>
<Filename Value="DECFormatBase.pas"/>
<UnitName Value="DECFormatBase"/>
</Item12>
<Item13>
<Filename Value="DECHash.pas"/>
<UnitName Value="DECHash"/>
</Item13>
<Item14>
<Filename Value="DECHashBase.pas"/>
<UnitName Value="DECHashBase"/>
</Item14>
<Item15>
<Filename Value="DECHashInterface.pas"/>
<UnitName Value="DECHashInterface"/>
</Item15>
<Item16>
<Filename Value="DECRandom.pas"/>
<UnitName Value="DECRandom"/>
</Item16>
<Item17>
<Filename Value="DECTypes.pas"/>
<UnitName Value="DECTypes"/>
</Item17>
<Item18>
<Filename Value="DECUtil.pas"/>
<UnitName Value="DECUtil"/>
</Item18>
<Item19>
<Filename Value="DECUtilRawByteStringHelper.pas"/>
<UnitName Value="DECUtilRawByteStringHelper"/>
</Item19>
<Item20>
<Filename Value="DECHash.asm86.inc"/>
<Type Value="Include"/>
</Item20>
<Item21>
<Filename Value="DECOptions.inc"/>
<Type Value="Include"/>
</Item21>
</Files>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPkgs>
<PublishOptions>
<Version Value="2"/>
<OpenInFileMan Value="True"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

18
contrib/DelphiEncryptionCompendium/Source/DEC60Lazarus.pas Normal file
View File

@@ -0,0 +1,18 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit DEC60Lazarus;
{$warn 5023 off : no warning about unused units}
interface
uses
DECBaseClass, DECCipherBase, DECCipherFormats, DECCipherInterface,
DECCipherModes, DECCiphers, DECCRC, DECData, DECDataCipher, DECDataHash,
DECFormat, DECFormatBase, DECHash, DECHashBase, DECHashInterface, DECRandom,
DECTypes, DECUtil, DECUtilRawByteStringHelper;
implementation
end.

2
contrib/DelphiEncryptionCompendium/Source/DEC60_project.tvsconfig Normal file
View File

@@ -0,0 +1,2 @@
<?xml version="1.0"?>
<TgConfig Version="3" SubLevelDisabled="False" />

376
contrib/DelphiEncryptionCompendium/Source/DECBaseClass.pas Normal file
View File

@@ -0,0 +1,376 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit DECBaseClass;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
Generics.Collections;
type
/// <summary>
/// Class type for the base class from which all other DEC classes inherit
/// in order to be able to create lists of classes, pick an entry of such a
/// list and construct an object out of it
/// </summary>
TDECClass = class of TDECObject;
/// <summary>
/// Generic list of DEC classes with the identity as key
/// </summary>
TDECClassList = class(TDictionary<Int64, TDECClass>)
strict private
/// <summary>
/// Checks if a given class type has the same short class name as given
/// </summary>
/// <param name="Name">
/// Short class name, e.g. HEXL
/// </param>
/// <param name="ClassType">
/// Class reference to check against
/// </param>
/// <returns>
/// true if the class reference is for the given short name
/// </returns>
function DoFindNameShort(const Name: string; const ClassType: TDECClass): Boolean;
/// <summary>
/// Checks if a given class type has the same long class name as given
/// </summary>
/// <param name="Name">
/// Long class name, e.g. TFormat_HEXL
/// </param>
/// <param name="ClassType">
/// Class reference to check against
/// </param>
/// <returns>
/// true if the class reference is for the given long name
/// </returns>
function DoFindNameLong(const Name: string; const ClassType: TClass): Boolean;
public
/// <summary>
/// Tries to find a class type by its name
/// </summary>
/// <param name="Name">
/// Name to look for in the list
/// </param>
/// <returns>
/// Returns the class type if found. if it could not be found a
/// EDECClassNotRegisteredException will be thrown
/// </returns>
function ClassByName(const Name: string): TDECClass;
/// <summary>
/// Tries to find a class type by its numeric identity DEC assigned to it.
/// Useful for file headers, so they can easily encode numerically which
/// cipher class was being used.
/// </summary>
/// <param name="Identity">
/// Identity to look for
/// </param>
/// <returns>
/// Returns the class type of the class with the specified identity value
/// or throws an EDECClassNotRegisteredException exception if no class
/// with the given identity has been found
/// </returns>
function ClassByIdentity(Identity: Int64): TDECClass;
/// <summary>
/// Returns a list of all classes registered in this list
/// </summary>
/// <param name="List">
/// List where the registered classes shall be added to. The string is the
/// long class name, the object the class reference. The list is being
/// cleared first and when an uncreated list is given nothing is being done
/// </param>
procedure GetClassList(List: TStrings);
end;
/// <summary>
/// Parent class of all cryptography and hash implementations
/// </summary>
TDECObject = class(TInterfacedObject)
public
/// <summary>
/// Overrideable but otherwise empty constructor (calls his parent
/// constructor or course)
/// </summary>
constructor Create; virtual;
/// <summary>
/// This function creates a unique Signature for each class using the
/// following naming scheme:
///
/// 'Z' repeated n times (to fill space of 256 chars) + DEC ClassName
///
/// The CRC32 of the generated Signature is used as our unique Identity
///
/// Important Note:
/// DEC 5.2 introduced a bug which breaks backward compatibility with
/// DEC 5.1 by using String instead of AnsiString. This leads to different
/// Identities when using Unicode capable Delphi Versions (Delphi 2009+).
///
/// To restore the *wrong* behavior of DEC 5.2 enable the DEC52_IDENTITY option
/// in the configuration file DECOptions.inc.
///
/// With this and all future versions we will keep backward compatibility.
/// </summary>
class function Identity: Int64;
{$IFDEF X86ASM}
/// <summary>
/// Override FreeInstance to fill allocated Object with zeros, that is
/// safer for any access to invalid Pointers of released Objects.
/// </summary>
procedure FreeInstance; override;
{$ENDIF X86ASM}
/// <summary>
/// Registers this class type in the list of DEC classes (ClassList).
/// Trying to register an already registered class will raise an exception.
/// </summary>
/// <param name="ClassList">
/// List to which the own class type shall be added. This allows subclasses
/// to have their own lists
/// </param>
class procedure RegisterClass(ClassList : TDECClassList);
/// <summary>
/// Removes tthis class type from the list of registered DEC classes
/// (ClassList). Trying to unregister a non registered class is a do nothing
/// operation.
/// </summary>
/// <param name="ClassList">
/// List from which the own class type shall be removed. This allows
/// subclasses to have their own lists
/// </param>
class procedure UnregisterClass(ClassList : TDECClassList);
/// <summary>
/// Returns short Classname of any DEC derrived class. This is the part
/// of the class name after the _ so for THash_RipeMD160 it will be RipeMD160.
/// </summary>
/// <param name="ClassName">
/// Complete class name
/// </param>
/// <returns>
/// Short class name
/// </returns>
class function GetShortClassNameFromName(const ClassName: string): string;
/// <summary>
/// Returns short Classname of any DEC derrived class type. This is the part
/// of the class name after the _ so for THash_RipeMD160 it will be RipeMD160.
/// </summary>
/// <returns>
/// Short class name or empty string if ClassType is nil.
/// </returns>
class function GetShortClassName: string;
end;
var
/// <summary>
/// default used for generating class identities
/// </summary>
IdentityBase: Int64 = $25844852;
/// <summary>
/// Size in bytes used for buffering data read from or written to a stream
/// </summary>
StreamBufferSize: Integer = 8192;
{$IFDEF NEXTGEN}
EmptyStr: string = '';
/// <summary>
/// Pointer to an empty string. For non Nextgen platforms declared in SysUtils
/// for backwards compatibility only. Here declared for NextGen only and
/// should get replaced
/// </summary>
NullStr: PString = @EmptyStr;
{$ENDIF}
implementation
uses
DECUtil, DECCRC;
resourcestring
sClassNotRegistered = 'Class %s is not registered';
sWrongIdentity = 'Another class "%s" with the same identity as "%s" has already been registered';
constructor TDECObject.Create;
begin
inherited Create;
end;
class function TDECObject.Identity: Int64;
var
Signature: {$IFDEF DEC52_IDENTITY}string{$ELSE !DEC52_IDENTITY}RawByteString{$ENDIF !DEC52_IDENTITY};
begin
{$IFDEF DEC52_IDENTITY}
Signature := StringOfChar(#$5A, 256 - Length(ClassName)) + UpperCase(ClassName);
{$IF CompilerVersion >= 24.0}
Result := CRC32(IdentityBase, Signature[Low(Signature)],
Length(Signature) * SizeOf(Signature[Low(Signature)]));
{$ELSE}
Result := CRC32(IdentityBase, Signature[Low(Signature)],
Length(Signature) * SizeOf(Signature[1]));
{$IFEND}
{$ELSE !DEC52_IDENTITY}
Signature := RawByteString(StringOfChar(#$5A, 256 - Length(ClassName)) + UpperCase(ClassName));
{$IF CompilerVersion >= 24.0}
Result := CRC32(IdentityBase, Signature[Low(Signature)],
Length(Signature) * SizeOf(Signature[Low(Signature)]));
{$ELSE}
Result := CRC32(IdentityBase, Signature[1],
Length(Signature) * SizeOf(Signature[1]));
{$IFEND}
{$ENDIF !DEC52_IDENTITY}
end;
class procedure TDECObject.RegisterClass(ClassList : TDECClassList);
begin
ClassList.Add(Identity, self);
end;
{$IFDEF X86ASM}
procedure TDECObject.FreeInstance;
// Override FreeInstance to fill allocated Object with zeros, that is
// safer for any access to invalid Pointers of released Objects
asm
PUSH EBX
PUSH EDI
MOV EBX,EAX
CALL TObject.CleanupInstance
MOV EAX,[EBX]
CALL TObject.InstanceSize
MOV ECX,EAX
MOV EDI,EBX
XOR EAX,EAX
REP STOSB
MOV EAX,EBX
CALL System.@FreeMem
POP EDI
POP EBX
end;
{$ENDIF X86ASM}
class procedure TDECObject.UnregisterClass(ClassList : TDECClassList);
begin
ClassList.Remove(Identity);
end;
class function TDECObject.GetShortClassName: string;
begin
Result := GetShortClassNameFromName(self.ClassName);
end;
class function TDECObject.GetShortClassNameFromName(const ClassName: string): string;
var
i: Integer;
begin
Result := ClassName;
i := Pos('_', Result);
if i > 0 then
Delete(Result, 1, i);
end;
{ TDECClassList }
function TDECClassList.DoFindNameShort(const Name: string; const ClassType: TDECClass): Boolean;
begin
Result := CompareText(ClassType.GetShortClassName, Name) = 0;
end;
function TDECClassList.DoFindNameLong(const Name: string; const ClassType: TClass): Boolean;
var
s: string;
begin
s := Name;
Result := CompareText(ClassType.ClassName, Name) = 0;
end;
function TDECClassList.ClassByIdentity(Identity: Int64): TDECClass;
begin
try
Result := Items[Identity];
except
On EListError do
raise EDECClassNotRegisteredException.CreateResFmt(@sClassNotRegistered,
[IntToHEX(Identity, 8)]);
end;
end;
function TDECClassList.ClassByName(const Name: string): TDECClass;
var
FindNameShort : Boolean;
Pair : TPair<Int64, TDECCLass>;
begin
Result := nil;
if Length(Name) > 0 then
begin
FindNameShort := TDECClass.GetShortClassNameFromName(Name) = Name;
for Pair in self do
begin
if FindNameShort then
begin
if DoFindNameShort(Name, Pair.Value) then
begin
result := Pair.Value;
break;
end;
end
else
if DoFindNameLong(Name, Pair.Value) then
begin
result := Pair.Value;
break;
end;
end;
end;
if Result = nil then
raise EDECClassNotRegisteredException.CreateResFmt(@sClassNotRegistered, [Name]);
end;
procedure TDECClassList.GetClassList(List: TStrings);
var
Pair : TPair<Int64, TDECCLass>;
begin
if List <> nil then
try
List.BeginUpdate;
List.Clear;
for Pair in self do
List.AddObject(Pair.Value.ClassName, TObject(Pair.Value));
finally
List.EndUpdate;
end;
end;
initialization
finalization
end.

908
contrib/DelphiEncryptionCompendium/Source/DECCRC.pas Normal file
View File

@@ -0,0 +1,908 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
{
Implementation of threadsafe CRC checksum functions.
The following standard CRCs are supported:
CRC-8, CRC-10, CRC-12 (Mobil Telephone),
CRC-16, CRC-16-CCITT, CRC-16-ZModem,
CRC-24 (PGP's MIME64 Armor CRC),
CRC-32, CRC-32-CCITT and CRC-32-ZModem.
How to use:
var
CRC16: UInt16;
begin
CRC16 := CRCCalc(CRC_16, Data, SizeOf(Data)); // all in one
end;
or
var
CRC: TCRCDef;
CRC32: UInt32;
begin
CRCInit(CRC, CRC_32); // setup CRC data structure
CRCCode(CRC, Data, SizeOf(Data)); // calcs CRC for "Data"
CRCCode(CRC, PChar(string)^, Length(string) * SizeOf(string[1])); // calcs CRC for String
CRC32 := CRCDone(CRC); // returns correct combined CRC for Data and String
// after CRCDone we can start a new calculation
end;
}
unit DECCRC;
interface
{$INCLUDE DECOptions.inc}
type
/// <summary>
/// CRC Definition Structure
/// </summary>
PCRCDef = ^TCRCDef;
/// <summary>
/// Record with meta data about a single CRC algorithm/polynom
/// Do *not* reorder or change this structure
/// <para>
/// SizeOf(TCRCDef) = 1056 = 0420h
/// </para>
/// </summary>
TCRCDef = packed record
/// <summary>
/// Lookup Table, precomputed in CRCSetup
/// </summary>
Table : array[0..255] of UInt32;
/// <summary>
/// Intermediate CRC
/// </summary>
CRC : UInt32;
/// <summary>
/// Is this Polynomial an inverse function?
/// </summary>
Inverse : LongBool;
/// <summary>
/// Shift Value for CRCCode (for more speed)
/// </summary>
Shift : UInt32;
/// <summary>
/// Start Value of CRC cComputation
/// </summary>
InitVector : UInt32;
/// <summary>
/// Final XOR Vector of computed CRC
/// </summary>
FinalVector : UInt32;
/// <summary>
/// Precomputed AND Mask of computed CRC
/// </summary>
Mask : UInt32;
/// <summary>
/// Bitsize of CRC
/// </summary>
Bits : UInt32;
/// <summary>
/// Used Polynomial
/// </summary>
Polynomial : UInt32;
end;
/// <summary>
/// predefined standard CRC Types
/// </summary>
TCRCType = (
CRC_8,
CRC_10,
CRC_12,
CRC_16,
CRC_16CCITT,
CRC_16XModem,
CRC_24,
CRC_32,
CRC_32CCITT,
CRC_32ZModem,
CRC_8ATMHEC,
CRC_8SMBus,
CRC_15CAN,
CRC_16ZMODEM
);
type
/// <summary>
/// Callback method used by some CRC calculation routines to fetch the data
/// to be processed
/// </summary>
/// <param name="Buffer">
/// Buffer containing the data to be processed
/// </param>
/// <param name="Count">
/// Number of bytes of the buffer to be processed
/// </param>
/// <returns>
///
/// </returns>
TReadMethod = function(var Buffer; Count: Int64): Int64 of object;
// initialize CRC Definition with a custom Algorithm
/// <summary>
/// Fills the individual fields of a CRC meta data structure
/// </summary>
/// <param name="CRCDef">
/// Structure whose fields shall be filled
/// </param>
/// <param name="Polynomial">
/// CRC polynome, defining the algorithm
/// </param>
/// <param name="Bits">
/// Size of the CRC value to be computed in bits. Needs to be at least 8
/// </param>
/// <param name="InitVector">
/// Initial value for the vector going into each calculation cycle
/// </param>
/// <param name="FinalVector">
/// Final XOR Vector of computed CRC
/// </param>
/// <param name="Inverse">
/// true if this Polynomial is an inverse function
/// </param>
/// <returns>
/// true on success, false when a number smaller 8 is being passed as Bits parameter
/// </returns>
function CRCSetup(var CRCDef: TCRCDef;
Polynomial, Bits, InitVector, FinalVector: UInt32;
Inverse: LongBool): Boolean;
/// <summary>
/// Retrieves the necessary meta data and precomputed tables for a given CRC
/// algorithm.
/// </summary>
/// <param name="CRCDef">
/// Record in which the to be retrieved meta data will be returned
/// </param>
/// <param name="CRCType">
/// Specifies the exact CRC type which shall be initialized
/// </param>
/// <returns>
/// true on success
/// </returns>
function CRCInit(var CRCDef: TCRCDef; CRCType: TCRCType): Boolean;
/// <summary>
/// Calculate the CRC of the contents of the passed in buffer.
/// </summary>
/// <param name="CRCDef">
/// Structure with the necessary metadata for the CRC algorithm to be used.
/// CRC processing state is being updated during calculation to enable this
/// structure to be fed in another call to CRCCode if a CRC over multiple
/// buffers has to be calculated.
/// </param>
/// <param name="Buffer">
/// Buffer with the data the CRC shall be calculated from
/// </param>
/// <param name="Size">
/// Number of bytes to calculate the CRC from, starting at the beginning of
/// the buffer
/// </param>
/// <returns>
/// Calculated CRC value, including any necessary correction (like CRCDone).
/// CRCDef.CRC holds the actual computed CRC, additional calls of CRCCode
/// compute the total CRC of split buffers
/// </returns>
function CRCCode(var CRCDef: TCRCDef; const Buffer; Size: UInt32): UInt32; overload;
/// <summary>
/// Calculate the CRC of the contents provided by a given callback
/// </summary>
/// <param name="CRCDef">
/// Structure with the necessary metadata for the CRC algorithm to be used.
/// CRC processing state is being updated during calculation to enable this
/// structure to be fed in another call to CRCCode if a CRC over multiple
/// buffers has to be calculated.
/// </param>
/// <param name="ReadMethod">
/// Callback which is being called to get the data the CRC is processed over,
/// e.g. TStream.Read
/// </param>
/// <param name="Size">
/// Number of bytes over which the CRC will be calculated. The callback will
/// be called until that number of bytes have been processed.
/// </param>
/// <returns>
/// Calculated CRC value, including any necessary correction (like CRCDone).
/// CRCDef.CRC holds the actual computed CRC, additional calls of CRCCode
/// compute the total CRC of split buffers
/// </returns>
function CRCCode(var CRCDef: TCRCDef;
ReadMethod: TReadMethod;
Size: UInt32 = $FFFFFFFF): UInt32; overload;
{ TODO :
DUnitTests f<>r die Callback-Methoden Varianten von CRCCode und CRCCalc
schreiben }
//
// CRCInit(CRC, CRC_32); // setup CRC data structure
// CRCCode(CRC, Data, SizeOf(Data)); // calcs CRC for "Data"
// CRCCode(CRC, PChar(string)^, Length(string) * SizeOf(string[1])); // calcs CRC for String
// CRC32 := CRCDone(CRC);
// returns corrected CRC as definied in CRCDef and resets CRCDef.CRC to InitVector
/// <summary>
/// Corrects the CRC via the final vector and resets the internal intermediate
/// CRC value to the init vector so the next CRC calculation can start.
/// </summary>
/// <param name="CRCDef">
/// Structure with the current CRC state
/// </param>
/// <returns>
/// Final CRC value
/// </returns>
function CRCDone(var CRCDef: TCRCDef): UInt32;
/// <summary>
/// Calculates a CRC over some Buffer with Size Bytes length. Processing is
/// being done in one single step
/// </summary>
/// <param name="CRCType">
/// Specifies the CRC algorithm to be used
/// </param>
/// <param name="Buffer">
/// Buffer with the data to calculate the CRC from
/// </param>
/// <param name="Size">
/// Number of bytes over which the CRC will be calculated from the beginning
/// of the buffer
/// </param>
function CRCCalc(CRCType: TCRCType; const Buffer; Size: UInt32): UInt32; overload;
/// <summary>
/// Calculates a CRC. Data is passed via callback, which is called repeatedly
/// if necessary
/// </summary>
/// <param name="CRCType">
/// Specifies the CRC algorithm to be used
/// </param>
/// <param name="ReadMethod">
/// Callback which is being called to get the data the CRC is processed over
/// e.g. TStream.Read
/// </param>
/// <param name="Size">
/// Number of bytes over which the CRC will be calculated. The callback will
/// be called until that number of bytes have been processed.
/// </param>
/// <returns>
/// Calculated CRC value.
/// </returns>
function CRCCalc(CRCType : TCRCType;
ReadMethod : TReadMethod;
Size : UInt32 = $FFFFFFFF): UInt32; overload;
/// <summary>
/// Calculates a CRC according a predefined CRC16-Standard over some Buffer
/// with Size Bytes length. Processing is being done in one single step
/// </summary>
/// <remarks>
/// call CRC := CRC16(0, Data, SizeOf(Data));
/// </remarks>
/// <param name="CRC">
/// Specifies the CRC algorithm to be used
/// </param>
/// <param name="Buffer">
/// Buffer with the data to calculate the CRC from
/// </param>
/// <param name="Size">
/// Number of bytes over which the CRC will be calculated from the beginning
/// of the buffer
/// </param>
/// <returns>
/// Calculated CRC16 value
/// </returns>
function CRC16(CRC: UInt16; const Buffer; Size: UInt32): UInt16;
/// <summary>
/// Calculates a CRC according the CRC32-CCITT standard over some Buffer
/// with Size Bytes length. Processing is being done in one single step
/// </summary>
/// <remarks>
/// call CRC := CRC32(0, Data, SizeOf(Data));
/// </remarks>
/// <param name="CRC">
/// Specifies the CRC algorithm to be used
/// </param>
/// <param name="Buffer">
/// Buffer with the data to calculate the CRC from
/// </param>
/// <param name="Size">
/// Number of bytes over which the CRC will be calculated from the beginning
/// of the buffer
/// </param>
/// <returns>
/// Calculated CRC32 value
/// </returns>
function CRC32(CRC: UInt32; const Buffer; Size: UInt32): UInt32;
implementation
{$IFOPT Q+}{$DEFINE RESTORE_OVERFLOWCHECKS}{$Q-}{$ENDIF}
{$IFOPT R+}{$DEFINE RESTORE_RANGECHECKS}{$R-}{$ENDIF}
type
PCRCTab = ^TCRCTab;
/// <summary>
/// Array type for the meta data definitions of the individual CRC algorithms
/// </summary>
TCRCTab = array[TCRCType] of packed record
Poly, Bits, Init, FInit: UInt32;
Inverse: LongBool;
end;
const
/// <summary>
/// Table containing meta data of various well known CRC algorithms/polynoms
/// </summary>
CRCTab : TCRCTab = (
(Poly: $000000D1; Bits: 08; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_8 GSM/ERR
(Poly: $00000233; Bits: 10; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_10 ATM/OAM Cell
(Poly: $0000080F; Bits: 12; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_12
(Poly: $00008005; Bits: 16; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_16 ARC;IBM;MODBUS RTU
// Init value of 1D0F instead of FFFF because the code doesn't fill with zeros,
// which would otherwise be required for the CCITT variant
(Poly: $00001021; Bits: 16; Init: $00001D0F; FInit: $00000000; Inverse: False), // CRC_16 CCITT ITU
(Poly: $00008408; Bits: 16; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_16 XModem
(Poly: $00864CFB; Bits: 24; Init: $00B704CE; FInit: $00000000; Inverse: False), // CRC_24
(Poly: $9DB11213; Bits: 32; Init: $FFFFFFFF; FInit: $FFFFFFFF; Inverse: True), // CRC_32
(Poly: $04C11DB7; Bits: 32; Init: $FFFFFFFF; FInit: $FFFFFFFF; Inverse: True), // CRC_32CCITT
(Poly: $04C11DB7; Bits: 32; Init: $FFFFFFFF; FInit: $00000000; Inverse: True), // CRC_32ZModem
(Poly: $00000007; Bits: 08; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_8ATMHEC
(Poly: $00000007; Bits: 08; Init: $00000000; FInit: $00000000; Inverse: False), // CRC_8SMBus
(Poly: $00004599; Bits: 15; Init: $00000000; FInit: $00000000; Inverse: True), // CRC_15CAN
(Poly: $00001021; Bits: 16; Init: $00000000; FInit: $00000000; Inverse: False) // CRC_16ZMODEM
);
// some other CRC's, not all yet verfied
// DD $00001021, 16, $0000FFFF, $00000000, 0 // CRC_16 CCITT British Aerospace
// DD $00004003, 16, $00000000, $00000000, -1 // CRC_16 reversed
// DD $00001005, 16, $00000000, $00000000, -1 // CRC_16 X25
// https://fenix.tecnico.ulisboa.pt/downloadFile/3779571246541/BasicCrd.pdf enth<74>lt
// eine beschreibung dieser BasicCard Smartcard incl. C-CRC Quellcode, aber die
// Polynome konnte ich so noch nicht <20>berpr<70>fen
// DD $00000053, 16, $00000000, $00000000, -1 // BasicCard 16Bit CRC (sparse poly for Crypto MCU)
// DD $000000C5, 32, $00000000, $00000000, -1 // BasicCard 32Bit CRC
function CRCSetup(var CRCDef: TCRCDef; Polynomial, Bits, InitVector,
FinalVector: UInt32; Inverse: LongBool): Boolean;
// initialize CRCDef according to the parameters, calculate the lookup table
{$IFDEF X86ASM}
asm
CMP ECX,8
JB @@8
PUSH EBX
PUSH EDI
PUSH ESI
MOV [EAX].TCRCDef.Polynomial,EDX
MOV [EAX].TCRCDef.Bits,ECX
MOV EBX,InitVector
MOV EDI,FinalVector
MOV ESI,Inverse
MOV [EAX].TCRCDef.CRC,EBX
MOV [EAX].TCRCDef.InitVector,EBX
MOV [EAX].TCRCDef.FinalVector,EDI
MOV [EAX].TCRCDef.Inverse,ESI
XOR EDI,EDI
LEA EBX,[ECX - 8]
SUB ECX,32
DEC EDI
NEG ECX
SHR EDI,CL
MOV [EAX].TCRCDef.Shift,EBX
MOV [EAX].TCRCDef.Mask,EDI
TEST ESI,ESI
JZ @@5
XOR EBX,EBX
MOV ECX,[EAX].TCRCDef.Bits
@@1: SHR EDX,1
ADC EBX,EBX
DEC ECX
JNZ @@1
NOP
MOV ECX,255
NOP
@@20: MOV EDX,ECX
SHR EDX,1
JNC @@21
XOR EDX,EBX
@@21: SHR EDX,1
JNC @@22
XOR EDX,EBX
@@22: SHR EDX,1
JNC @@23
XOR EDX,EBX
@@23: SHR EDX,1
JNC @@24
XOR EDX,EBX
@@24: SHR EDX,1
JNC @@25
XOR EDX,EBX
@@25: SHR EDX,1
JNC @@26
XOR EDX,EBX
@@26: SHR EDX,1
JNC @@27
XOR EDX,EBX
@@27: SHR EDX,1
JNC @@28
XOR EDX,EBX
@@28: MOV [EAX + ECX * 4],EDX
DEC ECX
JNL @@20
JMP @@7
@@5: AND EDX,EDI
ROL EDX,CL
MOV EBX,255
// can be coded branchfree
@@60: MOV ESI,EBX
SHL ESI,25
JNC @@61
XOR ESI,EDX
@@61: ADD ESI,ESI
JNC @@62
XOR ESI,EDX
@@62: ADD ESI,ESI
JNC @@63
XOR ESI,EDX
@@63: ADD ESI,ESI
JNC @@64
XOR ESI,EDX
@@64: ADD ESI,ESI
JNC @@65
XOR ESI,EDX
@@65: ADD ESI,ESI
JNC @@66
XOR ESI,EDX
@@66: ADD ESI,ESI
JNC @@67
XOR ESI,EDX
@@67: ADD ESI,ESI
JNC @@68
XOR ESI,EDX
@@68: ROR ESI,CL
MOV [EAX + EBX * 4],ESI
DEC EBX
JNL @@60
@@7: POP ESI
POP EDI
POP EBX
@@8: CMC
SBB EAX,EAX
NEG EAX
end;
{$ELSE !X86ASM}
var
Value, XorValue, OldValue: UInt32;
Index: Integer;
B: Boolean;
One: Byte;
begin
if Bits >= 8 then
begin
CRCDef.Polynomial := Polynomial;
CRCDef.Bits := Bits;
CRCDef.CRC := InitVector;
CRCDef.InitVector := InitVector;
CRCDef.FinalVector := FinalVector;
CRCDef.Inverse := Inverse;
CRCDef.Shift := Bits - 8;
Bits := -(Bits - 32);
CRCDef.Mask := -1 shr Byte(Bits);
if Inverse then
begin
Bits := CRCDef.Bits;
XorValue := 0;
repeat
Inc(XorValue, XorValue + Ord(Polynomial and $1));
Polynomial := Polynomial shr 1;
Dec(Bits);
until Bits = 0;
One := $1;
for Index := 255 downto 0 do
begin
Value := Index;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
B := Boolean(Value and One); Value := Value shr 1;
if B then Value := Value xor XorValue;
CRCDef.Table[Index] := Value;
end;
end
else
begin
XorValue := Polynomial and CRCDef.Mask;
XorValue := (XorValue shl Byte(Bits)) or (XorValue shr (32 - Byte(Bits)));
for Index := 255 downto 0 do
begin
B := Boolean(Index and $000000080); Value := Index shl 25;
if B then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
OldValue := Value; Inc(Value, Value);
if Value < OldValue then Value := Value xor XorValue;
Value := (Value shr Byte(Bits)) or (Value shl (32 - Byte(Bits)));
CRCDef.Table[Index] := Value;
end;
end;
Result := True;
end
else
Result := False;
end;
{$ENDIF !X86ASM}
function CRCInit(var CRCDef: TCRCDef; CRCType: TCRCType): Boolean;
begin
Result := CRCSetup(CRCDef,
PCRCTab(@CRCTab)[CRCType].Poly,
PCRCTab(@CRCTab)[CRCType].Bits,
PCRCTab(@CRCTab)[CRCType].Init,
PCRCTab(@CRCTab)[CRCType].FInit,
PCRCTab(@CRCTab)[CRCType].Inverse);
end;
function CRCCode(var CRCDef: TCRCDef; const Buffer; Size: UInt32): UInt32;
// do the CRC computation
{$IFDEF X86ASM}
asm
JECXZ @@5
TEST EDX,EDX
JZ @@5
PUSH ESI
PUSH EBX
MOV ESI,EAX
CMP [EAX].TCRCDef.Inverse,0
MOV EAX,[ESI].TCRCDef.CRC
JZ @@2
XOR EBX,EBX
@@1: MOV BL,[EDX]
XOR BL,AL
SHR EAX,8
INC EDX
XOR EAX,[ESI + EBX * 4]
DEC ECX
JNZ @@1
JMP @@4
@@2: PUSH EDI
MOV EBX,EAX
MOV EDI,ECX
MOV ECX,[ESI].TCRCDef.Shift
MOV EBX,EAX
@@3: SHR EBX,CL
SHL EAX,8
XOR BL,[EDX]
INC EDX
MOVZX EBX,BL
XOR EAX,[ESI + EBX * 4]
DEC EDI
MOV EBX,EAX
JNZ @@3
POP EDI
@@4: MOV [ESI].TCRCDef.CRC,EAX
XOR EAX,[ESI].TCRCDef.FinalVector
AND EAX,[ESI].TCRCDef.Mask
POP EBX
POP ESI
RET
@@5: MOV EAX,[EAX].TCRCDef.CRC
end;
{$ELSE !X86ASM}
var
P: PByte;
Value: Byte;
begin
Result := CRCDef.CRC;
P := @Buffer;
if (Size <> 0) and (P <> nil) then
begin
if CRCDef.Inverse then
begin
repeat
Value := P^ xor Byte(Result);
Result := (Result shr 8) xor CRCDef.Table[Value];
Inc(P);
Dec(Size);
until Size = 0;
end
else
begin
Value := Byte(CRCDef.Shift); // move to local variable => cpu register
repeat
Result := (Result shl 8) xor CRCDef.Table[Byte(Result shr Value) xor P^];
Inc(P);
Dec(Size);
until Size = 0;
end;
CRCDef.CRC := Result;
Result := (Result xor CRCDef.FinalVector) and CRCDef.Mask;
end;
end;
{$ENDIF !X86ASM}
function CRCCode(var CRCDef: TCRCDef; ReadMethod: TReadMethod; Size: UInt32 = $FFFFFFFF): UInt32;
var
Buffer: array[0..1023] of Char;
Count: Int64;
begin
repeat
if Size > SizeOf(Buffer) then
Count := SizeOf(Buffer)
else
Count := Size;
Count := ReadMethod(Buffer, Count);
Result := CRCCode(CRCDef, Buffer, Count);
Dec(Size, Count);
until (Size = 0) or (Count = 0);
end;
function CRCDone(var CRCDef: TCRCDef): UInt32;
// finalize CRCDef after a computation
{$IFDEF X86ASM}
asm
MOV EDX,[EAX].TCRCDef.CRC
MOV ECX,[EAX].TCRCDef.InitVector
XOR EDX,[EAX].TCRCDef.FinalVector
MOV [EAX].TCRCDef.CRC,ECX
AND EDX,[EAX].TCRCDef.Mask
MOV EAX,EDX
end;
{$ELSE !X86ASM}
begin
Result := CRCDef.CRC;
CRCDef.CRC := CRCDef.InitVector;
Result := (Result xor CRCDef.FinalVector) and CRCDef.Mask;
end;
{$ENDIF !X86ASM}
function CRCCalc(CRCType: TCRCType; const Buffer; Size: UInt32): UInt32;
// inplace calculation
var
CRC: TCRCDef;
begin
CRCInit(CRC, CRCType);
Result := CRCCode(CRC, Buffer, Size);
end;
function CRCCalc(CRCType: TCRCType; ReadMethod: TReadMethod; Size: UInt32): UInt32;
var
CRC: TCRCDef;
begin
CRCInit(CRC, CRCType);
Result := CRCCode(CRC, ReadMethod, Size);
end;
// predefined CRC16/CRC32CCITT, avoid slower lookuptable computation by use of precomputation
var
FCRC16: PCRCDef = nil;
FCRC32: PCRCDef = nil;
function CRC16Init: Pointer;
begin
// Replace GetMem by GetMemory due to C++ Builder compatibility
// GetMem(FCRC16, SizeOf(TCRCDef));
FCRC16 := GetMemory(SizeOf(TCRCDef));
CRCInit(FCRC16^, CRC_16);
Result := FCRC16;
end;
function CRC16(CRC: UInt16; const Buffer; Size: UInt32): UInt16;
{$IFDEF X86ASM}
asm
JECXZ @@2
PUSH EDI
PUSH ESI
MOV EDI,ECX
{$IFDEF PIC}
MOV ESI,[EBX].FCRC16
{$ELSE !PIC}
MOV ESI,FCRC16
{$ENDIF !PIC}
XOR ECX,ECX
TEST ESI,ESI
JZ @@3
@@1: MOV CL,[EDX]
XOR CL,AL
SHR EAX,8
INC EDX
XOR EAX,[ESI + ECX * 4]
DEC EDI
JNZ @@1
POP ESI
POP EDI
@@2: RET
@@3: PUSH EAX
PUSH EDX
CALL CRC16Init
MOV ESI,EAX
XOR ECX,ECX
POP EDX
POP EAX
JMP @@1
end;
{$ELSE !X86ASM}
var
LCRC16: PCRCDef;
P: PByte;
CRC32: UInt32;
Value: Byte;
begin
if Size <> 0 then
begin
LCRC16 := FCRC16;
if LCRC16 = nil then
LCRC16 := CRC16Init;
CRC32 := CRC;
P := @Buffer;
repeat
Value := P^ xor Byte(CRC32);
CRC32 := (CRC32 shr 8) xor LCRC16.Table[Value];
Inc(P);
Dec(Size);
until Size = 0;
Result := UInt16(CRC32);
end
else
Result := CRC;
end;
{$ENDIF !X86ASM}
function CRC32Init: Pointer;
begin
// Replaced for C++ Builder compatibility
// GetMem(FCRC32, SizeOf(TCRCDef));
FCRC32 := GetMemory(SizeOf(TCRCDef));
CRCInit(FCRC32^, CRC_32CCITT);
Result := FCRC32;
end;
function CRC32(CRC: UInt32; const Buffer; Size: UInt32): UInt32;
{$IFDEF X86ASM}
asm
JECXZ @@2
PUSH EDI
PUSH ESI
NOT EAX // inverse Input CRC
MOV EDI,ECX
{$IFDEF PIC}
MOV ESI,[EBX].FCRC32
{$ELSE !PIC}
MOV ESI,FCRC32
{$ENDIF !PIC}
XOR ECX,ECX
TEST ESI,ESI
JZ @@3
@@1: MOV CL,[EDX]
XOR CL,AL
SHR EAX,8
INC EDX
XOR EAX,[ESI + ECX * 4]
DEC EDI
JNZ @@1
NOT EAX // inverse Output CRC
POP ESI
POP EDI
@@2: RET
@@3: PUSH EAX
PUSH EDX
CALL CRC32Init
MOV ESI,EAX
XOR ECX,ECX
POP EDX
POP EAX
JMP @@1
end;
{$ELSE !X86ASM}
var
LCRC32: PCRCDef;
P: PByte;
CRC32: UInt32;
Value: Byte;
begin
if Size <> 0 then
begin
LCRC32 := FCRC32;
if LCRC32 = nil then
LCRC32 := CRC32Init;
CRC32 := not CRC; // inverse Input CRC
P := @Buffer;
repeat
Value := P^ xor Byte(CRC32);
CRC32 := (CRC32 shr 8) xor LCRC32.Table[Value];
Inc(P);
Dec(Size);
until Size = 0;
Result := not CRC32; // inverse Output CRC
end
else
Result := CRC;
end;
{$ENDIF !X86ASM}
procedure CRCInitThreadSafe;
begin
CRC16Init;
CRC32Init;
end;
{$IFDEF RESTORE_RANGECHECKS}{$R+}{$ENDIF}
{$IFDEF RESTORE_OVERFLOWCHECKS}{$Q+}{$ENDIF}
initialization
CRCInitThreadSafe;
finalization
if FCRC16 <> nil then
FreeMem(FCRC16);
if FCRC32 <> nil then
FreeMem(FCRC32);
end.

1114
contrib/DelphiEncryptionCompendium/Source/DECCipherBase.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1037
contrib/DelphiEncryptionCompendium/Source/DECCipherFormats.pas Normal file
View File

File diff suppressed because it is too large Load Diff

605
contrib/DelphiEncryptionCompendium/Source/DECCipherInterface.pas Normal file
View File

@@ -0,0 +1,605 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit DECCipherInterface;
interface
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
DECUtil, DECCipherBase, DECFormatBase;
type
/// <summary>
/// Common interface for all ciphers. Some ciphers may have additional
/// methods/properties though!
/// </summary>
IDECCipher = Interface
/// <summary>
/// Encrypts the contents of a given byte array
/// </summary>
/// <param name="Source">
/// Byte array with data to be encrypted
/// </param>
/// <returns>
/// Byte array with encrypted data
/// </returns>
function EncodeBytes(const Source: TBytes): TBytes;
/// <summary>
/// Decrypts the contents of a given byte array
/// </summary>
/// <param name="Source">
/// Byte array with data to be decrypted
/// </param>
/// <returns>
/// Byte array with decrypted data
/// </returns>
function DecodeBytes(const Source: TBytes): TBytes;
/// <summary>
/// Encrypts the data contained in a given stream
/// </summary>
/// <param name="Source">
/// Source stream containing the data to encrypt
/// </param>
/// <param name="Dest">
/// Destination stream, where the encrypted data shall be put in
/// </param>
/// <param name="DataSize">
/// Number of bytes of Source to be encrypted
/// </param>
/// <param name="OnProgress">
/// optional callback for reporting progress of the operation
/// </param>
procedure EncodeStream(const Source, Dest: TStream; DataSize: Int64;
const OnProgress: TDECProgressEvent = nil);
/// <summary>
/// Decrypts the data contained in a given stream
/// </summary>
/// <param name="Source">
/// Source stream containing the data to decrypt
/// </param>
/// <param name="Dest">
/// Destination stream, where the decrypted data shall be put in
/// </param>
/// <param name="DataSize">
/// Number of bytes of Source to be decrypted
/// </param>
/// <param name="OnProgress">
/// optional callback for reporting progress of the operation
/// </param>
procedure DecodeStream(const Source, Dest: TStream; DataSize: Int64;
const OnProgress: TDECProgressEvent = nil);
/// <summary>
/// Reads the contents of one file, encrypts it and stores it in another file
/// </summary>
/// <param name="SourceFileName">
/// Path and name of the file to encrypt
/// </param>
/// <param name="DestFileName">
/// Path and name of the file the encrypted data shall be stored in
/// </param>
/// <param name="OnProgress">
/// Optional event which can be passed to get information about the
/// progress of the encryption operation
/// </param>
procedure EncodeFile(const SourceFileName, DestFileName: string;
const OnProgress: TDECProgressEvent = nil);
/// <summary>
/// Reads the contents of one file, decrypts it and stores it in another file
/// </summary>
/// <param name="SourceFileName">
/// Path and name of the file to decrypt
/// </param>
/// <param name="DestFileName">
/// Path and name of the file the decrypted data shall be stored in
/// </param>
/// <param name="OnProgress">
/// Optional event which can be passed to get information about the
/// progress of the decryption operation
/// </param>
procedure DecodeFile(const SourceFileName, DestFileName: string;
const OnProgress: TDECProgressEvent = nil);
/// <summary>
/// Encrypts the contents of the passed unicode string
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as a byte array
/// </returns>
function EncodeStringToBytes(const Source: string; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Encrypts the contents of the passed RawByteString
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as a byte array
/// </returns>
function EncodeStringToBytes(const Source: RawByteString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Encrypts the contents of the passed unicode string
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which will result in an 7-bit ASCII compatible string as we cannot
/// ensure that Unicode string processing will not alter/interpret some
/// byte combinations in a destructive way, making the encrypted string
/// un-decryptable.
/// </remarks>
function EncodeStringToString(const Source: string; Format: TDECFormatClass = nil): string; overload;
/// <summary>
/// Encrypts the contents of the passed unicode string
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which will result in an 7-bit ASCII compatible string as we cannot
/// ensure that string processing will not alter/interpret some
/// byte combinations in a destructive way, making the encrypted string
/// un-decryptable.
/// </remarks>
function EncodeStringToString(const Source: RawByteString; Format: TDECFormatClass = nil): RawByteString; overload;
/// <summary>
/// Decrypts the contents of the passed encrypted unicode string
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the still encrypted data, not the
/// encrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string as a byte array
/// </returns>
function DecodeStringToBytes(const Source: string; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Decrypts the contents of the passed encrypted RawByteString
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the still encrypted data, not the
/// encrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string as a byte array
/// </returns>
function DecodeStringToBytes(const Source: RawByteString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Decrypts the contents of the passed Unicode string
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the encrypted data, not the
/// decrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which uses an 7-bit ASCII compatible string as input so that it
/// didn't get altered by Unicode string processing in some hafrmful way
/// </remarks>
function DecodeStringToString(const Source: string; Format: TDECFormatClass = nil): string; overload;
/// <summary>
/// Decrypts the contents of the passed RawByteString string
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the encrypted data, not the
/// decrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which uses an 7-bit ASCII compatible string as input so that it
/// didn't get altered by string processing in some hafrmful way
/// </remarks>
function DecodeStringToString(const Source: RawByteString; Format: TDECFormatClass = nil): RawByteString; overload;
{$IFDEF ANSISTRINGSUPPORTED}
/// <summary>
/// Encrypts the contents of the passed Ansistring
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as a byte array
/// </returns>
function EncodeStringToBytes(const Source: AnsiString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Encrypts the contents of the passed Ansistring
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as an AnsiString
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which will result in an 7-bit ASCII compatible string as we cannot
/// ensure that string processing will not alter/interpret some
/// byte combinations in a destructive way, making the encrypted string
/// un-decryptable.
/// </remarks>
function EncodeStringToString(const Source: AnsiString; Format: TDECFormatClass = nil): AnsiString; overload;
/// <summary>
/// Decrypts the contents of the passed encrypted Ansistring
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the still encrypted data, not the
/// encrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string as a byte array
/// </returns>
function DecodeStringToBytes(const Source: AnsiString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Decrypts the contents of the passed AnsiString string
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the encrypted data, not the
/// decrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which uses an 7-bit ASCII compatible string as input so that it
/// didn't get altered by string processing in some hafrmful way
/// </remarks>
function DecodeStringToString(const Source: AnsiString; Format: TDECFormatClass = nil): AnsiString; overload;
{$ENDIF}
{$IFNDEF NEXTGEN}
/// <summary>
/// Encrypts the contents of the passed Widestring
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as a byte array
/// </returns>
function EncodeStringToBytes(const Source: WideString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Encrypts the contents of the passed Widestring
/// </summary>
/// <param name="Source">
/// String to encrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Encoded will be the encrypted data, not the
/// source data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Encrypted string as an WideString
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which will result in an 7-bit ASCII compatible string as we cannot
/// ensure that string processing will not alter/interpret some
/// byte combinations in a destructive way, making the encrypted string
/// un-decryptable.
/// </remarks>
function EncodeStringToString(const Source: WideString; Format: TDECFormatClass = nil): WideString; overload;
/// <summary>
/// Decrypts the contents of the passed encrypted Widestring
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the still encrypted data, not the
/// encrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string as a byte array
/// </returns>
function DecodeStringToBytes(const Source: WideString; Format: TDECFormatClass = nil): TBytes; overload;
/// <summary>
/// Decrypts the contents of the passed WideString string
/// </summary>
/// <param name="Source">
/// String to decrypt
/// </param>
/// <param name="Format">
/// Optional parameter. One can pass a class reference of one of the
/// concrete data formatting classes here which will be internally used
/// to convert the data. Decoded will be the encrypted data, not the
/// decrypted data. Formattings can be used to convert data into a format
/// suitable for the transport medium the data shall be transported with.
/// </param>
/// <returns>
/// Decrypted string
/// </returns>
/// <remarks>
/// The use of this method is only recommended if a formatting is passed
/// which uses an 7-bit ASCII compatible string as input so that it
/// didn't get altered by string processing in some hafrmful way
/// </remarks>
function DecodeStringToString(const Source: WideString; Format: TDECFormatClass = nil): WideString; overload;
{$ENDIF}
/// <summary>
/// Initializes the cipher with the necessary encryption/decryption key
/// </summary>
/// <param name="Key">
/// Encryption/decryption key. Recommended/required key length is dependant
/// on the concrete algorithm.
/// </param>
/// <param name="Size">
/// Size of the key in bytes
/// </param>
/// <param name="IVector">
/// Initialization vector. This contains the values the first block of
/// data to be processed is linked with. This is being done the same way
/// as the 2nd block of the data to be processed will be linked with the
/// first block and so on and this is dependant on the cypher mode set via
/// Mode property
/// </param>
/// <param name="IVectorSize">
/// Size of the initialization vector in bytes
/// </param>
/// <param name="IFiller">
/// optional parameter defining the value with which the last block will
/// be filled up if the size of the data to be processed cannot be divided
/// by block size without reminder. Means: if the last block is not
/// completely filled with data.
/// </param>
procedure Init(const Key; Size: Integer; const IVector; IVectorSize: Integer; IFiller: Byte = $FF); overload;
/// <summary>
/// Initializes the cipher with the necessary encryption/decryption key
/// </summary>
/// <param name="Key">
/// Encryption/decryption key. Recommended/required key length is dependant
/// on the concrete algorithm.
/// </param>
/// <param name="IVector">
/// Initialization vector. This contains the values the first block of
/// data to be processed is linked with. This is being done the same way
/// as the 2nd block of the data to be processed will be linked with the
/// first block and so on and this is dependant on the cypher mode set via
/// Mode property
/// </param>
/// <param name="IFiller">
/// optional parameter defining the value with which the last block will
/// be filled up if the size of the data to be processed cannot be divided
/// by block size without reminder. Means: if the last block is not
/// completely filled with data.
/// </param>
procedure Init(const Key: TBytes; const IVector: TBytes; IFiller: Byte = $FF); overload;
/// <summary>
/// Initializes the cipher with the necessary encryption/decryption key
/// </summary>
/// <param name="Key">
/// Encryption/decryption key. Recommended/required key length is dependant
/// on the concrete algorithm.
/// </param>
/// <param name="IVector">
/// Initialization vector. This contains the values the first block of
/// data to be processed is linked with. This is being done the same way
/// as the 2nd block of the data to be processed will be linked with the
/// first block and so on and this is dependant on the cypher mode set via
/// Mode property
/// </param>
/// <param name="IFiller">
/// optional parameter defining the value with which the last block will
/// be filled up if the size of the data to be processed cannot be divided
/// by block size without reminder. Means: if the last block is not
/// completely filled with data.
/// </param>
procedure Init(const Key: RawByteString; const IVector: RawByteString = ''; IFiller: Byte = $FF); overload;
{$IFDEF ANSISTRINGSUPPORTED}
/// <summary>
/// Initializes the cipher with the necessary encryption/decryption key.
/// Only for use with the classic desktop compilers.
/// </summary>
/// <param name="Key">
/// Encryption/decryption key. Recommended/required key length is dependant
/// on the concrete algorithm.
/// </param>
/// <param name="IVector">
/// Initialization vector. This contains the values the first block of
/// data to be processed is linked with. This is being done the same way
/// as the 2nd block of the data to be processed will be linked with the
/// first block and so on and this is dependant on the cypher mode set via
/// Mode property
/// </param>
/// <param name="IFiller">
/// optional parameter defining the value with which the last block will
/// be filled up if the size of the data to be processed cannot be divided
/// by block size without reminder. Means: if the last block is not
/// completely filled with data.
/// </param>
procedure Init(const Key: AnsiString; const IVector: AnsiString = ''; IFiller: Byte = $FF); overload;
{$ENDIF}
{$IFNDEF NEXTGEN}
/// <summary>
/// Initializes the cipher with the necessary encryption/decryption key.
/// Only for use with the classic desktop compilers.
/// </summary>
/// <param name="Key">
/// Encryption/decryption key. Recommended/required key length is dependant
/// on the concrete algorithm.
/// </param>
/// <param name="IVector">
/// Initialization vector. This contains the values the first block of
/// data to be processed is linked with. This is being done the same way
/// as the 2nd block of the data to be processed will be linked with the
/// first block and so on and this is dependant on the cypher mode set via
/// Mode property
/// </param>
/// <param name="IFiller">
/// optional parameter defining the value with which the last block will
/// be filled up if the size of the data to be processed cannot be divided
/// by block size without reminder. Means: if the last block is not
/// completely filled with data.
/// </param>
procedure Init(const Key: WideString; const IVector: WideString = ''; IFiller: Byte = $FF); overload;
{$ENDIF}
/// <summary>
/// Returns the currently set cipher block mode, means how blocks are
/// linked to each other in order to avoid certain attacks.
/// </summary>
function GetMode: TCipherMode;
/// <summary>
/// Sets the cipher mode, means how each block is being linked with his
/// predecessor to avoid certain attacks
/// </summary>
procedure SetMode(Value: TCipherMode);
/// <summary>
/// Mode used for padding data to be encrypted/decrypted. See TCipherMode.
/// </summary>
property Mode: TCipherMode
read GetMode
write SetMode;
end;
implementation
end.

919
contrib/DelphiEncryptionCompendium/Source/DECCipherModes.pas Normal file
View File

@@ -0,0 +1,919 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit DECCipherModes;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils,
{$ELSE}
System.SysUtils,
{$ENDIF}
DECCipherBase;
{$I DECOptions.inc}
type
/// <summary>
/// Most ciphers are block oriented and thus work on blocks of a fixed size.
/// In order to not encrypt each block separately without any link to his
/// predecessor and sucessor, which would make attacks on the encrypted data
/// easier, each block should be linked with his predecessor (or the
/// initialization vector). This class implements the various supported
/// algorithms for linking blocks.
/// </summary>
TDECCipherModes = class(TDECCipher)
strict protected
/// <summary>
/// Raises an EDECCipherException exception and provides the correct values
/// for message lenght and block size
/// </summary>
procedure ReportInvalidMessageLength(Cipher: TDECCipher);
/// <summary>
/// Electronic Code Book
/// Mode cmECBx needs message padding to be a multiple of Cipher.BlockSize
/// and should be used only in 1-byte Streamciphers.
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// </summary>
/// <remarks>
/// This mode should not be used in practice, as it makes the encrypted
/// message vulnerable to certain attacks without knowing the encryption key
/// </remarks>
procedure EncodeECBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8bit Output Feedback mode, needs no padding
/// </summary>
procedure EncodeOFB8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8 bit Cipher Feedback mode, needs no padding and works on 8 bit
/// Feedback Shift Registers.
/// </summary>
procedure EncodeCFB8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8Bit CFS, double Cipher Feedback mode (CFB), needs no padding and
/// works on 8 bit Feedback Shift Registers.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into Feedback register.
/// </summary>
procedure EncodeCFS8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Cipher Feedback mode (CFB) on Blocksize of Cipher, needs no padding
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure EncodeCFBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Output Feedback mode on Blocksize of Cipher, needs no padding and
/// works on 8 bit Feedback Shift Registers.
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure EncodeOFBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// double Cipher Feedback mode (CFB) on Blocksize of Cipher, needs no padding.
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into Feedback register.
/// </summary>
procedure EncodeCFSx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Cipher Block Chaining, with CFB8 padding of truncated final block
/// It needs no external padding, because internally the last
/// truncated block is padded by cmCFS8 or cmCFB8. After padding these Modes
/// cannot be used to process any more data. If needed to process chunks of
/// data then each chunk must be aligned to Cipher.BufferSize bytes.
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure EncodeCBCx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// double CBC, with CFS8 padding of truncated final block
/// It needs no external padding, because internally the last
/// truncated block is padded by cmCFS8 or cmCFB8. After padding these Modes
/// cannot be used to process any more data. If needed to process chunks of
/// data then each chunk must be aligned to Cipher.BufferSize bytes.
/// This one works on Blocks of Cipher.BufferSize bytes, when using a
/// Blockcipher that's equal to Cipher.BlockSize.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into Feedback register.
/// </summary>
procedure EncodeCTSx(Source, Dest: PByteArray; Size: Integer); virtual;
{$IFDEF DEC3_CMCTS}
/// <summary>
/// double CBC, with
/// for DEC 3.0 compatibility only
/// This is a proprietary mode developed by Frederik Winkelsdorf. It
/// replaces the CFS8 padding of the truncated final block with a CFSx padding.
/// Useful when converting projects that previously used the old DEC v3.0. It
/// has the same restrictions for external padding and chunk processing as
/// cmCTSx has. It has a less secure padding of the truncated final block.
/// (to enable it see DECOptions.inc)
/// </summary>
procedure EncodeCTS3(Source, Dest: PByteArray; Size: Integer); virtual;
{$ENDIF}
/// <summary>
/// Electronic Code Book
/// Mode cmECBx needs message padding to be a multiple of Cipher.BlockSize
/// and should be used only in 1-byte Streamciphers.
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure DecodeECBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8 bit Output Feedback mode, needs no padding
/// </summary>
procedure DecodeOFB8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8 bit Cipher Feedback mode, needs no padding and works on 8 bit
/// Feedback Shift Registers.
/// </summary>
procedure DecodeCFB8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// 8 Bit CFS, double Cipher Feedback mode (CFB), needs no padding and
/// works on 8 bit Feedback Shift Registers.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into Feedback register.
/// </summary>
procedure DecodeCFS8(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Cipher Feedback mode (CFB) on Blocksize of Cipher, needs no padding
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure DecodeCFBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Output Feedback mode on Blocksize of Cipher, needs no padding and
/// works on 8 bit Feedback Shift Registers.
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure DecodeOFBx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// double Cipher Feedback mode (CFB) on Blocksize of Cipher, needs no padding.
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into Feedback register.
/// </summary>
procedure DecodeCFSx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// Cipher Block Chaining, with CFB8 padding of truncated final block.
/// It needs no external padding, because internally the last
/// truncated block is padded by cmCFS8 or cmCFB8. After padding these modes
/// cannot be used to process any more data. If needed to process chunks of
/// data then each chunk must be algined to Cipher.BufferSize bytes.
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// </summary>
procedure DecodeCBCx(Source, Dest: PByteArray; Size: Integer); virtual;
/// <summary>
/// double CBC, with CFS8 padding of truncated final block
/// It needs no external padding, because internally the last
/// truncated block is padded by cmCFS8 or cmCFB8. After padding these Modes
/// cannot be used to process any more data. If needed to process chunks of
/// data then each chunk must be algined to Cipher.BufferSize bytes.
/// This one works on blocks of Cipher.BufferSize bytes, when using a
/// blockcipher that's equal to Cipher.BlockSize.
/// This one is a proprietary mode developed by Hagen Reddmann. This mode
/// works as cmCBCx, cmCFBx, cmCFB8 but with double XOR'ing of the
/// inputstream into feedback register.
/// </summary>
procedure DecodeCTSx(Source, Dest: PByteArray; Size: Integer); virtual;
{$IFDEF DEC3_CMCTS}
/// <summary>
/// double CBC
/// This is a proprietary mode developed by Frederik Winkelsdorf. It
/// replaces the CFS8 padding of the truncated final block with a CFSx padding.
/// Useful when converting projects that previously used the old DEC v3.0. It
/// has the same restrictions for external padding and chunk processing as
/// cmCTSx has. It has a less secure padding of the truncated final block.
/// (to enable it see DECOptions.inc)
/// </summary>
/// <remarks>
/// For DEC 3.0 compatibility only
/// </remarks>
procedure DecodeCTS3(Source, Dest: PByteArray; Size: Integer); virtual;
{$ENDIF}
public
/// <summary>
/// Encrypts a given block of data
/// </summary>
/// <param name="Source">
/// Data to be encrypted
/// </param>
/// <param name="Dest">
/// Data after encryption
/// </param>
/// <param name="DataSize">
/// Size of the data the Source parameter points to in byte
/// </param>
procedure Encode(const Source; var Dest; DataSize: Integer);
/// <summary>
/// Decrypts a given block of data
/// </summary>
/// <param name="Source">
/// Data to be Decrypted
/// </param>
/// <param name="Dest">
/// Data after decryption
/// </param>
/// <param name="DataSize">
/// Size of the data the Source parameter points to in byte
/// </param>
procedure Decode(const Source; var Dest; DataSize: Integer);
end;
implementation
uses
{$IFDEF FPC}
TypInfo,
{$ELSE}
System.TypInfo,
{$ENDIF}
DECUtil;
resourcestring
sInvalidMessageLength = 'Message length for mode %0:s must be a multiple of %1:d bytes';
procedure TDECCipherModes.ReportInvalidMessageLength(Cipher: TDECCipher);
begin
raise EDECCipherException.CreateResFmt(@sInvalidMessageLength,
[System.TypInfo.GetEnumName(TypeInfo(TCipherMode),
Integer(Cipher.Mode)),
Cipher.Context.BlockSize]);
end;
procedure TDECCipherModes.Encode(const Source; var Dest; DataSize: Integer);
begin
CheckState([csInitialized, csEncode, csDone]);
case FMode of
cmECBx: EncodeECBx(@Source, @Dest, DataSize);
cmCBCx: EncodeCBCx(@Source, @Dest, DataSize);
cmCTSx: EncodeCTSx(@Source, @Dest, DataSize);
{$IFDEF DEC3_CMCTS}
cmCTS3: EncodeCTS3(@Source, @Dest, DataSize);
{$ENDIF DEC3_CMCTS}
cmCFB8: EncodeCFB8(@Source, @Dest, DataSize);
cmCFBx: EncodeCFBx(@Source, @Dest, DataSize);
cmOFB8: EncodeOFB8(@Source, @Dest, DataSize);
cmOFBx: EncodeOFBx(@Source, @Dest, DataSize);
cmCFS8: EncodeCFS8(@Source, @Dest, DataSize);
cmCFSx: EncodeCFSx(@Source, @Dest, DataSize);
end;
end;
procedure TDECCipherModes.EncodeECBx(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
if Context.BlockSize = 1 then
begin
DoEncode(Source, Dest, Size);
FState := csEncode;
end
else
begin
Dec(Size, FBufferSize);
I := 0;
while I <= Size do
begin
DoEncode(@Source[I], @Dest[I], FBufferSize);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
if Size mod Context.BlockSize = 0 then
begin
DoEncode(@Source[I], @Dest[I], Size);
FState := csEncode;
end
else
begin
FState := csPadded;
ReportInvalidMessageLength(Self);
end;
end;
end;
end;
procedure TDECCipherModes.EncodeOFB8(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
FFeedback[FBufferSize - 1] := FBuffer[0];
Dest[I] := Source[I] xor FBuffer[0];
Inc(I);
end;
FState := csEncode;
end;
procedure TDECCipherModes.EncodeCFB8(Source, Dest: PByteArray; Size: Integer);
// CFB-8
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
Dest[I] := Source[I] xor FBuffer[0];
FFeedback[FBufferSize - 1] := Dest[I];
Inc(I);
end;
FState := csEncode;
end;
procedure TDECCipherModes.EncodeCFS8(Source, Dest: PByteArray; Size: Integer);
// CFS-8, CTS as CFB
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Dest[I] := Source[I] xor FBuffer[0];
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
FFeedback[FBufferSize - 1] := FFeedback[FBufferSize - 1] xor Dest[I];
Inc(I);
end;
FState := csEncode;
end;
procedure TDECCipherModes.EncodeCFBx(Source, Dest: PByteArray; Size: Integer);
// CFB-BlockSize
var
I: Integer;
F: PByteArray;
begin
FState := csEncode;
if FBufferIndex > 0 then
begin
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
XORBuffers(Source[0], FBuffer[FBufferIndex], I, Dest[0]);
Move(Dest[0], FFeedback[FBufferIndex], I);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
Dec(Size, FBufferSize);
F := FFeedback;
I := 0;
while I < Size do
begin
DoEncode(F, FBuffer, FBufferSize);
XORBuffers(Source[I], FBuffer[0], FBufferSize, Dest[I]);
F := @Dest[I];
Inc(I, FBufferSize);
end;
if F <> FFeedback then
Move(F^, FFeedback^, FBufferSize);
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
XORBuffers(Source[I], FBuffer[0], Size, Dest[I]);
Move(Dest[I], FFeedback[0], Size);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.EncodeOFBx(Source, Dest: PByteArray; Size: Integer);
// OFB-BlockSize
var
I: Integer;
begin
FState := csEncode;
if FBufferIndex > 0 then
begin
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
XORBuffers(Source[0], FFeedback[FBufferIndex], I, Dest[0]);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
Dec(Size, FBufferSize);
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FFeedback, FBufferSize);
XORBuffers(Source[I], FFeedback[0], FBufferSize, Dest[I]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DoEncode(FFeedback, FFeedback, FBufferSize);
XORBuffers(Source[I], FFeedback[0], Size, Dest[I]);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.EncodeCFSx(Source, Dest: PByteArray; Size: Integer);
// CFS-BlockSize
var
I: Integer;
begin
FState := csEncode;
if FBufferIndex > 0 then
begin
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
XORBuffers(Source[0], FBuffer[FBufferIndex], I, Dest[0]);
XORBuffers(Dest[0], FFeedback[FBufferIndex], I, FFeedback[FBufferIndex]);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
Dec(Size, FBufferSize);
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
XORBuffers(Source[I], FBuffer[0], FBufferSize, Dest[I]);
XORBuffers(Dest[I], FFeedback[0], FBufferSize, FFeedback[0]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
XORBuffers(Source[I], FBuffer[0], Size, Dest[I]);
XORBuffers(Dest[I], FFeedback[0], Size, FFeedback[0]);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.EncodeCBCx(Source, Dest: PByteArray; Size: Integer);
var
F: PByteArray;
I: Integer;
begin
Dec(Size, FBufferSize);
F := FFeedback;
I := 0;
while I <= Size do
begin
XORBuffers(Source[I], F[0], FBufferSize, Dest[I]);
F := @Dest[I];
DoEncode(F, F, FBufferSize);
Inc(I, FBufferSize);
end;
if F <> FFeedback then
Move(F[0], FFeedback[0], FBufferSize);
Dec(Size, I - FBufferSize);
if Size > 0 then
begin // padding
EncodeCFB8(@Source[I], @Dest[I], Size);
FState := csPadded;
end
else
FState := csEncode;
end;
procedure TDECCipherModes.EncodeCTSx(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
Dec(Size, FBufferSize);
I := 0;
while I <= Size do
begin
XORBuffers(Source[I], FFeedback[0], FBufferSize, Dest[I]);
DoEncode(@Dest[I], @Dest[I], FBufferSize);
XORBuffers(Dest[I], FFeedback[0], FBufferSize, FFeedback[0]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin // padding
EncodeCFS8(@Source[I], @Dest[I], Size);
FState := csPadded;
end
else
FState := csEncode;
end;
{$IFDEF DEC3_CMCTS}
procedure TDECCipherModes.EncodeCTS3(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
Dec(Size, FBufferSize);
I := 0;
while I <= Size do
begin
XORBuffers(Source[I], FFeedback[0], FBufferSize, Dest[I]);
DoEncode(@Dest[I], @Dest[I], FBufferSize);
XORBuffers(Dest[I], FFeedback[0], FBufferSize, FFeedback[0]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin // padding
EncodeCFSx(@Source[I], @Dest[I], Size); // use the padding implemented in CFSx
FState := csPadded;
end
else
FState := csEncode;
end;
{$ENDIF DEC3_CMCTS}
procedure TDECCipherModes.Decode(const Source; var Dest; DataSize: Integer);
begin
CheckState([csInitialized, csDecode, csDone]);
case FMode of
cmECBx: DecodeECBx(@Source, @Dest, DataSize);
cmCBCx: DecodeCBCx(@Source, @Dest, DataSize);
cmCTSx: DecodeCTSx(@Source, @Dest, DataSize);
{$IFDEF DEC3_CMCTS}
cmCTS3: DecodeCTS3(@Source, @Dest, DataSize);
{$ENDIF DEC3_CMCTS}
cmCFB8: DecodeCFB8(@Source, @Dest, DataSize);
cmCFBx: DecodeCFBx(@Source, @Dest, DataSize);
cmOFB8: DecodeOFB8(@Source, @Dest, DataSize);
cmOFBx: DecodeOFBx(@Source, @Dest, DataSize);
cmCFS8: DecodeCFS8(@Source, @Dest, DataSize);
cmCFSx: DecodeCFSx(@Source, @Dest, DataSize);
end;
end;
procedure TDECCipherModes.DecodeECBx(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
if Context.BlockSize = 1 then
begin
DoDecode(Source, Dest, Size);
FState := csDecode;
end
else
begin
Dec(Size, FBufferSize);
I := 0;
while I <= Size do
begin
DoDecode(@Source[I], @Dest[I], FBufferSize);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
if Size mod Context.BlockSize = 0 then
begin
DoDecode(@Source[I], @Dest[I], Size);
FState := csDecode;
end
else
begin
FState := csPadded;
ReportInvalidMessageLength(Self);
end;
end;
end;
end;
procedure TDECCipherModes.DecodeCFB8(Source, Dest: PByteArray; Size: Integer);
// CFB-8
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
FFeedback[FBufferSize - 1] := Source[I];
Dest[I] := Source[I] xor FBuffer[0];
Inc(I);
end;
FState := csDecode;
end;
procedure TDECCipherModes.DecodeOFB8(Source, Dest: PByteArray; Size: Integer);
// same as EncodeOFB
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
FFeedback[FBufferSize - 1] := FBuffer[0];
Dest[I] := Source[I] xor FBuffer[0];
Inc(I);
end;
FState := csDecode;
end;
procedure TDECCipherModes.DecodeCFS8(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
begin
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(FFeedback[1], FFeedback[0], FBufferSize - 1);
FFeedback[FBufferSize - 1] := FFeedback[FBufferSize - 1] xor Source[I];
Dest[I] := Source[I] xor FBuffer[0];
Inc(I);
end;
FState := csDecode;
end;
procedure TDECCipherModes.DecodeCFBx(Source, Dest: PByteArray; Size: Integer);
// CFB-BlockSize
var
I: Integer;
F: PByteArray;
begin
FState := csDecode;
if FBufferIndex > 0 then
begin // remaining bytes of last decode
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
Move(Source[0], FFeedback[FBufferIndex], I);
XORBuffers(Source[0], FBuffer[FBufferIndex], I, Dest[0]);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
// process chunks of FBufferSize bytes
Dec(Size, FBufferSize);
I := 0;
if Source <> Dest then
begin
F := FFeedback;
while I < Size do
begin
DoEncode(F, FBuffer, FBufferSize);
XORBuffers(Source[I], FBuffer[0], FBufferSize, Dest[I]);
F := @Source[I];
Inc(I, FBufferSize);
end;
if F <> FFeedback then
Move(F^, FFeedback^, FBufferSize);
end
else
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(Source[I], FFeedback[0], FBufferSize);
XORBuffers(Source[I], FBuffer[0], FBufferSize, Dest[I]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin // remaining bytes
DoEncode(FFeedback, FBuffer, FBufferSize);
Move(Source[I], FFeedback[0], Size);
XORBuffers(Source[I], FBuffer[0], Size, Dest[I]);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.DecodeOFBx(Source, Dest: PByteArray; Size: Integer);
// OFB-BlockSize, same as EncodeOFBx
var
I: Integer;
begin
FState := csDecode;
if FBufferIndex > 0 then
begin
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
XORBuffers(Source[0], FFeedback[FBufferIndex], I, Dest[0]);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
Dec(Size, FBufferSize);
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FFeedback, FBufferSize);
XORBuffers(Source[I], FFeedback[0], FBufferSize, Dest[I]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DoEncode(FFeedback, FFeedback, FBufferSize);
XORBuffers(Source[I], FFeedback[0], Size, Dest[I]);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.DecodeCFSx(Source, Dest: PByteArray; Size: Integer);
// CFS-BlockSize
var
I: Integer;
begin
FState := csDecode;
if FBufferIndex > 0 then
begin // remaining bytes of last decode
I := FBufferSize - FBufferIndex;
if I > Size then
I := Size;
XORBuffers(Source[0], FFeedback[FBufferIndex], I, FFeedback[FBufferIndex]);
XORBuffers(Source[0], FBuffer[FBufferIndex], I, Dest[0]);
Inc(FBufferIndex, I);
if FBufferIndex < FBufferSize then
Exit;
Dec(Size, I);
Source := @Source[I];
Dest := @Dest[I];
FBufferIndex := 0
end;
// process chunks of FBufferSize bytes
Dec(Size, FBufferSize);
I := 0;
while I < Size do
begin
DoEncode(FFeedback, FBuffer, FBufferSize);
XORBuffers(Source[I], FFeedback[0], FBufferSize, FFeedback[0]);
XORBuffers(Source[I], FBuffer[0], FBufferSize, Dest[I]);
Inc(I, FBufferSize);
end;
Dec(Size, I - FBufferSize);
if Size > 0 then
begin // remaining bytes
DoEncode(FFeedback, FBuffer, FBufferSize);
XORBuffers(Source[I], FFeedback[0], Size, FFeedback[0]);
XORBuffers(Source[I], FBuffer[0], Size, Dest[I]);
FBufferIndex := Size;
end;
end;
procedure TDECCipherModes.DecodeCBCx(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
F, B, T: PByteArray;
begin
Dec(Size, FBufferSize);
F := FFeedback;
I := 0;
if Source = Dest then
begin
B := FBuffer;
while I <= Size do
begin
Move(Source[I], B[0], FBufferSize);
DoDecode(@Source[I], @Source[I], FBufferSize);
XORBuffers(Source[I], F[0], FBufferSize, Source[I]);
T := F;
F := B;
B := T;
Inc(I, FBufferSize);
end;
end
else
begin
while I <= Size do
begin
DoDecode(@Source[I], @Dest[I], FBufferSize);
XORBuffers(F[0], Dest[I], FBufferSize, Dest[I]);
F := @Source[I];
Inc(I, FBufferSize);
end;
end;
if F <> FFeedback then
Move(F[0], FFeedback[0], FBufferSize);
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DecodeCFB8(@Source[I], @Dest[I], Size);
FState := csPadded;
end
else
FState := csDecode;
end;
procedure TDECCipherModes.DecodeCTSx(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
F, B, T: PByteArray;
begin
Dec(Size, FBufferSize);
F := FFeedback;
B := FBuffer;
I := 0;
while I <= Size do
begin
XORBuffers(Source[I], F[0], FBufferSize, B[0]);
DoDecode(@Source[I], @Dest[I], FBufferSize);
XORBuffers(Dest[I], F[0], FBufferSize, Dest[I]);
T := B;
B := F;
F := T;
Inc(I, FBufferSize);
end;
if F <> FFeedback then
Move(F[0], FFeedback[0], FBufferSize);
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DecodeCFS8(@Source[I], @Dest[I], Size);
FState := csPadded;
end
else
FState := csDecode;
end;
{$IFDEF DEC3_CMCTS}
procedure DecodeCTS3(Source, Dest: PByteArray; Size: Integer);
var
I: Integer;
F, B, T: PByteArray;
begin
Dec(Size, FBufferSize);
F := FFeedback;
B := FBuffer;
I := 0;
while I <= Size do
begin
XORBuffers(Source[I], F[0], FBufferSize, B[0]);
DoDecode(@Source[I], @Dest[I], FBufferSize);
XORBuffers(Dest[I], F[0], FBufferSize, Dest[I]);
T := B;
B := F;
F := T;
Inc(I, FBufferSize);
end;
if F <> FFeedback then
Move(F[0], FFeedback[0], FBufferSize);
Dec(Size, I - FBufferSize);
if Size > 0 then
begin
DecodeCFSx(@Source[I], @Dest[I], Size); // use the padding implemented in CFSx
FState := csPadded;
end
else
FState := csDecode;
end;
{$ENDIF DEC3_CMCTS}
end.

6612
contrib/DelphiEncryptionCompendium/Source/DECCiphers.pas Normal file
View File

File diff suppressed because it is too large Load Diff

167
contrib/DelphiEncryptionCompendium/Source/DECData.pas Normal file
View File

@@ -0,0 +1,167 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Data Arrays for the Hash and Cipher functions
/// </summary>
unit DECData;
interface
{$INCLUDE DECOptions.inc}
{$IFOPT Q+}{$DEFINE RESTORE_OVERFLOWCHECKS}{$Q-}{$ENDIF}
{$IFOPT R+}{$DEFINE RESTORE_RANGECHECKS}{$R-}{$ENDIF}
const
Square_TE: array[0..3, 0..255] of UInt32 = (
($26B1B197,$A7CECE69,$B0C3C373,$4A9595DF,$EE5A5AB4,$02ADADAF,$DCE7E73B,$06020204,
$D74D4D9A,$CC444488,$F8FBFB03,$469191D7,$140C0C18,$7C8787FB,$16A1A1B7,$F05050A0,
$A8CBCB63,$A96767CE,$FC5454A8,$92DDDD4F,$CA46468C,$648F8FEB,$D6E1E137,$D24E4E9C,
$E5F0F015,$F2FDFD0F,$F1FCFC0D,$C8EBEB23,$FEF9F907,$B9C4C47D,$2E1A1A34,$B26E6EDC,
$E25E5EBC,$EAF5F51F,$A1CCCC6D,$628D8DEF,$241C1C38,$FA5656AC,$C5434386,$F7FEFE09,
$0907070E,$A36161C2,$FDF8F805,$9F7575EA,$EB5959B2,$F4FFFF0B,$05030306,$66222244,
$6B8A8AE1,$86D1D157,$35131326,$C7EEEE29,$6D8888E5,$00000000,$120E0E1C,$5C343468,
$3F15152A,$758080F5,$499494DD,$D0E3E333,$C2EDED2F,$2AB5B59F,$F55353A6,$65232346,
$DD4B4B96,$C947478E,$3917172E,$1CA7A7BB,$459090D5,$5F35356A,$08ABABA3,$9DD8D845,
$3DB8B885,$94DFDF4B,$D14F4F9E,$F95757AE,$5B9A9AC1,$439292D1,$98DBDB43,$2D1B1B36,
$443C3C78,$ADC8C865,$5E9999C7,$0C040408,$678E8EE9,$D5E0E035,$8CD7D75B,$877D7DFA,
$7A8585FF,$38BBBB83,$C0404080,$742C2C58,$4E3A3A74,$CF45458A,$E6F1F117,$C6424284,
$AF6565CA,$60202040,$C3414182,$28181830,$967272E4,$6F25254A,$409393D3,$907070E0,
$5A36366C,$0F05050A,$E3F2F211,$1D0B0B16,$10A3A3B3,$8B7979F2,$C1ECEC2D,$18080810,
$6927274E,$53313162,$56323264,$2FB6B699,$847C7CF8,$25B0B095,$1E0A0A14,$957373E6,
$ED5B5BB6,$8D7B7BF6,$2CB7B79B,$768181F7,$83D2D251,$170D0D1A,$BE6A6AD4,$6A26264C,
$579E9EC9,$E85858B0,$519C9CCD,$708383F3,$9C7474E8,$20B3B393,$01ACACAD,$50303060,
$8E7A7AF4,$BB6969D2,$997777EE,$110F0F1E,$07AEAEA9,$63212142,$97DEDE49,$85D0D055,
$722E2E5C,$4C9797DB,$30101020,$19A4A4BD,$5D9898C5,$0DA8A8A5,$89D4D45D,$B86868D0,
$772D2D5A,$A66262C4,$7B292952,$B76D6DDA,$3A16162C,$DB494992,$9A7676EC,$BCC7C77B,
$CDE8E825,$B6C1C177,$4F9696D9,$5937376E,$DAE5E53F,$ABCACA61,$E9F4F41D,$CEE9E927,
$A56363C6,$36121224,$B3C2C271,$1FA6A6B9,$3C141428,$31BCBC8D,$80D3D353,$78282850,
$04AFAFAB,$712F2F5E,$DFE6E639,$6C242448,$F65252A4,$BFC6C679,$15A0A0B5,$1B090912,
$32BDBD8F,$618C8CED,$A4CFCF6B,$E75D5DBA,$33111122,$E15F5FBE,$03010102,$BAC5C57F,
$549F9FCB,$473D3D7A,$13A2A2B1,$589B9BC3,$AEC9C967,$4D3B3B76,$37BEBE89,$F35151A2,
$2B191932,$211F1F3E,$413F3F7E,$E45C5CB8,$23B2B291,$C4EFEF2B,$DE4A4A94,$A2CDCD6F,
$34BFBF8B,$3BBABA81,$B16F6FDE,$AC6464C8,$9ED9D947,$E0F3F313,$423E3E7C,$29B4B49D,
$0BAAAAA1,$91DCDC4D,$8AD5D55F,$0A06060C,$B5C0C075,$827E7EFC,$EFF6F619,$AA6666CC,
$B46C6CD8,$798484FD,$937171E2,$48383870,$3EB9B987,$271D1D3A,$817F7FFE,$529D9DCF,
$D8484890,$688B8BE3,$7E2A2A54,$9BDADA41,$1AA5A5BF,$55333366,$738282F1,$4B393972,
$8FD6D659,$887878F0,$7F8686F9,$FBFAFA01,$D9E4E43D,$7D2B2B56,$0EA9A9A7,$221E1E3C,
$6E8989E7,$A06060C0,$BD6B6BD6,$CBEAEA21,$FF5555AA,$D44C4C98,$ECF7F71B,$D3E2E231),
($B1B19726,$CECE69A7,$C3C373B0,$9595DF4A,$5A5AB4EE,$ADADAF02,$E7E73BDC,$02020406,
$4D4D9AD7,$444488CC,$FBFB03F8,$9191D746,$0C0C1814,$8787FB7C,$A1A1B716,$5050A0F0,
$CBCB63A8,$6767CEA9,$5454A8FC,$DDDD4F92,$46468CCA,$8F8FEB64,$E1E137D6,$4E4E9CD2,
$F0F015E5,$FDFD0FF2,$FCFC0DF1,$EBEB23C8,$F9F907FE,$C4C47DB9,$1A1A342E,$6E6EDCB2,
$5E5EBCE2,$F5F51FEA,$CCCC6DA1,$8D8DEF62,$1C1C3824,$5656ACFA,$434386C5,$FEFE09F7,
$07070E09,$6161C2A3,$F8F805FD,$7575EA9F,$5959B2EB,$FFFF0BF4,$03030605,$22224466,
$8A8AE16B,$D1D15786,$13132635,$EEEE29C7,$8888E56D,$00000000,$0E0E1C12,$3434685C,
$15152A3F,$8080F575,$9494DD49,$E3E333D0,$EDED2FC2,$B5B59F2A,$5353A6F5,$23234665,
$4B4B96DD,$47478EC9,$17172E39,$A7A7BB1C,$9090D545,$35356A5F,$ABABA308,$D8D8459D,
$B8B8853D,$DFDF4B94,$4F4F9ED1,$5757AEF9,$9A9AC15B,$9292D143,$DBDB4398,$1B1B362D,
$3C3C7844,$C8C865AD,$9999C75E,$0404080C,$8E8EE967,$E0E035D5,$D7D75B8C,$7D7DFA87,
$8585FF7A,$BBBB8338,$404080C0,$2C2C5874,$3A3A744E,$45458ACF,$F1F117E6,$424284C6,
$6565CAAF,$20204060,$414182C3,$18183028,$7272E496,$25254A6F,$9393D340,$7070E090,
$36366C5A,$05050A0F,$F2F211E3,$0B0B161D,$A3A3B310,$7979F28B,$ECEC2DC1,$08081018,
$27274E69,$31316253,$32326456,$B6B6992F,$7C7CF884,$B0B09525,$0A0A141E,$7373E695,
$5B5BB6ED,$7B7BF68D,$B7B79B2C,$8181F776,$D2D25183,$0D0D1A17,$6A6AD4BE,$26264C6A,
$9E9EC957,$5858B0E8,$9C9CCD51,$8383F370,$7474E89C,$B3B39320,$ACACAD01,$30306050,
$7A7AF48E,$6969D2BB,$7777EE99,$0F0F1E11,$AEAEA907,$21214263,$DEDE4997,$D0D05585,
$2E2E5C72,$9797DB4C,$10102030,$A4A4BD19,$9898C55D,$A8A8A50D,$D4D45D89,$6868D0B8,
$2D2D5A77,$6262C4A6,$2929527B,$6D6DDAB7,$16162C3A,$494992DB,$7676EC9A,$C7C77BBC,
$E8E825CD,$C1C177B6,$9696D94F,$37376E59,$E5E53FDA,$CACA61AB,$F4F41DE9,$E9E927CE,
$6363C6A5,$12122436,$C2C271B3,$A6A6B91F,$1414283C,$BCBC8D31,$D3D35380,$28285078,
$AFAFAB04,$2F2F5E71,$E6E639DF,$2424486C,$5252A4F6,$C6C679BF,$A0A0B515,$0909121B,
$BDBD8F32,$8C8CED61,$CFCF6BA4,$5D5DBAE7,$11112233,$5F5FBEE1,$01010203,$C5C57FBA,
$9F9FCB54,$3D3D7A47,$A2A2B113,$9B9BC358,$C9C967AE,$3B3B764D,$BEBE8937,$5151A2F3,
$1919322B,$1F1F3E21,$3F3F7E41,$5C5CB8E4,$B2B29123,$EFEF2BC4,$4A4A94DE,$CDCD6FA2,
$BFBF8B34,$BABA813B,$6F6FDEB1,$6464C8AC,$D9D9479E,$F3F313E0,$3E3E7C42,$B4B49D29,
$AAAAA10B,$DCDC4D91,$D5D55F8A,$06060C0A,$C0C075B5,$7E7EFC82,$F6F619EF,$6666CCAA,
$6C6CD8B4,$8484FD79,$7171E293,$38387048,$B9B9873E,$1D1D3A27,$7F7FFE81,$9D9DCF52,
$484890D8,$8B8BE368,$2A2A547E,$DADA419B,$A5A5BF1A,$33336655,$8282F173,$3939724B,
$D6D6598F,$7878F088,$8686F97F,$FAFA01FB,$E4E43DD9,$2B2B567D,$A9A9A70E,$1E1E3C22,
$8989E76E,$6060C0A0,$6B6BD6BD,$EAEA21CB,$5555AAFF,$4C4C98D4,$F7F71BEC,$E2E231D3),
($B19726B1,$CE69A7CE,$C373B0C3,$95DF4A95,$5AB4EE5A,$ADAF02AD,$E73BDCE7,$02040602,
$4D9AD74D,$4488CC44,$FB03F8FB,$91D74691,$0C18140C,$87FB7C87,$A1B716A1,$50A0F050,
$CB63A8CB,$67CEA967,$54A8FC54,$DD4F92DD,$468CCA46,$8FEB648F,$E137D6E1,$4E9CD24E,
$F015E5F0,$FD0FF2FD,$FC0DF1FC,$EB23C8EB,$F907FEF9,$C47DB9C4,$1A342E1A,$6EDCB26E,
$5EBCE25E,$F51FEAF5,$CC6DA1CC,$8DEF628D,$1C38241C,$56ACFA56,$4386C543,$FE09F7FE,
$070E0907,$61C2A361,$F805FDF8,$75EA9F75,$59B2EB59,$FF0BF4FF,$03060503,$22446622,
$8AE16B8A,$D15786D1,$13263513,$EE29C7EE,$88E56D88,$00000000,$0E1C120E,$34685C34,
$152A3F15,$80F57580,$94DD4994,$E333D0E3,$ED2FC2ED,$B59F2AB5,$53A6F553,$23466523,
$4B96DD4B,$478EC947,$172E3917,$A7BB1CA7,$90D54590,$356A5F35,$ABA308AB,$D8459DD8,
$B8853DB8,$DF4B94DF,$4F9ED14F,$57AEF957,$9AC15B9A,$92D14392,$DB4398DB,$1B362D1B,
$3C78443C,$C865ADC8,$99C75E99,$04080C04,$8EE9678E,$E035D5E0,$D75B8CD7,$7DFA877D,
$85FF7A85,$BB8338BB,$4080C040,$2C58742C,$3A744E3A,$458ACF45,$F117E6F1,$4284C642,
$65CAAF65,$20406020,$4182C341,$18302818,$72E49672,$254A6F25,$93D34093,$70E09070,
$366C5A36,$050A0F05,$F211E3F2,$0B161D0B,$A3B310A3,$79F28B79,$EC2DC1EC,$08101808,
$274E6927,$31625331,$32645632,$B6992FB6,$7CF8847C,$B09525B0,$0A141E0A,$73E69573,
$5BB6ED5B,$7BF68D7B,$B79B2CB7,$81F77681,$D25183D2,$0D1A170D,$6AD4BE6A,$264C6A26,
$9EC9579E,$58B0E858,$9CCD519C,$83F37083,$74E89C74,$B39320B3,$ACAD01AC,$30605030,
$7AF48E7A,$69D2BB69,$77EE9977,$0F1E110F,$AEA907AE,$21426321,$DE4997DE,$D05585D0,
$2E5C722E,$97DB4C97,$10203010,$A4BD19A4,$98C55D98,$A8A50DA8,$D45D89D4,$68D0B868,
$2D5A772D,$62C4A662,$29527B29,$6DDAB76D,$162C3A16,$4992DB49,$76EC9A76,$C77BBCC7,
$E825CDE8,$C177B6C1,$96D94F96,$376E5937,$E53FDAE5,$CA61ABCA,$F41DE9F4,$E927CEE9,
$63C6A563,$12243612,$C271B3C2,$A6B91FA6,$14283C14,$BC8D31BC,$D35380D3,$28507828,
$AFAB04AF,$2F5E712F,$E639DFE6,$24486C24,$52A4F652,$C679BFC6,$A0B515A0,$09121B09,
$BD8F32BD,$8CED618C,$CF6BA4CF,$5DBAE75D,$11223311,$5FBEE15F,$01020301,$C57FBAC5,
$9FCB549F,$3D7A473D,$A2B113A2,$9BC3589B,$C967AEC9,$3B764D3B,$BE8937BE,$51A2F351,
$19322B19,$1F3E211F,$3F7E413F,$5CB8E45C,$B29123B2,$EF2BC4EF,$4A94DE4A,$CD6FA2CD,
$BF8B34BF,$BA813BBA,$6FDEB16F,$64C8AC64,$D9479ED9,$F313E0F3,$3E7C423E,$B49D29B4,
$AAA10BAA,$DC4D91DC,$D55F8AD5,$060C0A06,$C075B5C0,$7EFC827E,$F619EFF6,$66CCAA66,
$6CD8B46C,$84FD7984,$71E29371,$38704838,$B9873EB9,$1D3A271D,$7FFE817F,$9DCF529D,
$4890D848,$8BE3688B,$2A547E2A,$DA419BDA,$A5BF1AA5,$33665533,$82F17382,$39724B39,
$D6598FD6,$78F08878,$86F97F86,$FA01FBFA,$E43DD9E4,$2B567D2B,$A9A70EA9,$1E3C221E,
$89E76E89,$60C0A060,$6BD6BD6B,$EA21CBEA,$55AAFF55,$4C98D44C,$F71BECF7,$E231D3E2),
($9726B1B1,$69A7CECE,$73B0C3C3,$DF4A9595,$B4EE5A5A,$AF02ADAD,$3BDCE7E7,$04060202,
$9AD74D4D,$88CC4444,$03F8FBFB,$D7469191,$18140C0C,$FB7C8787,$B716A1A1,$A0F05050,
$63A8CBCB,$CEA96767,$A8FC5454,$4F92DDDD,$8CCA4646,$EB648F8F,$37D6E1E1,$9CD24E4E,
$15E5F0F0,$0FF2FDFD,$0DF1FCFC,$23C8EBEB,$07FEF9F9,$7DB9C4C4,$342E1A1A,$DCB26E6E,
$BCE25E5E,$1FEAF5F5,$6DA1CCCC,$EF628D8D,$38241C1C,$ACFA5656,$86C54343,$09F7FEFE,
$0E090707,$C2A36161,$05FDF8F8,$EA9F7575,$B2EB5959,$0BF4FFFF,$06050303,$44662222,
$E16B8A8A,$5786D1D1,$26351313,$29C7EEEE,$E56D8888,$00000000,$1C120E0E,$685C3434,
$2A3F1515,$F5758080,$DD499494,$33D0E3E3,$2FC2EDED,$9F2AB5B5,$A6F55353,$46652323,
$96DD4B4B,$8EC94747,$2E391717,$BB1CA7A7,$D5459090,$6A5F3535,$A308ABAB,$459DD8D8,
$853DB8B8,$4B94DFDF,$9ED14F4F,$AEF95757,$C15B9A9A,$D1439292,$4398DBDB,$362D1B1B,
$78443C3C,$65ADC8C8,$C75E9999,$080C0404,$E9678E8E,$35D5E0E0,$5B8CD7D7,$FA877D7D,
$FF7A8585,$8338BBBB,$80C04040,$58742C2C,$744E3A3A,$8ACF4545,$17E6F1F1,$84C64242,
$CAAF6565,$40602020,$82C34141,$30281818,$E4967272,$4A6F2525,$D3409393,$E0907070,
$6C5A3636,$0A0F0505,$11E3F2F2,$161D0B0B,$B310A3A3,$F28B7979,$2DC1ECEC,$10180808,
$4E692727,$62533131,$64563232,$992FB6B6,$F8847C7C,$9525B0B0,$141E0A0A,$E6957373,
$B6ED5B5B,$F68D7B7B,$9B2CB7B7,$F7768181,$5183D2D2,$1A170D0D,$D4BE6A6A,$4C6A2626,
$C9579E9E,$B0E85858,$CD519C9C,$F3708383,$E89C7474,$9320B3B3,$AD01ACAC,$60503030,
$F48E7A7A,$D2BB6969,$EE997777,$1E110F0F,$A907AEAE,$42632121,$4997DEDE,$5585D0D0,
$5C722E2E,$DB4C9797,$20301010,$BD19A4A4,$C55D9898,$A50DA8A8,$5D89D4D4,$D0B86868,
$5A772D2D,$C4A66262,$527B2929,$DAB76D6D,$2C3A1616,$92DB4949,$EC9A7676,$7BBCC7C7,
$25CDE8E8,$77B6C1C1,$D94F9696,$6E593737,$3FDAE5E5,$61ABCACA,$1DE9F4F4,$27CEE9E9,
$C6A56363,$24361212,$71B3C2C2,$B91FA6A6,$283C1414,$8D31BCBC,$5380D3D3,$50782828,
$AB04AFAF,$5E712F2F,$39DFE6E6,$486C2424,$A4F65252,$79BFC6C6,$B515A0A0,$121B0909,
$8F32BDBD,$ED618C8C,$6BA4CFCF,$BAE75D5D,$22331111,$BEE15F5F,$02030101,$7FBAC5C5,
$CB549F9F,$7A473D3D,$B113A2A2,$C3589B9B,$67AEC9C9,$764D3B3B,$8937BEBE,$A2F35151,
$322B1919,$3E211F1F,$7E413F3F,$B8E45C5C,$9123B2B2,$2BC4EFEF,$94DE4A4A,$6FA2CDCD,
$8B34BFBF,$813BBABA,$DEB16F6F,$C8AC6464,$479ED9D9,$13E0F3F3,$7C423E3E,$9D29B4B4,
$A10BAAAA,$4D91DCDC,$5F8AD5D5,$0C0A0606,$75B5C0C0,$FC827E7E,$19EFF6F6,$CCAA6666,
$D8B46C6C,$FD798484,$E2937171,$70483838,$873EB9B9,$3A271D1D,$FE817F7F,$CF529D9D,
$90D84848,$E3688B8B,$547E2A2A,$419BDADA,$BF1AA5A5,$66553333,$F1738282,$724B3939,
$598FD6D6,$F0887878,$F97F8686,$01FBFAFA,$3DD9E4E4,$567D2B2B,$A70EA9A9,$3C221E1E,
$E76E8989,$C0A06060,$D6BD6B6B,$21CBEAEA,$AAFF5555,$98D44C4C,$1BECF7F7,$31D3E2E2)
);
{$IFDEF RESTORE_RANGECHECKS}{$R+}{$ENDIF}
{$IFDEF RESTORE_OVERFLOWCHECKS}{$Q+}{$ENDIF}
implementation
end.

3944
contrib/DelphiEncryptionCompendium/Source/DECDataCipher.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2659
contrib/DelphiEncryptionCompendium/Source/DECDataHash.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1890
contrib/DelphiEncryptionCompendium/Source/DECFormat.pas Normal file
View File

File diff suppressed because it is too large Load Diff

637
contrib/DelphiEncryptionCompendium/Source/DECFormatBase.pas Normal file
View File

@@ -0,0 +1,637 @@
{ *****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
***************************************************************************** }
/// <summary>
/// Contains the base class for all the formatting classes
/// </summary>
unit DECFormatBase;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
DECBaseClass, DECUtil;
type
/// <summary>
/// Class reference type of the TDECFormat base class. This is used for
/// passing formatting classes as parameters or returning those. This is
/// especially useful for the formatting classes, as they only contain
/// class functions.
/// </summary>
TDECFormatClass = class of TDECFormat;
/// <summary>
/// copy input to output (default format)
/// </summary>
TFormat_Copy = class;
/// <summary>
/// Basis for all formatting classes. Not to be instantiated directly.
/// </summary>
TDECFormat = class(TDECObject)
protected
/// <summary>
/// Internal method for the actual format conversion. This method needs to
/// be overridden in all the child classes. Converts into the format.
/// </summary>
/// <param name="Source">
/// Data to be converted
/// </param>
/// <param name="Dest">
/// Into this parameter the converted data will be written into.
/// </param>
/// <param name="Size">
/// Number of bytes from source which will get converted.
/// </param>
class procedure DoEncode(const Source; var Dest: TBytes;
Size: Integer); virtual;
/// <summary>
/// Internal method for the actual format conversion. This method needs to
/// be overridden in all the child classes. Converts from the format into
/// the format the data had before encoding it.
/// </summary>
/// <param name="Source">
/// Data to be converted
/// </param>
/// <param name="Dest">
/// Into this parameter the converted data will be written into.
/// </param>
/// <param name="Size">
/// Number of bytes from source which will get converted.
/// </param>
class procedure DoDecode(const Source; var Dest: TBytes;
Size: Integer); virtual;
/// <summary>
/// Internal method for checking whether all bytes of the data to be
/// processed are valid for this particular formatting. This method needs
/// to be overridden in all the child classes.
/// </summary>
/// <param name="Data">
/// Data to be checked
/// </param>
/// <param name="Size">
/// Number of bytes from data which will get checked.
/// </param>
class function DoIsValid(const Data; Size: Integer): Boolean; virtual;
public
/// <summary>
/// List of registered DEC classes. Key is the Identity of the class.
/// </summary>
class var ClassList: TDECClassList;
/// <summary>
/// Tries to find a class type by its name in the list of registered
/// formatting classes
/// </summary>
/// <param name="Name">
/// Name to look for in the list
/// </param>
/// <returns>
/// Returns the class type if found. if it could not be found a
/// EDECClassNotRegisteredException will be thrown
/// </returns>
class function ClassByName(const Name: string): TDECFormatClass;
/// <summary>
/// Tries to find a class type by its numeric identity DEC assigned to it.
/// Useful for file headers, so they can easily encode numerically which
/// cipher class was being used.
/// </summary>
/// <param name="Identity">
/// Identity to look for
/// </param>
/// <returns>
/// Returns the class type of the class with the specified identity value
/// or throws an EDECClassNotRegisteredException exception if no class
/// with the given identity has been found
/// </returns>
class function ClassByIdentity(Identity: Int64): TDECFormatClass;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted into the format of this class as
/// RawByteString. Empty strings are allowed. They will simply lead to
// empty return arrays as well.
/// </param>
/// <returns>
/// Data in the format of this formatting algorithm as RawByteString
/// </returns>
class function Encode(const Data: RawByteString): RawByteString; overload;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted into the format of this class as untyped
/// parameter. Empty data is allowed. It will simply lead to empty return
// values as well.
/// </param>
/// <param name="Size">
/// Size of the data passed via data in bytes.
/// </param>
/// <returns>
/// Data in the format of this formatting algorithm as RawByteString
/// </returns>
class function Encode(const Data; Size: Integer): RawByteString; overload;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted into the format of this class as Byte Array.
/// Empty arrays of size 0 are allowed. They will simply lead to empty return
// arrays as well.
/// </param>
/// <returns>
/// Data in the format of this formatting algorithm as byte array.
/// </returns>
class function Encode(const Data: TBytes): TBytes; overload;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted from the format of this class as byte array
/// into the original byte representation. Empty arrays of size 0 are allowed.
// They will simply lead to empty return arrays as well.
/// </param>
/// <returns>
/// Data in the original byte format it had before getting encoded with
/// this formatting.
/// </returns>
class function Decode(const Data: TBytes): TBytes; overload;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted from the format of this class as
/// RawByteString into the original representation. Empty strings are allowed.
/// They will simply lead to empty return arrays as well.
/// </param>
/// <returns>
/// Data in the format of this formatting algorithm as RawByteString
/// </returns>
class function Decode(const Data: RawByteString): RawByteString; overload;
/// <summary>
/// Calls the internal method which actually does the format conversion.
/// </summary>
/// <param name="Data">
/// Source data to be converted from the format of this class as untyped
/// parameter into the original representation. Empty data is allowed.
/// It will simply lead to empty return values as well.
/// </param>
/// <param name="Size">
/// Size of the data passed via data in bytes.
/// </param>
/// <returns>
/// Data in the format of this formatting algorithm as RawByteString
/// </returns>
class function Decode(const Data; Size: Integer): RawByteString; overload;
/// <summary>
/// Checks whether the data passed to this method only contains chars
/// valid for this specific formatting.
/// </summary>
/// <param name="Data">
/// Untyped parameter with the data to be checked
/// </param>
/// <param name="Size">
/// Size of the data to be checked in bytes
/// </param>
/// <returns>
/// true, if the input data contains only characters valid for this format
/// </returns>
class function IsValid(const Data; Size: Integer): Boolean; overload;
/// <summary>
/// Checks whether the data passed to this method only contains chars
/// valid for this specific formatting.
/// </summary>
/// <param name="Data">
/// Byte array with the data to be checked
/// </param>
/// <returns>
/// true, if the input data contains only characters valid for this format
/// </returns>
class function IsValid(const Data: TBytes): Boolean; overload;
/// <summary>
/// Checks whether the data passed to this method only contains chars
/// valid for this specific formatting.
/// </summary>
/// <param name="Text">
/// RawByteString with the data to be checked
/// </param>
/// <returns>
/// true, if the input data contains only characters valid for this format
/// </returns>
class function IsValid(const Text: RawByteString): Boolean; overload;
/// <summary>
/// Converts the ordinal number of an ASCII char given as byte into the
/// ordinal number of the corresponding upper case ASCII char. Works only
/// on a-z and works like the System.Pas variant just on bytes instead of chars
/// </summary>
/// <param name="b">
/// Ordinal ASCII char value to be converted to upper case
/// </param>
/// <returns>
/// Uppercase ordinal number if the number passed in as parameter belongs to
/// a char in the a-z range. Otherwise the number passed in will be returned.
/// </returns>
class function UpCaseBinary(b: Byte): Byte;
/// <summary>
/// Looks for the index of a given byte in a byte-array.
/// </summary>
/// <param name="Value">
/// Byte value to be searched in the array
/// </param>
/// <param name="Table">
/// Byte-array where the value is searched in
/// </param>
/// <param name="Len">
/// Maximum index until which the search will be performed. If Len is higher
/// than length(Table) the latter will be used as maximum
/// </param>
/// <returns>
/// Index of the first appearance of the searched value. If it cannot be found
/// the result will be -1. The index is 0 based.
/// </returns>
class function TableFindBinary(Value: Byte; Table: TBytes;
Len: Integer): Integer;
end;
/// <summary>
/// Formatting class which doesn't apply any transformation to the data
/// passed in. It simply copies it from Source to Dest.
/// </summary>
TFormat_Copy = class(TDECFormat)
protected
/// <summary>
/// Copies the data contained in Source into Dest without any conversion
/// </summary>
/// <param name="Source">
/// Variable from which Size bytes will be copied to Dest
/// </param>
/// <param name="Dest">
/// Byte-array where Source will be copied into. It will be dimensioned
/// to a length of Size internally.
/// </param>
/// <param name="Size">
/// Number of bytes to copy from Soruce to Dest
/// </param>
class procedure DoEncode(const Source; var Dest: TBytes;
Size: Integer); override;
/// <summary>
/// Copies the data contained in Source into Dest without any conversion
/// </summary>
/// <param name="Source">
/// Variable from which Size bytes will be copied to Dest
/// </param>
/// <param name="Dest">
/// Byte-array where Source will be copied into. It will be dimensioned
/// to a length of Size internally.
/// </param>
/// <param name="Size">
/// Number of bytes to copy from Soruce to Dest
/// </param>
class procedure DoDecode(const Source; var Dest: TBytes;
Size: Integer); override;
/// <summary>
/// Dummy function to check if Source is valid for this particular format
/// </summary>
/// <param name="Data">
/// Data to be checked for validity. In this dummy case it will only be
/// checked for Size >= 0
/// </param>
/// <param name="Size">
/// Number of bytes the Source to be checked contains
/// </param>
/// <returns>
/// true if Size >= 0
/// </returns>
class function DoIsValid(const Data; Size: Integer): Boolean; override;
public
end;
/// <summary>
/// Returns the passed class type if it is not nil. Otherwise the class type
/// of the TFormat_Copy class is being returned.
/// </summary>
/// <param name="FormatClass">
/// Class type of a formatting class like TFormat_HEX or nil, if no formatting
/// is desired.
/// </param>
/// <returns>
/// Passed class type or TFormat_Copy class type, depending on FormatClass
/// parameter value.
/// </returns>
function ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass;
/// <summary>
/// Searches a registered formatting class by name.
/// </summary>
/// <param name="Name">
/// Unique long (TFormat_HEXL) or short (HEXL) name of the class to be searched.
/// </param>
/// <returns>
/// Class type, which can be used to create an object isntance from. Raises an
/// EDECClassNotRegisteredException exception if the class cannot be found in
/// the list of registered format classes.
/// </returns>
function FormatByName(const Name: string): TDECFormatClass;
/// <summary>
/// Searches a registered formatting class by identity. The identity is some
/// integer value calculated on the basis of the class name, the length of the
/// name and a fixed prefix and by calculating a CRC32 checksum of this.
/// </summary>
/// <param name="Identity">
/// Unique identity of the class to be searched.
/// </param>
/// <returns>
/// Class type, which can be used to create an object isntance from. Raises an
/// EDECClassNotRegisteredException exception if the class cannot be found in
/// the list of registered format classes.
/// </returns>
function FormatByIdentity(Identity: Int64): TDECFormatClass;
implementation
function ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass;
begin
if FormatClass <> nil then
Result := FormatClass
else
Result := TFormat_Copy;
end;
function FormatByName(const Name: string): TDECFormatClass;
begin
Result := TDECFormatClass(TDECFormat.ClassList.ClassByName(Name));
end;
function FormatByIdentity(Identity: Int64): TDECFormatClass;
begin
Result := TDECFormatClass(TDECFormat.ClassList.ClassByIdentity(Identity));
end;
{ TDECFormat }
class procedure TDECFormat.DoEncode(const Source; var Dest: TBytes;
Size: Integer);
begin
// C++ does not support virtual static functions thus the base cannot be
// marked 'abstract'. This is our workaround:
raise EDECAbstractError.Create(GetShortClassName);
end;
class procedure TDECFormat.DoDecode(const Source; var Dest: TBytes;
Size: Integer);
begin
// C++ does not support virtual static functions thus the base cannot be
// marked 'abstract'. This is our workaround:
raise EDECAbstractError.Create(GetShortClassName);
end;
class function TDECFormat.DoIsValid(const Data; Size: Integer): Boolean;
begin
{$IFDEF FPC}
Result := False; // suppress FPC compiler warning
{$ENDIF FPC}
// C++ does not support virtual static functions thus the base cannot be
// marked 'abstract'. This is our workaround:
raise EDECAbstractError.Create(GetShortClassName);
end;
class function TDECFormat.Encode(const Data: RawByteString): RawByteString;
var
b: TBytes;
begin
if Length(Data) > 0 then
begin
{$IF CompilerVersion >= 24.0}
DoEncode(Data[Low(Data)], b, Length(Data) * SizeOf(Data[Low(Data)]));
{$ELSE}
DoEncode(Data[1], b, Length(Data) * SizeOf(Data[1]));
{$IFEND}
Result := BytesToRawString(b);
end
else
SetLength(Result, 0);
end;
class function TDECFormat.Encode(const Data: TBytes): TBytes;
var
b: TBytes;
begin
if Length(Data) > 0 then
begin
DoEncode(Data[0], b, Length(Data));
Result := b;
end
else
SetLength(Result, 0);
end;
class function TDECFormat.ClassByIdentity(Identity: Int64): TDECFormatClass;
begin
Result := TDECFormatClass(ClassList.ClassByIdentity(Identity));
end;
class function TDECFormat.ClassByName(const Name: string): TDECFormatClass;
begin
Result := TDECFormatClass(ClassList.ClassByName(Name));
end;
class function TDECFormat.Decode(const Data: TBytes): TBytes;
var
b: TBytes;
begin
if Length(Data) > 0 then
begin
DoDecode(Data[0], b, Length(Data));
Result := b;
end
else
SetLength(Result, 0);
end;
class function TDECFormat.Decode(const Data: RawByteString): RawByteString;
var
b: TBytes;
begin
if Length(Data) > 0 then
begin
{$IF CompilerVersion >= 24.0}
DoDecode(Data[Low(Data)], b, Length(Data) * SizeOf(Data[Low(Data)]));
{$ELSE}
DoDecode(Data[1], b, Length(Data) * SizeOf(Data[1]));
{$IFEND}
Result := BytesToRawString(b);
end
else
SetLength(Result, 0);
end;
class function TDECFormat.Decode(const Data; Size: Integer): RawByteString;
var
b: TBytes;
begin
if Size > 0 then
begin
DoDecode(Data, b, Size);
Result := BytesToRawString(b);
end
else
SetLength(Result, 0);
end;
class function TDECFormat.Encode(const Data; Size: Integer): RawByteString;
var
b: TBytes;
begin
if Size > 0 then
begin
DoEncode(Data, b, Size);
Result := BytesToRawString(b);
end
else
SetLength(Result, 0);
end;
class function TDECFormat.IsValid(const Data; Size: Integer): Boolean;
begin
Result := DoIsValid(Data, Size);
end;
class function TDECFormat.IsValid(const Data: TBytes): Boolean;
begin
Result := (Length(Data) = 0) or (DoIsValid(Data[0], Length(Data)));
end;
class function TDECFormat.IsValid(const Text: RawByteString): Boolean;
begin
{$IF CompilerVersion >= 24.0}
Result := (Length(Text) = 0) or
(DoIsValid(Text[Low(Text)], Length(Text) * SizeOf(Text[Low(Text)])));
{$ELSE}
Result := (Length(Text) = 0) or
(DoIsValid(Text[1], Length(Text) * SizeOf(Text[1])));
{$IFEND}
end;
class function TDECFormat.UpCaseBinary(b: Byte): Byte;
begin
Result := b;
if Result in [$61 .. $7A] then
Dec(Result, $61 - $41);
end;
class function TDECFormat.TableFindBinary(Value: Byte; Table: TBytes;
Len: Integer): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i <= Len) and (i < Length(Table)) do
begin
if (Table[i] = Value) then
begin
Result := i;
break;
end;
inc(i);
end;
end;
{ TFormat_Copy }
class procedure TFormat_Copy.DoEncode(const Source; var Dest: TBytes;
Size: Integer);
begin
SetLength(Dest, Size);
if Size <> 0 then
Move(Source, Dest[0], Size);
end;
class procedure TFormat_Copy.DoDecode(const Source; var Dest: TBytes;
Size: Integer);
begin
SetLength(Dest, Size);
if Size <> 0 then
Move(Source, Dest[0], Size);
end;
class function TFormat_Copy.DoIsValid(const Data; Size: Integer): Boolean;
begin
Result := Size >= 0;
end;
{$IFDEF DELPHIORBCB}
procedure ModuleUnload(Instance: NativeInt);
var
i: Integer;
begin
if TDECFormat.ClassList <> nil then
begin
for i := TDECFormat.ClassList.Count - 1 downto 0 do
begin
if NativeInt(FindClassHInstance(TClass(TDECFormat.ClassList[i]))) = Instance
then
TDECFormat.ClassList.Remove(TDECFormat.ClassList[i].Identity);
end;
end;
end;
{$ENDIF DELPHIORBCB}
initialization
// Code for packages and dynamic extension of the class registration list
{$IFDEF DELPHIORBCB}
AddModuleUnloadProc(ModuleUnload);
{$ENDIF DELPHIORBCB}
TDECFormat.ClassList := TDECClassList.Create;
TFormat_Copy.RegisterClass(TDECFormat.ClassList);
finalization
// Ensure no further instances of classes registered in the registration list
// are possible through the list after this unit has been unloaded by unloding
// the package this unit is in
{$IFDEF DELPHIORBCB}
RemoveModuleUnloadProc(ModuleUnload);
{$ENDIF DELPHIORBCB}
TDECFormat.ClassList.Free;
end.

29529
contrib/DelphiEncryptionCompendium/Source/DECHash.asm86.inc Normal file
View File

File diff suppressed because it is too large Load Diff

4626
contrib/DelphiEncryptionCompendium/Source/DECHash.pas Normal file
View File

File diff suppressed because it is too large Load Diff

377
contrib/DelphiEncryptionCompendium/Source/DECHash.sha3_mmx.inc Normal file
View File

@@ -0,0 +1,377 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
{**********************************************************************}
{ }
{ "The contents of this file are subject to the Mozilla Public }
{ License Version 1.1 (the "License"); you may not use this }
{ file except in compliance with the License. You may obtain }
{ a copy of the License at http://www.mozilla.org/MPL/ }
{ }
{ Software distributed under the License is distributed on an }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express }
{ or implied. See the License for the specific language }
{ governing rights and limitations under the License. }
{ }
{ Copyright Creative IT. }
{ Current maintainer: Eric Grange }
{ }
{**********************************************************************}
// The original source file can be found here:
// https://bitbucket.org/egrange/dwscript/src
add edx, 128
add eax, 128
movq mm1, [edx-120]
movq mm4, [edx-96]
movq mm3, [edx-104]
pxor mm1, [edx-80]
movq mm5, [edx+16]
pxor mm1, [edx]
movq mm2, [edx-112]
pxor mm1, [edx+40]
pxor mm1, [edx-40]
movq mm0, [edx-128]
movq mm6, mm1
pxor mm4, [edx-56]
movq [ecx+8], mm1
psrlq mm6, 63
pxor mm4, [edx+24]
pxor mm4, [edx+64]
pxor mm4, [edx-16]
psllq mm1, 1
pxor mm2, [edx+48]
por mm1, mm6
movq mm6, [edx-88]
pxor mm1, mm4
pxor mm2, [edx-32]
pxor mm2, [edx-72]
pxor mm6, mm1
movq mm7, mm6
psrlq mm7, 28
psllq mm6, 36
por mm6, mm7
pxor mm2, [edx+8]
movq [eax], mm6
movq mm6, [edx+32]
movq mm7, mm4
psrlq mm7, 63
psllq mm4, 1
pxor mm0, mm6
por mm4, mm7
pxor mm4, mm2
pxor mm5, mm4
movq mm7, mm5
pxor mm0, [edx-8]
psllq mm5, 21
psrlq mm7, 43
pxor mm6, mm1
por mm5, mm7
movq [eax-104], mm5
movq mm5, [edx-48]
pxor mm0, mm5
movq mm7, mm6
psrlq mm7, 46
psllq mm6, 18
por mm6, mm7
movq [eax-16], mm6
movq mm6, [edx+56]
pxor mm5, mm1
movq mm7, mm5
pxor mm3, mm6
psllq mm5, 3
psrlq mm7, 61
pxor mm3, [edx+16]
pxor mm3, [edx-24]
por mm5, mm7
pxor mm6, mm4
pxor mm0, [edx-88]
movq mm7, mm6
psrlq mm7, 8
movq [eax-72], mm5
movq mm5, mm2
psllq mm2, 1
psllq mm6, 56
psrlq mm5, 63
por mm6, mm7
por mm2, mm5
pxor mm2, mm0
movq [eax+24], mm6
movq mm5, [edx-120]
movq mm6, mm0
psllq mm0, 1
pxor mm5, mm2
pxor mm3, [edx-64]
psrlq mm6, 63
por mm0, mm6
movq mm6, [edx-64]
movq mm7, mm5
psllq mm5, 1
psrlq mm7, 63
pxor mm6, mm4
por mm5, mm7
pxor mm0, mm3
movq mm7, mm6
movq [eax-48], mm5
movq mm5, [edx]
psllq mm6, 55
psrlq mm7, 9
por mm6, mm7
movq [eax+40], mm6
movq mm6, [edx-40]
pxor mm5, mm2
movq mm7, mm5
psllq mm5, 45
psrlq mm7, 19
pxor mm6, mm2
por mm5, mm7
movq [eax-64], mm5
movq mm5, [edx+40]
movq mm7, mm6
pxor mm5, mm2
psllq mm6, 10
psrlq mm7, 54
por mm6, mm7
movq [eax+8], mm6
movq mm6, [edx-96]
movq mm7, mm3
psrlq mm7, 63
psllq mm3, 1
por mm3, mm7
movq mm7, mm5
psllq mm5, 2
psrlq mm7, 62
por mm5, mm7
movq [eax+64], mm5
movq mm5, [edx+24]
pxor mm6, mm0
movq mm7, mm6
psrlq mm7, 37
psllq mm6, 27
por mm6, mm7
movq [eax-8], mm6
pxor mm5, mm0
movq mm6, [edx-16]
movq mm7, mm5
psllq mm5, 8
pxor mm3, [ecx+8]
psrlq mm7, 56
pxor mm6, mm0
por mm5, mm7
movq [eax-24], mm5
movq mm7, mm6
psllq mm6, 39
movq mm5, [edx-112]
psrlq mm7, 25
por mm6, mm7
movq [eax+48], mm6
movq mm6, [edx-24]
pxor mm5, mm3
movq mm7, mm5
psrlq mm7, 2
psllq mm5, 62
por mm5, mm7
movq [eax+32], mm5
movq mm5, [edx-104]
pxor mm6, mm4
movq mm7, mm6
psrlq mm7, 39
psllq mm6, 25
por mm6, mm7
pxor mm5, mm4
movq [eax-32], mm6
movq mm6, [edx-128]
pxor mm6, mm1
movq mm4, mm6
movq [eax-128], mm6
movq mm4, mm6
movq mm6, [edx-8]
movq mm7, mm5
psrlq mm7, 36
psllq mm5, 28
pxor mm6, mm1
por mm5, mm7
movq mm7, mm6
psrlq mm7, 23
movq mm1, mm5
movq [eax-88], mm5
movq mm5, [edx-56]
pxor mm5, mm0
psllq mm6, 41
por mm6, mm7
movq [eax+56], mm6
movq mm6, [edx+48]
pxor mm6, mm3
movq mm7, mm5
psrlq mm7, 44
psllq mm5, 20
por mm5, mm7
movq [eax-80], mm5
pandn mm1, mm5
movq mm5, [edx-32]
movq mm7, mm6
psrlq mm7, 3
psllq mm6, 61
por mm6, mm7
pxor mm1, mm6
movq [eax-56], mm6
movq mm6, [edx+8]
movq [edx-56], mm1
movq mm1, [eax-112]
pxor mm5, mm3
movq mm7, mm5
psllq mm5, 43
psrlq mm7, 21
pxor mm6, mm3
por mm5, mm7
movq mm1, mm5
movq mm5, [edx-80]
pxor mm5, mm2
movq mm2, [eax-104]
movq mm7, mm6
psrlq mm7, 49
psllq mm6, 15
por mm6, mm7
movq [eax+16], mm6
movq mm6, [edx+64]
movq [eax-96], mm6
movq mm7, mm5
psrlq mm7, 20
psllq mm5, 44
pxor mm6, mm0
por mm5, mm7
movq mm7, mm6
psrlq mm7, 50
psllq mm6, 14
por mm6, mm7
pandn mm2, mm6
movq mm0, mm5
pandn mm0, mm1
pxor mm2, mm1
pandn mm1, [eax-104]
movq [edx-112], mm2
pandn mm4, mm5
pxor mm1, mm5
movq [eax-120], mm5
movq mm2, [eax-40]
movq [edx-120], mm1
movq mm5, [edx-72]
movq mm1, [eax-64]
pxor mm4, mm6
movq [edx-96], mm4
pxor mm5, mm3
movq mm4, [eax-88]
movq mm7, mm5
movq mm3, mm6
pxor mm0, [eax-128]
movq [edx-128], mm0
movq mm6, [eax-72]
psllq mm5, 6
psrlq mm7, 58
movq mm0, [eax-56]
por mm5, mm7
movq mm2, mm5
movq mm5, [eax-80]
movq mm7, mm1
pandn mm7, mm0
pxor mm7, mm6
movq [edx-72], mm7
movq mm7, [eax-72]
pandn mm6, mm1
pxor mm6, mm5
pandn mm0, mm4
pandn mm5, mm7
movq mm7, [eax]
pxor mm5, mm4
movq mm4, [eax-24]
movq [edx-80], mm6
movq mm6, [eax-48]
movq [edx-88], mm5
movq mm5, mm1
movq mm1, [eax-16]
pxor mm0, mm5
movq mm5, mm1
pandn mm3, [eax-128]
pxor mm3, [eax-104]
movq [edx-64], mm0
movq mm0, [eax+8]
movq [edx-104], mm3
movq mm3, [eax-32]
pandn mm6, mm2
pxor mm6, mm5
movq [edx-16], mm6
movq mm6, [eax+56]
pandn mm3, mm4
pxor mm3, mm2
movq [edx-40], mm3
movq mm3, [eax-32]
pandn mm5, [eax-48]
pxor mm5, mm4
movq [edx-24], mm5
pandn mm7, mm0
movq mm5, [eax+16]
pandn mm4, mm1
pxor mm4, mm3
movq [edx-32], mm4
movq mm4, [eax+40]
movq mm1, mm5
movq mm5, [eax+48]
pandn mm5, mm6
pxor mm5, mm4
pandn mm2, mm3
movq mm3, [eax-8]
movq [edx+40], mm5
movq mm5, [eax+24]
pxor mm7, mm3
movq [edx-8], mm7
movq mm7, [eax+64]
pxor mm2, [eax-48]
movq [edx-48], mm2
movq mm2, mm5
pandn mm2, mm3
pxor mm2, mm1
movq [edx+16], mm2
pandn mm3, [eax]
movq mm2, mm5
movq mm5, [eax+48]
pandn mm6, mm7
pxor mm6, mm5
movq [edx+48], mm6
pandn mm1, mm2
movq mm6, [eax+32]
pxor mm1, mm0
pxor mm3, mm2
movq [edx+24], mm3
pandn mm0, [eax+16]
pxor mm0, [eax]
movq mm3, mm4
movq [edx+8], mm1
movq [edx], mm0
movq mm0, mm6
movq mm1, [eax+56]
pandn mm4, mm5
pxor mm4, mm0
pandn mm0, mm3
pxor mm0, mm7
movq [edx+32], mm4
pandn mm7, mm6
pxor mm7, mm1
movq [edx+56], mm7
movq [edx+64], mm0

318
contrib/DelphiEncryptionCompendium/Source/DECHash.sha3_x64.inc Normal file
View File

@@ -0,0 +1,318 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
{**********************************************************************}
{ }
{ "The contents of this file are subject to the Mozilla Public }
{ License Version 1.1 (the "License"); you may not use this }
{ file except in compliance with the License. You may obtain }
{ a copy of the License at http://www.mozilla.org/MPL/ }
{ }
{ Software distributed under the License is distributed on an }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express }
{ or implied. See the License for the specific language }
{ governing rights and limitations under the License. }
{ }
{ Copyright Creative IT. }
{ Current maintainer: Eric Grange }
{ }
{**********************************************************************}
// The original source file can be found here:
// https://bitbucket.org/egrange/dwscript/src
push r12
push r13
push r14
add rdx, 128
add rcx, 128
// Theta
mov rax, [rdx-128]
xor rax, [rdx-88]
xor rax, [rdx-48]
xor rax, [rdx-8]
xor rax, [rdx+32]
mov [r8], rax
mov rax, [rdx-120]
xor rax, [rdx-80]
xor rax, [rdx-40]
xor rax, [rdx]
xor rax, [rdx+40]
mov [r8+8], rax
mov rax, [rdx-112]
xor rax, [rdx-72]
xor rax, [rdx-32]
xor rax, [rdx+8]
xor rax, [rdx+48]
mov [r8+16], rax
mov rax, [rdx-104]
xor rax, [rdx-64]
xor rax, [rdx-24]
xor rax, [rdx+16]
xor rax, [rdx+56]
mov [r8+24], rax
mov rax, [rdx-96]
xor rax, [rdx-56]
xor rax, [rdx-16]
xor rax, [rdx+24]
xor rax, [rdx+64]
mov [r8+32], rax
mov r10, [r8]
rol r10, 1
xor r10, [r8+24]
mov r11, [r8+8]
rol r11, 1
xor r11, [r8+32]
mov r12, [r8+16]
rol r12, 1
xor r12, [r8]
mov r13, [r8+24]
rol r13, 1
xor r13, [r8+8]
mov r14, [r8+32]
rol r14, 1
xor r14, [r8+16]
// Rho Pi
mov rax, [rdx-128]
xor rax, r11
mov [rcx-128], rax
mov rax, [rdx-80]
xor rax, r12
rol rax, 44
mov [rcx-120], rax
mov rax, [rdx-32]
xor rax, r13
rol rax, 43
mov [rcx-112], rax
mov rax, [rdx+16]
xor rax, r14
rol rax, 21
mov [rcx-104], rax
mov rax, [rdx+64]
xor rax, r10
rol rax, 14
mov [rcx-96], rax
mov rax, [rdx-104]
xor rax, r14
rol rax, 28
mov [rcx-88], rax
mov rax, [rdx-56]
xor rax, r10
rol rax, 20
mov [rcx-80], rax
mov rax, [rdx-48]
xor rax, r11
rol rax, 3
mov [rcx-72], rax
mov rax, [rdx]
xor rax, r12
rol rax, 45
mov [rcx-64], rax
mov rax, [rdx+48]
xor rax, r13
rol rax, 61
mov [rcx-56], rax
mov rax, [rdx-120]
xor rax, r12
rol rax, 1
mov [rcx-48], rax
mov rax, [rdx-72]
xor rax, r13
rol rax, 6
mov [rcx-40], rax
mov rax, [rdx-24]
xor rax, r14
rol rax, 25
mov [rcx-32], rax
mov rax, [rdx+24]
xor rax, r10
rol rax, 8
mov [rcx-24], rax
mov rax, [rdx+32]
xor rax, r11
rol rax, 18
mov [rcx-16], rax
mov rax, [rdx-96]
xor rax, r10
rol rax, 27
mov [rcx-8], rax
mov rax, [rdx-88]
xor rax, r11
rol rax, 36
mov [rcx], rax
mov rax, [rdx-40]
xor rax, r12
rol rax, 10
mov [rcx+8], rax
mov rax, [rdx+8]
xor rax, r13
rol rax, 15
mov [rcx+16], rax
mov rax, [rdx+56]
xor rax, r14
rol rax, 56
mov [rcx+24], rax
mov rax, [rdx-112]
xor rax, r13
rol rax, 62
mov [rcx+32], rax
mov rax, [rdx-64]
xor rax, r14
rol rax, 55
mov [rcx+40], rax
mov rax, [rdx-16]
xor rax, r10
rol rax, 39
mov [rcx+48], rax
mov rax, [rdx-8]
xor rax, r11
rol rax, 41
mov [rcx+56], rax
mov rax, [rdx+40]
xor rax, r12
rol rax, 2
mov [rcx+64], rax
// Chi
mov rax, [rcx-120]
not rax
and rax, [rcx-112]
xor rax, [rcx-128]
mov [rdx-128], rax
mov rax, [rcx-112]
not rax
and rax, [rcx-104]
xor rax, [rcx-120]
mov [rdx-120], rax
mov rax, [rcx-104]
not rax
and rax, [rcx-96]
xor rax, [rcx-112]
mov [rdx-112], rax
mov rax, [rcx-96]
not rax
and rax, [rcx-128]
xor rax, [rcx-104]
mov [rdx-104], rax
mov rax, [rcx-128]
not rax
and rax, [rcx-120]
xor rax, [rcx-96]
mov [rdx-96], rax
mov rax, [rcx-80]
not rax
and rax, [rcx-72]
xor rax, [rcx-88]
mov [rdx-88], rax
mov rax, [rcx-72]
not rax
and rax, [rcx-64]
xor rax, [rcx-80]
mov [rdx-80], rax
mov rax, [rcx-64]
not rax
and rax, [rcx-56]
xor rax, [rcx-72]
mov [rdx-72], rax
mov rax, [rcx-56]
not rax
and rax, [rcx-88]
xor rax, [rcx-64]
mov [rdx-64], rax
mov rax, [rcx-88]
not rax
and rax, [rcx-80]
xor rax, [rcx-56]
mov [rdx-56], rax
mov rax, [rcx-40]
not rax
and rax, [rcx-32]
xor rax, [rcx-48]
mov [rdx-48], rax
mov rax, [rcx-32]
not rax
and rax, [rcx-24]
xor rax, [rcx-40]
mov [rdx-40], rax
mov rax, [rcx-24]
not rax
and rax, [rcx-16]
xor rax, [rcx-32]
mov [rdx-32], rax
mov rax, [rcx-16]
not rax
and rax, [rcx-48]
xor rax, [rcx-24]
mov [rdx-24], rax
mov rax, [rcx-48]
not rax
and rax, [rcx-40]
xor rax, [rcx-16]
mov [rdx-16], rax
mov rax, [rcx]
not rax
and rax, [rcx+8]
xor rax, [rcx-8]
mov [rdx-8], rax
mov rax, [rcx+8]
not rax
and rax, [rcx+16]
xor rax, [rcx]
mov [rdx], rax
mov rax, [rcx+16]
not rax
and rax, [rcx+24]
xor rax, [rcx+8]
mov [rdx+8], rax
mov rax, [rcx+24]
not rax
and rax, [rcx-8]
xor rax, [rcx+16]
mov [rdx+16], rax
mov rax, [rcx-8]
not rax
and rax, [rcx]
xor rax, [rcx+24]
mov [rdx+24], rax
mov rax, [rcx+40]
not rax
and rax, [rcx+48]
xor rax, [rcx+32]
mov [rdx+32], rax
mov rax, [rcx+48]
not rax
and rax, [rcx+56]
xor rax, [rcx+40]
mov [rdx+40], rax
mov rax, [rcx+56]
not rax
and rax, [rcx+64]
xor rax, [rcx+48]
mov [rdx+48], rax
mov rax, [rcx+64]
not rax
and rax, [rcx+32]
xor rax, [rcx+56]
mov [rdx+56], rax
mov rax, [rcx+32]
not rax
and rax, [rcx+40]
xor rax, [rcx+64]
mov [rdx+64], rax
pop r14
pop r13
pop r12

879
contrib/DelphiEncryptionCompendium/Source/DECHashAuthentication.pas Normal file
View File

@@ -0,0 +1,879 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Unit containing all the KDF, MGF, HMAC and PBKDF2 algorithms
/// </summary>
unit DECHashAuthentication;
interface
uses
System.SysUtils, DECHashBase;
type
/// <summary>
/// Meta class for all the hashing classes in order to support the
/// registration mechanism
/// </summary>
TDECHashAuthenticationClass = class of TDECHashAuthentication;
/// <summary>
/// Type of the KDF variant
/// </summary>
TKDFType = (ktKDF1, ktKDF2, ktKDF3);
/// <summary>
/// Class containing all the KDF, MGF, HMAC and PBKDF2 algorithms
/// </summary>
TDECHashAuthentication = class(TDECHash)
strict private
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// IEEE P1363 Working Group, ISO 18033-2:2004
/// This is either KDF1 or KDF2 depending on KDFType
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="DataSize">
/// Size in bytes of the source data passed.
/// </param>
/// <param name="Seed">
/// Start value for pseudo random number generator
/// </param>
/// <param name="SeedSize">
/// Size of the seed in byte.
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <param name="KDFType">
/// Type of the algorithm: 1 = KDF1, 2 = KDF2 and 3 = KDF 3
/// </param>
/// <returns>
/// Returns the new derrived key.
/// </returns>
class function KDFInternal(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer; KDFType: TKDFType): TBytes; inline;
public
/// <summary>
/// Detects whether the given hash class is one particularily suited
/// for storing hashes of passwords
/// </summary>
/// <returns>
/// true if it's a hash class specifically designed to store password
/// hashes, false for ordinary hash algorithms.
/// </returns>
class function IsPasswordHash: Boolean; override;
// mask generation
/// <summary>
/// Mask generation: generates an output based on the data given which is
/// similar to a hash function but in contrast does not have a fixed output
/// length. Use of a MGF is desirable in cases where a fixed-size hash
/// would be inadequate. Examples include generating padding, producing
/// one time pads or keystreams in symmetric key encryption, and yielding
/// outputs for pseudorandom number generators.
/// Indexed Mask generation function, IEEE P1363 working group
/// equal to KDF1 except without seed. RFC 2437 PKCS #1
/// </summary>
/// <param name="Data">
/// Data from which to generate a mask from
/// </param>
/// <param name="DataSize">
/// Size of the input data in bytes
/// </param>
/// <param name="MaskSize">
/// Size of the returned mask in bytes
/// </param>
/// <returns>
/// Mask such that one cannot determine the data which had been given to
/// generate this mask from.
/// </returns>
class function MGF1(const Data; DataSize, MaskSize: Integer): TBytes; overload;
/// <summary>
/// Mask generation: generates an output based on the data given which is
/// similar to a hash function but incontrast does not have a fixed output
/// length. Use of a MGF is desirable in cases where a fixed-size hash
/// would be inadequate. Examples include generating padding, producing
/// one time pads or keystreams in symmetric key encryption, and yielding
/// outputs for pseudorandom number generators
/// </summary>
/// <param name="Data">
/// Data from which to generate a mask from
/// </param>
/// <param name="MaskSize">
/// Size of the returned mask in bytes
/// </param>
/// <returns>
/// Mask such that one cannot determine the data which had been given to
/// generate this mask from.
/// </returns>
class function MGF1(const Data: TBytes; MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// IEEE P1363 Working Group, ISO 18033-2:2004
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="DataSize">
/// Size in bytes of the source data passed.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="SeedSize">
/// Size of the seed/salt in byte.
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
/// <remarks>
/// In earlier versions there was an optional format parameter. This has
/// been removed as this is a base class. The method might not have
/// returned a result with the MaskSize specified, as the formatting might
/// have had to alter this. This would have been illogical.
/// </remarks>
class function KDF1(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// IEEE P1363 Working Group, ISO 18033-2:2004
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
class function KDF1(const Data, Seed: TBytes; MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// IEEE P1363 Working Group, ISO 18033-2:2004
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="DataSize">
/// Size in bytes of the source data passed.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="SeedSize">
/// Size of the seed/salt in byte.
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
/// <remarks>
/// In earlier versions there was an optional format parameter. This has
/// been removed as this is a base class. The method might not have
/// returned a result with the MaskSize specified, as the formatting might
/// have had to alter this. This would have been illogical.
/// </remarks>
class function KDF2(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// IEEE P1363 Working Group, ISO 18033-2:2004
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="Seed">
/// Start value for pseudo random number generator
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
class function KDF2(const Data, Seed: TBytes; MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="DataSize">
/// Size in bytes of the source data passed.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="SeedSize">
/// Size of the seed/salt in byte.
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
/// <remarks>
/// In earlier versions there was an optional format parameter. This has
/// been removed as this is a base class. The method might not have
/// returned a result with the MaskSize specified, as the formatting might
/// have had to alter this. This would have been illogical.
/// </remarks>
class function KDF3(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
class function KDF3(const Data, Seed: TBytes; MaskSize: Integer): TBytes; overload;
// DEC's own KDF + MGF
/// <summary>
/// Key deviation algorithm to derrive keys from other keys. The alrorithm
/// implemented by this method does not follow any official standard.
/// </summary>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="DataSize">
/// Size in bytes of the source data passed.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="SeedSize">
/// Size of the seed/salt in byte.
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <param name="Index">
/// Optional parameter: can be used to specify a different default value
/// for the index variable used in the algorithm.
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
class function KDFx(const Data; DataSize: Integer; const Seed; SeedSize, MaskSize: Integer; Index: UInt32 = 1): TBytes; overload;
/// <summary>
/// Key deviation algorithm to derrive keys from other keys.
/// </summary>
/// <remarks>
/// This variant of the algorithm does not follow an official standard.
/// It has been created by the original author of DEC.
/// </remarks>
/// <param name="Data">
/// Source data from which the new key shall be derrived.
/// </param>
/// <param name="Seed">
/// Salt value
/// </param>
/// <param name="MaskSize">
/// Size of the generated output in byte
/// </param>
/// <param name="Index">
/// Optional parameter: can be used to specify a different default value
/// for the index variable used in the algorithm.
/// </param>
/// <returns>
/// Returns the new derrived key with the length specified in MaskSize.
/// </returns>
class function KDFx(const Data, Seed: TBytes; MaskSize: Integer; Index: UInt32 = 1): TBytes; overload;
/// <summary>
/// Mask generation: generates an output based on the data given which is
/// similar to a hash function but incontrast does not have a fixed output
/// length. Use of a MGF is desirable in cases where a fixed-size hash
/// would be inadequate. Examples include generating padding, producing
/// one time pads or keystreams in symmetric key encryption, and yielding
/// outputs for pseudorandom number generators.
/// </summary>
/// <remarks>
/// This variant of the algorithm does not follow an official standard.
/// It has been created by the original author of DEC.
/// </remarks>
/// <param name="Data">
/// Data from which to generate a mask from
/// </param>
/// <param name="DataSize">
/// Size of the passed data in bytes
/// </param>
/// <param name="MaskSize">
/// Size of the returned mask in bytes
/// </param>
/// <param name="Index">
/// Looks like this is a salt applied to each byte of output data?
{ TODO : Clarify this parameter }
/// </param>
/// <returns>
/// Mask such that one cannot determine the data which had been given to
/// generate this mask from.
/// </returns>
class function MGFx(const Data; DataSize, MaskSize: Integer; Index: UInt32 = 1): TBytes; overload;
/// <summary>
/// Mask generation: generates an output based on the data given which is
/// similar to a hash function but incontrast does not have a fixed output
/// length. Use of a MGF is desirable in cases where a fixed-size hash
/// would be inadequate. Examples include generating padding, producing
/// one time pads or keystreams in symmetric key encryption, and yielding
/// outputs for pseudorandom number generators.
/// </summary>
/// <remarks>
/// This variant of the algorithm does not follow an official standard.
/// It has been created by the original author of DEC.
/// </remarks>
/// <param name="Data">
/// Data from which to generate a mask from
/// </param>
/// <param name="MaskSize">
/// Size of the returned mask in bytes
/// </param>
/// <param name="Index">
/// Looks like this is a salt applied to each byte of output data?
{ TODO : Clarify this parameter }
/// </param>
/// <returns>
/// Mask such that one cannot determine the data which had been given to
/// generate this mask from.
/// </returns>
class function MGFx(const Data: TBytes; MaskSize: Integer; Index: UInt32 = 1): TBytes; overload;
/// <summary>
/// HMAC according to rfc2202: hash message authentication code allow to
/// verify both the data integrity and the authenticity of a message.
/// </summary>
/// <param name="Key">
/// This is the secret key which shall not be transmitted over the line.
/// The sender uses this key to create the resulting HMAC, transmits the
/// text and the HMAC over the line and the receiver recalculates the HMAC
/// based on his copy of the secret key. If his calculated HMAC equals the
/// transfered HMAC value the message has not been tampered.
/// </param>
/// <param name="Text">
/// Text over which to calculate the HMAC
/// </param>
/// <returns>
/// Calculated HMAC
/// </returns>
class function HMAC(const Key, Text: TBytes): TBytes; overload;
/// <summary>
/// HMAC according to rfc2202: hash message authentication code allow to
/// verify both the data integrity and the authenticity of a message.
/// </summary>
/// <param name="Key">
/// This is the secret key which shall not be transmitted over the line.
/// The sender uses this key to create the resulting HMAC, transmits the
/// text and the HMAC over the line and the receiver recalculates the HMAC
/// based on his copy of the secret key. If his calculated HMAC equals the
/// transfered HMAC value the message has not been tampered.
/// </param>
/// <param name="Text">
/// Text over which to calculate the HMAC
/// </param>
/// <returns>
/// Calculated HMAC
/// </returns>
class function HMAC(const Key, Text: RawByteString): TBytes; overload;
/// <summary>
/// Password based key deviation function 2
/// RFC 2898, PKCS #5.
/// This can be used to create a login sheme by storing the output,
/// number of iterations and the salt. When the user enters a password
/// this calculation is done using the same parameters as stored for his
/// user account and comparing the output.
/// </summary>
/// <param name="Password">
/// Password to create the deviation from
/// </param>
/// <param name="Salt">
/// Salt used to modify the password
/// </param>
/// <param name="Iterations">
/// Number of iterations to perform
/// </param>
/// <param name="KeyLength">
/// Length of the resulting key in byte
/// </param>
class function PBKDF2(const Password, Salt: TBytes; Iterations: Integer; KeyLength: Integer): TBytes; overload;
/// <summary>
/// Password based key deviation function 2
/// RFC 2898, PKCS #5.
/// This can be used to create a login sheme by storing the output,
/// number of iterations and the salt. When the user enters a password
/// this calculation is done using the same parameters as stored for his
/// user account and comparing the output.
/// </summary>
/// <param name="Password">
/// Password to create the deviation from
/// </param>
/// <param name="Salt">
/// Salt used to modify the password
/// </param>
/// <param name="Iterations">
/// Number of iterations to perform
/// </param>
/// <param name="KeyLength">
/// Length of the resulting key in byte
/// </param>
class function PBKDF2(const Password, Salt: RawByteString; Iterations: Integer; KeyLength: Integer): TBytes; overload;
end;
/// <summary>
/// All hash classes with hash algorithms specially developed for password
/// hashing should inherit from this class in order to be able to distinguish
/// those from normal hash algorithms not really meant to be used for password
/// hashing.
/// </summary>
TDECPasswordHash = class(TDECHashAuthentication);
{$IF CompilerVersion < 28.0}
/// <summary>
/// Class helper for implementing array concatenation which is not available
/// in Delphi XE6 or lower.
/// </summary>
/// <remarks>
/// SHall be removed as soon as the minimum supported version is XE7 or higher.
/// </remarks>
TArrHelper = class
class procedure AppendArrays<T>(var A: TArray<T>; const B: TArray<T>);
end;
{$IFEND}
implementation
uses
DECUtil;
class function TDECHashAuthentication.IsPasswordHash: Boolean;
begin
Result := self.InheritsFrom(TDECPasswordHash);
end;
class function TDECHashAuthentication.KDFInternal(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer; KDFType: TKDFType): TBytes;
var
I, n,
Rounds, DigestBytes : Integer;
Dest : PByteArray;
Count : UInt32;
HashInstance : TDECHashAuthentication;
begin
SetLength(Result, 0);
DigestBytes := DigestSize;
Assert(MaskSize >= 0);
Assert(DataSize >= 0);
Assert(SeedSize >= 0);
Assert(DigestBytes >= 0);
HashInstance := TDECHashAuthenticationClass(self).Create;
try
Rounds := (MaskSize + DigestBytes - 1) div DigestBytes;
SetLength(Result, Rounds * DigestBytes);
Dest := @Result[0];
if (KDFType = ktKDF2) then
n := 1
else
n := 0;
for I := 0 to Rounds-1 do
begin
Count := SwapUInt32(n);
HashInstance.Init;
if (KDFType = ktKDF3) then
begin
HashInstance.Calc(Count, SizeOf(Count));
HashInstance.Calc(Data, DataSize);
end
else
begin
HashInstance.Calc(Data, DataSize);
HashInstance.Calc(Count, SizeOf(Count));
end;
HashInstance.Calc(Seed, SeedSize);
HashInstance.Done;
Move(HashInstance.Digest[0], Dest[(I) * DigestBytes], DigestBytes);
inc(n);
end;
SetLength(Result, MaskSize);
finally
HashInstance.Free;
end;
end;
class function TDECHashAuthentication.MGF1(const Data; DataSize, MaskSize: Integer): TBytes;
begin
Result := KDF1(Data, DataSize, NullStr, 0, MaskSize);
end;
class function TDECHashAuthentication.MGF1(const Data: TBytes; MaskSize: Integer): TBytes;
begin
Result := KDFInternal(Data[0], Length(Data), NullStr, 0, MaskSize, ktKDF1);
end;
class function TDECHashAuthentication.KDF1(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes;
begin
Result := KDFInternal(Data, DataSize, Seed, SeedSize, MaskSize, ktKDF1);
end;
class function TDECHashAuthentication.KDF1(const Data, Seed: TBytes;
MaskSize: Integer): TBytes;
begin
if (length(Seed) > 0) then
Result := KDFInternal(Data[0], length(Data), Seed[0], length(Seed), MaskSize, ktKDF1)
else
Result := KDFInternal(Data[0], length(Data), NullStr, 0, MaskSize, ktKDF1);
end;
class function TDECHashAuthentication.KDF2(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes;
begin
Result := KDFInternal(Data, DataSize, Seed, SeedSize, MaskSize, ktKDF2);
end;
class function TDECHashAuthentication.KDF2(const Data, Seed: TBytes; MaskSize: Integer): TBytes;
begin
if (length(Seed) > 0) then
Result := KDFInternal(Data[0], Length(Data), Seed[0], Length(Seed), MaskSize, ktKDF2)
else
Result := KDFInternal(Data[0], Length(Data), NullStr, 0, MaskSize, ktKDF2);
end;
class function TDECHashAuthentication.KDF3(const Data; DataSize: Integer; const Seed;
SeedSize, MaskSize: Integer): TBytes;
begin
Result := KDFInternal(Data, DataSize, Seed, SeedSize, MaskSize, ktKDF3);
end;
class function TDECHashAuthentication.KDF3(const Data, Seed: TBytes; MaskSize: Integer): TBytes;
begin
if (length(Seed) > 0) then
Result := KDFInternal(Data[0], Length(Data), Seed[0], Length(Seed), MaskSize, ktKDF3)
else
Result := KDFInternal(Data[0], Length(Data), NullStr, 0, MaskSize, ktKDF3);
end;
class function TDECHashAuthentication.KDFx(const Data; DataSize: Integer; const Seed; SeedSize, MaskSize: Integer; Index: UInt32 = 1): TBytes;
// DEC's own KDF, even stronger
var
I, J : Integer;
Count : UInt32;
R : Byte;
HashInstance : TDECHashAuthentication;
begin
Assert(MaskSize >= 0);
Assert(DataSize >= 0);
Assert(SeedSize >= 0);
Assert(DigestSize > 0);
SetLength(Result, MaskSize);
Index := SwapUInt32(Index);
HashInstance := TDECHashAuthenticationClass(self).Create;
try
for I := 0 to MaskSize - 1 do
begin
HashInstance.Init;
Count := SwapUInt32(I);
HashInstance.Calc(Count, SizeOf(Count));
HashInstance.Calc(Result[0], I);
HashInstance.Calc(Index, SizeOf(Index));
Count := SwapUInt32(SeedSize);
HashInstance.Calc(Count, SizeOf(Count));
HashInstance.Calc(Seed, SeedSize);
Count := SwapUInt32(DataSize);
HashInstance.Calc(Count, SizeOf(Count));
HashInstance.Calc(Data, DataSize);
HashInstance.Done;
R := 0;
for J := 0 to DigestSize - 1 do
R := R xor HashInstance.Digest[J];
Result[I] := R;
end;
finally
HashInstance.Free;
end;
end;
class function TDECHashAuthentication.KDFx(const Data, Seed: TBytes; MaskSize: Integer; Index: UInt32 = 1): TBytes;
begin
if (length(Seed) > 0) then
Result := KDFx(Data[0], Length(Data), Seed[0], Length(Seed), MaskSize, Index)
else
Result := KDFx(Data[0], Length(Data), NullStr, Length(Seed), MaskSize, Index)
end;
class function TDECHashAuthentication.MGFx(const Data; DataSize, MaskSize: Integer; Index: UInt32 = 1): TBytes;
begin
Result := KDFx(Data, DataSize, NullStr, 0, MaskSize, Index);
end;
class function TDECHashAuthentication.MGFx(const Data: TBytes; MaskSize: Integer; Index: UInt32 = 1): TBytes;
begin
Result := KDFx(Data[0], Length(Data), NullStr, 0, MaskSize, Index);
end;
class function TDECHashAuthentication.HMAC(const Key, Text: RawByteString): TBytes;
begin
result := HMAC(BytesOf(Key), BytesOf(Text));
end;
class function TDECHashAuthentication.HMAC(const Key, Text: TBytes): TBytes;
const
CONST_UINT_OF_0x36 = $3636363636363636;
CONST_UINT_OF_0x5C = $5C5C5C5C5C5C5C5C;
var
HashInstance: TDECHashAuthentication;
InnerKeyPad, OuterKeyPad: array of Byte;
I, KeyLength, BlockSize, DigestLength: Integer;
begin
HashInstance := TDECHashAuthenticationClass(self).Create;
try
BlockSize := HashInstance.BlockSize; // 64 for sha1, ...
DigestLength := HashInstance.DigestSize;
KeyLength := Length(Key);
SetLength(InnerKeyPad, BlockSize);
SetLength(OuterKeyPad, BlockSize);
I := 0;
if KeyLength > BlockSize then
begin
Result := HashInstance.CalcBytes(Key);
KeyLength := DigestLength;
end
else
Result := Key;
while I <= KeyLength - SizeOf(NativeUInt) do
begin
PNativeUInt(@InnerKeyPad[I])^ := PNativeUInt(@Result[I])^ xor NativeUInt(CONST_UINT_OF_0x36);
PNativeUInt(@OuterKeyPad[I])^ := PNativeUInt(@Result[I])^ xor NativeUInt(CONST_UINT_OF_0x5C);
Inc(I, SizeOf(NativeUInt));
end;
while I < KeyLength do
begin
InnerKeyPad[I] := Result[I] xor $36;
OuterKeyPad[I] := Result[I] xor $5C;
Inc(I);
end;
while I <= BlockSize - SizeOf(NativeUInt) do
begin
PNativeUInt(@InnerKeyPad[I])^ := NativeUInt(CONST_UINT_OF_0x36);
PNativeUInt(@OuterKeyPad[I])^ := NativeUInt(CONST_UINT_OF_0x5C);
Inc(I, SizeOf(NativeUInt));
end;
while I < BlockSize do
begin
InnerKeyPad[I] := $36;
OuterKeyPad[I] := $5C;
Inc(I);
end;
HashInstance.Init;
HashInstance.Calc(InnerKeyPad[0], BlockSize);
if Length(Text) > 0 then
HashInstance.Calc(Text[0], Length(Text));
HashInstance.Done;
Result := HashInstance.DigestAsBytes;
HashInstance.Init;
HashInstance.Calc(OuterKeyPad[0], BlockSize);
HashInstance.Calc(Result[0], DigestLength);
HashInstance.Done;
Result := HashInstance.DigestAsBytes;
finally
HashInstance.Free;
end;
end;
class function TDECHashAuthentication.PBKDF2(const Password, Salt: TBytes; Iterations: Integer; KeyLength: Integer): TBytes;
const
CONST_UINT_OF_0x36 = $3636363636363636;
CONST_UINT_OF_0x5C = $5C5C5C5C5C5C5C5C;
var
Hash: TDECHashAuthentication;
I, J, C: Integer;
BlockCount, HashLengthRounded, SaltLength: Integer;
PassLength, DigestLength, BlockSize: Integer;
InnerKeyPad, OuterKeyPad: TBytes;
SaltEx, T, U, TrimmedKey: TBytes;
begin
Hash := TDECHashAuthenticationClass(self).Create;
try
// Setup needed parameters
DigestLength := Hash.DigestSize;
HashLengthRounded := DigestLength - SizeOf(NativeUInt) + 1;
BlockCount := Trunc((KeyLength + DigestLength - 1) / DigestLength);
BlockSize := Hash.BlockSize;
PassLength := Length(Password);
SaltLength := Length(Salt);
SaltEx := Salt;
SetLength(SaltEx, SaltLength + 4); // reserve 4 bytes for INT_32_BE(i)
SetLength(T, DigestLength);
// Prepare Key for HMAC calculation
// PrepareKeyForHMAC;
I := 0;
if PassLength > BlockSize then
begin
TrimmedKey := Hash.CalcBytes(Password);
PassLength := DigestLength;
end
else
TrimmedKey := Password;
SetLength(InnerKeyPad, BlockSize);
SetLength(OuterKeyPad, BlockSize);
while I < PassLength do
begin
InnerKeyPad[I] := TrimmedKey[I] xor $36;
OuterKeyPad[I] := TrimmedKey[I] xor $5C;
Inc(I);
end;
while I < BlockSize do
begin
InnerKeyPad[I] := $36;
OuterKeyPad[I] := $5C;
Inc(I);
end;
// Calculate DK
for I := 1 to BlockCount do
begin
SaltEx[SaltLength + 0] := Byte(I shr 24); // INT_32_BE(i)
SaltEx[SaltLength + 1] := Byte(I shr 16);
SaltEx[SaltLength + 2] := Byte(I shr 8);
SaltEx[SaltLength + 3] := Byte(I shr 0);
FillChar(T[0], DigestLength, 0); // reset Ti / F
U := SaltEx; // initialize U to U1 = Salt + INT_32_BE(i)
// Calculate F(Password, Salt, c, i) = U1 ^ U2 ^ ... ^ Uc
for C := 1 to Iterations do
begin
Hash.Init;
Hash.Calc(InnerKeyPad[0], BlockSize);
Hash.Calc(U[0], Length(U));
Hash.Done;
U := Hash.DigestAsBytes;
Hash.Init;
Hash.Calc(OuterKeyPad[0], BlockSize);
Hash.Calc(U[0], DigestLength);
Hash.Done;
U := Hash.DigestAsBytes; // Ui
// F = U1 ^ U2 ^ ... ^ Uc
J := 0;
while J < HashLengthRounded do
begin
PNativeUInt(@T[J])^ := PNativeUInt(@T[J])^ xor PNativeUInt(@U[J])^;
Inc(J, SizeOf(NativeUInt));
end;
while J < DigestLength do
begin
T[J] := T[J] xor U[J];
Inc(J);
end;
end;
{$IF CompilerVersion >= 28.0}
Result := Result + T; // DK += F , DK = DK || Ti
{$ELSE}
TArrHelper.AppendArrays<Byte>(Result, T);
{$IFEND}
end;
finally
Hash.Free;
end;
// Trim to the needed key length
SetLength(Result, KeyLength);
end;
class function TDECHashAuthentication.PBKDF2(const Password, Salt: RawByteString; Iterations: Integer; KeyLength: Integer): TBytes;
begin
result := PBKDF2(BytesOf(Password), BytesOf(Salt), Iterations, KeyLength);
end;
{ TArrHelper }
{$IF CompilerVersion < 28.0}
class procedure TArrHelper.AppendArrays<T>(var A: TArray<T>; const B: TArray<T>);
var
i, L: Integer;
begin
L := Length(A);
SetLength(A, L + Length(B));
for i := 0 to High(B) do
A[L + i] := B[i];
end;
{$IFEND}
end.

940
contrib/DelphiEncryptionCompendium/Source/DECHashBase.pas Normal file
View File

@@ -0,0 +1,940 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Base unit for all the hash algorithms. The key deviation algorithms are
/// in the DECHashAUthentication unit and hash algorithms which can process
/// messages with a length specified in bits instead of whole bytes have
/// to inherit from TDECHashBit
/// </summary>
unit DECHashBase;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
DECBaseClass, DECFormatBase, DECUtil, DECTypes, DECHashInterface;
type
/// <summary>
/// Meta class for all the hashing classes in order to support the
/// registration mechanism
/// </summary>
TDECHashClass = class of TDECHash;
/// <summary>
/// Base class for all hash algorithm implementation classes
/// </summary>
{$IFDEF FPC}
TDECHash = class(TDECObject) // does not find methods of the interface as it
// searches for AnsiString instead of RawByteString
// and thus does not find that
{$ELSE}
TDECHash = class(TDECObject, IDECHash)
{$ENDIF}
strict private
/// <summary>
/// Raises an EDECHashException hash algorithm not initialized exception
/// </summary>
procedure RaiseHashNotInitialized;
/// <summary>
/// Returns the current value of the padding byte used to fill up data
/// if necessary
/// </summary>
function GetPaddingByte: Byte;
/// <summary>
/// Changes the value of the padding byte used to fill up data
/// if necessary
/// </summary>
/// <param name="Value">
/// New value for the padding byte
/// </param>
procedure SetPaddingByte(Value: Byte);
strict protected
FCount : array[0..7] of UInt32;
/// <summary>
/// Internal processing buffer
/// </summary>
FBuffer : PByteArray;
/// <summary>
/// Size of the internal processing buffer in byte
/// </summary>
FBufferSize : Integer;
/// <summary>
/// Position the algorithm is currently at in the processing buffer
/// </summary>
FBufferIndex : Integer;
/// <summary>
/// Value used to fill up data
/// </summary>
FPaddingByte : Byte;
/// <summary>
/// Last byte of the message to be hashed if the algorithm is capable of
/// processing bit sized message lengths and FFinalBitLen > 0.
/// </summary>
FFinalByte : UInt8;
/// <summary>
/// Setting this to a number of bits allows to process messages which have
/// a length which is not a exact multiple of bytes.
/// </summary>
FFinalByteLength : UInt8;
/// <summary>
/// This abstract method has to be overridden by each concrete hash algorithm
/// to initialize the necessary data structures.
/// </summary>
procedure DoInit; virtual; abstract;
procedure DoTransform(Buffer: PUInt32Array); virtual; abstract;
/// <summary>
/// This abstract method has to be overridden by each concrete hash algorithm
/// to finalize the calculation of a hash value over the data passed.
/// </summary>
procedure DoDone; virtual; abstract;
/// <summary>
/// Adds the value of 8*Add to the value (which is interpreted as an
/// 8*32 bit unsigned integer array. The carry is taken care of.
/// </summary>
/// <param name="Value">
/// Value which is incremented
/// </param>
/// <param name="Add">
/// Value (which is being multiplied by 8) by which to increment Value
/// </param>
/// <remarks>
/// Raises an EDECHashException overflow error if the last operation has
/// set the carry flag
/// </remarks>
procedure Increment8(var Value; Add: UInt32);
/// <summary>
/// Raises an EDECHashException overflow error
/// </summary>
procedure RaiseHashOverflowError;
/// <summary>
/// Overwrite internally used processing buffers to make it harder to steal
/// any data from memory.
/// </summary>
procedure SecureErase; virtual;
/// <summary>
/// Returns the calculated hash value
/// </summary>
function Digest: PByteArray; virtual; abstract;
public
/// <summary>
/// Initialize internal fields
/// </summary>
constructor Create; override;
/// <summary>
/// Fees internal resources
/// </summary>
destructor Destroy; override;
/// <summary>
/// Generic initialization of internal data structures. Additionally the
/// internal algorithm specific (because of being overridden by each
/// hash algorithm) DoInit method is called. Needs to be called before
/// each hash calculation.
/// </summary>
procedure Init;
/// <summary>
/// Processes one chunk of data to be hashed.
/// </summary>
/// <param name="Data">
/// Data on which the hash value shall be calculated on
/// </param>
/// <param name="DataSize">
/// Size of the data in bytes
/// </param>
procedure Calc(const Data; DataSize: Integer); virtual;
/// <summary>
/// Frees dynamically allocated buffers in a way which safeguards agains
/// data stealing by other methods which afterwards might allocate this memory.
/// Additionaly calls the algorithm spercific DoDone method.
/// </summary>
procedure Done;
/// <summary>
/// Returns the calculated hash value as byte array
/// </summary>
function DigestAsBytes: TBytes; virtual;
/// <summary>
/// Returns the calculated hash value as formatted Unicode string
/// </summary>
/// <param name="Format">
/// Optional parameter. If a formatting class is being passed the formatting
/// will be applied to the returned string. Otherwise no formatting is
/// being used.
/// </param>
/// <returns>
/// Hash value of the last performed hash calculation
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the Unicode string might
/// result in strange characters in the returned result.
/// </remarks>
function DigestAsString(Format: TDECFormatClass = nil): string;
/// <summary>
/// Returns the calculated hash value as formatted RawByteString
/// </summary>
/// <param name="Format">
/// Optional parameter. If a formatting class is being passed the formatting
/// will be applied to the returned string. Otherwise no formatting is
/// being used.
/// </param>
/// <returns>
/// Hash value of the last performed hash calculation
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the RawByteString might
/// result in strange characters in the returned result.
/// </remarks>
function DigestAsRawByteString(Format: TDECFormatClass = nil): RawByteString;
/// <summary>
/// Gives the length of the calculated hash value in byte. Needs to be
/// overridden in concrete hash implementations.
/// </summary>
class function DigestSize: UInt32; virtual;
/// <summary>
/// Gives the length of the blocks the hash value is being calculated
/// on in byte. Needs to be overridden in concrete hash implementations.
/// </summary>
class function BlockSize: UInt32; virtual;
/// <summary>
/// List of registered DEC classes. Key is the Identity of the class.
/// </summary>
class var ClassList : TDECClassList;
/// <summary>
/// Tries to find a class type by its name
/// </summary>
/// <param name="Name">
/// Name to look for in the list
/// </param>
/// <returns>
/// Returns the class type if found. if it could not be found a
/// EDECClassNotRegisteredException will be thrown
/// </returns>
class function ClassByName(const Name: string): TDECHashClass;
/// <summary>
/// Tries to find a class type by its numeric identity DEC assigned to it.
/// Useful for file headers, so they can easily encode numerically which
/// cipher class was being used.
/// </summary>
/// <param name="Identity">
/// Identity to look for
/// </param>
/// <returns>
/// Returns the class type of the class with the specified identity value
/// or throws an EDECClassNotRegisteredException exception if no class
/// with the given identity has been found
/// </returns>
class function ClassByIdentity(Identity: Int64): TDECHashClass;
/// <summary>
/// Detects whether the given hash class is one particularily suited
/// for storing hashes of passwords
/// </summary>
/// <returns>
/// true if it's a hash class specifically designed to store password
/// hashes, false for ordinary hash algorithms.
/// </returns>
class function IsPasswordHash: Boolean; virtual;
// hash calculation wrappers
/// <summary>
/// Calculates the hash value (digest) for a given buffer
/// </summary>
/// <param name="Buffer">
/// Untyped buffer the hash shall be calculated for
/// </param>
/// <param name="BufferSize">
/// Size of the buffer in byte
/// </param>
/// <returns>
/// Byte array with the calculated hash value
/// </returns>
function CalcBuffer(const Buffer; BufferSize: Integer): TBytes;
/// <summary>
/// Calculates the hash value (digest) for a given buffer
/// </summary>
/// <param name="Data">
/// The TBytes array the hash shall be calculated on
/// </param>
/// <returns>
/// Byte array with the calculated hash value
/// </returns>
function CalcBytes(const Data: TBytes): TBytes;
/// <summary>
/// Calculates the hash value (digest) for a given unicode string
/// </summary>
/// <param name="Value">
/// The string the hash shall be calculated on
/// </param>
/// <param name="Format">
/// Formatting class from DECFormat. The formatting will be applied to the
/// returned digest value. This parameter is optional.
/// </param>
/// <returns>
/// string with the calculated hash value
/// </returns>
function CalcString(const Value: string; Format: TDECFormatClass = nil): string; overload;
/// <summary>
/// Calculates the hash value (digest) for a given rawbytestring
/// </summary>
/// <param name="Value">
/// The string the hash shall be calculated on
/// </param>
/// <param name="Format">
/// Formatting class from DECFormat. The formatting will be applied to the
/// returned digest value. This parameter is optional.
/// </param>
/// <returns>
/// string with the calculated hash value
/// </returns>
function CalcString(const Value: RawByteString; Format: TDECFormatClass): RawByteString; overload;
/// <summary>
/// Calculates the hash value over a given stream of bytes
/// </summary>
/// <param name="Stream">
/// Memory or file stream over which the hash value shall be calculated.
/// The stream must be assigned. The hash value will always be calculated
/// from the current position of the stream.
/// </param>
/// <param name="Size">
/// Number of bytes within the stream over which to calculate the hash value
/// </param>
/// <param name="HashResult">
/// In this byte array the calculated hash value will be returned
/// </param>
/// <param name="OnProgress">
/// Optional callback routine. It can be used to display the progress of
/// the operation.
/// </param>
procedure CalcStream(const Stream: TStream; Size: Int64; var HashResult: TBytes;
const OnProgress:TDECProgressEvent = nil); overload;
/// <summary>
/// Calculates the hash value over a givens stream of bytes
/// </summary>
/// <param name="Stream">
/// Memory or file stream over which the hash value shall be calculated.
/// The stream must be assigned. The hash value will always be calculated
/// from the current position of the stream.
/// </param>
/// <param name="Size">
/// Number of bytes within the stream over which to calculate the hash value
/// </param>
/// <param name="Format">
/// Optional formatting class. The formatting of that will be applied to
/// the returned hash value.
/// </param>
/// <param name="OnProgress">
/// Optional callback routine. It can be used to display the progress of
/// the operation.
/// </param>
/// <returns>
/// Hash value over the bytes in the stream, formatted with the formatting
/// passed as format parameter, if used.
/// </returns>
function CalcStream(const Stream: TStream; Size: Int64; Format: TDECFormatClass = nil;
const OnProgress:TDECProgressEvent = nil): RawByteString; overload;
/// <summary>
/// Calculates the hash value over the contents of a given file
/// </summary>
/// <param name="FileName">
/// Path and name of the file to be processed
/// </param>
/// <param name="HashResult">
/// Here the resulting hash value is being returned as byte array
/// </param>
/// <param name="OnProgress">
/// Optional callback. If being used the hash calculation will call it from
/// time to time to return the current progress of the operation
/// </param>
procedure CalcFile(const FileName: string; var HashResult: TBytes;
const OnProgress:TDECProgressEvent = nil); overload;
/// <summary>
/// Calculates the hash value over the contents of a given file
/// </summary>
/// <param name="FileName">
/// Path and name of the file to be processed
/// </param>
/// <param name="Format">
/// Optional parameter: Formatting class. If being used the formatting is
/// being applied to the returned string with the calculated hash value
/// </param>
/// <param name="OnProgress">
/// Optional callback. If being used the hash calculation will call it from
/// time to time to return the current progress of the operation
/// </param>
/// <returns>
/// Calculated hash value as RawByteString.
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the RawByteString might
/// result in strange characters in the returned result.
/// </remarks>
function CalcFile(const FileName: string; Format: TDECFormatClass = nil;
const OnProgress:TDECProgressEvent = nil): RawByteString; overload;
/// <summary>
/// Defines the byte used in the KDF methods to padd the end of the data
/// if the length of the data cannot be divided by required size for the
/// hash algorithm without reminder
/// </summary>
property PaddingByte: Byte read GetPaddingByte write SetPaddingByte;
end;
/// <summary>
/// Returns the passed hash class type if it is not nil. Otherwise the
/// class type class set per SetDefaultHashClass is being returned. If using
/// the DECHash unit THash_SHA256 is registered in the initialization, otherwise
/// nil might be returned!
/// </summary>
/// <param name="HashClass">
/// Class type of a hash class like THash_SHA256. If nil is passed the one set
/// as default is returned.
/// </param>
/// <returns>
/// Passed class type or defined default hash class type, depending on
/// HashClass parameter value.
/// </returns>
function ValidHash(HashClass: TDECHashClass = nil): TDECHashClass;
/// <summary>
/// Defines which cipher class to return by ValidCipher if passing nil to that
/// </summary>
/// <param name="HashClass">
/// Class type of a hash class to return by ValidHash if passing nil to
/// that one. This parameter should not be nil!
/// </param>
procedure SetDefaultHashClass(HashClass: TDECHashClass);
implementation
resourcestring
sHashNotInitialized = 'Hash must be initialized';
sRaiseHashOverflowError = 'Hash Overflow: Too many bits processed';
sHashNoDefault = 'No default hash has been registered';
var
/// <summary>
/// Hash class returned by ValidHash if nil is passed as parameter to it
/// </summary>
FDefaultHashClass: TDECHashClass = nil;
function ValidHash(HashClass: TDECHashClass): TDECHashClass;
begin
if Assigned(HashClass) then
Result := HashClass
else
Result := FDefaultHashClass;
if not Assigned(Result) then
raise EDECHashException.CreateRes(@sHashNoDefault);
end;
procedure SetDefaultHashClass(HashClass: TDECHashClass);
begin
Assert(Assigned(HashClass), 'Do not set a nil default hash class!');
FDefaultHashClass := HashClass;
end;
{ TDECHash }
constructor TDECHash.Create;
begin
inherited;
FBufferSize := 0;
FBuffer := nil;
end;
destructor TDECHash.Destroy;
begin
SecureErase;
FreeMem(FBuffer, FBufferSize);
inherited Destroy;
end;
procedure TDECHash.SecureErase;
begin
ProtectBuffer(Digest^, DigestSize);
if FBuffer = nil then
ProtectBuffer(FBuffer^, FBufferSize);
end;
procedure TDECHash.Init;
begin
FBufferIndex := 0;
if (FBuffer = nil) or (UInt32(FBufferSize) <> BlockSize) then
begin
FBufferSize := BlockSize;
// ReallocMemory instead of ReallocMem due to C++ compatibility as per 10.1 help
// It is necessary to reallocate the buffer as FreeMem in destructor wouldn't
// accept a nil pointer on some platforms.
FBuffer := ReallocMemory(FBuffer, FBufferSize);
end;
FillChar(FBuffer^, FBufferSize, 0);
FillChar(FCount, SizeOf(FCount), 0);
DoInit;
end;
class function TDECHash.IsPasswordHash: Boolean;
begin
// has to be overwritten by the base class for password hash algorithms
result := false;
end;
procedure TDECHash.Done;
begin
DoDone;
end;
function TDECHash.GetPaddingByte: Byte;
begin
Result := FPaddingByte;
end;
procedure TDECHash.Increment8(var Value; Add: UInt32);
// Value := Value + 8 * Add
// Value is array[0..7] of UInt32
{ TODO -oNormanNG -cCodeReview : !!Unbedingt noch einmal pr<70>fen, ob das wirklich so alles stimmt!!
Mein Versuch der Umsetzung von Increment8 in ASM.
Die Implementierung zuvor hat immer Zugriffsverletzungen ausgel<65>st.
Vermutung: die alte Implementierung lag urspr<70>nglich ausserhalb der Klasse und wurde sp<73>ter
in die Klasse verschoben. Dabei ver<65>ndert sich aber die Nutzung der Register, da zus<75>tzlich
der SELF-Parameter in EAX <20>bergeben wird. Beim Schreiben nach auf Value wurde dann in die Instanz (Self)
geschrieben -> peng
}
{$IF defined(X86ASM) or defined(X64ASM)}
{$IFDEF X86ASM}
// type TData = packed array[0..7] of UInt32; 8x32bit
// TypeOf Param "Value" = TData
//
// EAX = Self
// EDX = Pointer to "Value"
// ECX = Value of "ADD"
register; // redundant but informative
asm
LEA EAX,[ECX*8] // EAX := ADD * 8
SHR ECX,29 // 29bit nach rechts schieben, 3bit beiben stehen
ADD [EDX].DWord[00],EAX // add [edx], eax TData(Value)[00] := TData(Value)[00] + EAX
ADC [EDX].DWord[04],ECX // adc [edx+$04], ecx TData(Value)[04] := TData(Value)[04] + ECX + Carry
ADC [EDX].DWord[08],0 // adc [edx+$08], 0 TData(Value)[08] := TData(Value)[08] + 0 + Carry
ADC [EDX].DWord[12],0 // adc [edx+$0c], 0 TData(Value)[12] := TData(Value)[12] + 0 + Carry
ADC [EDX].DWord[16],0 // adc [edx+$10], 0 TData(Value)[16] := TData(Value)[16] + 0 + Carry
ADC [EDX].DWord[20],0 // adc [edx+$14], 0 TData(Value)[20] := TData(Value)[20] + 0 + Carry
ADC [EDX].DWord[24],0 // adc [edx+$18], 0 TData(Value)[24] := TData(Value)[24] + 0 + Carry
ADC [EDX].DWord[28],0 // adc [edx+$1c], 0 TData(Value)[28] := TData(Value)[28] + 0 + Carry
JC RaiseHashOverflowError
end;
{$ENDIF !X86ASM}
{$IFDEF X64ASM}
// type TData = packed array[0..3] of UInt64; 4x64bit
// TypeOf Param "Value" = TData
//
// RCX = Self
// RDX = Pointer to "Value"
// R8D = Value of "ADD"
register; // redundant but informative
asm
SHL R8, 3 // R8 := Add * 8 the caller writes to R8D what automatically clears the high DWORD of R8
ADD QWORD PTR [RDX ], R8 // add [rdx], r8 TData(Value)[00] := TData(Value)[00] + R8
ADD QWORD PTR [RDX + 8], 0 // add [rdx+$08], 0 TData(Value)[08] := TData(Value)[08] + 0 + Carry
ADD QWORD PTR [RDX + 16], 0 // add [rdx+$10], 0 TData(Value)[16] := TData(Value)[16] + 0 + Carry
ADD QWORD PTR [RDX + 24], 0 // add [rdx+$18], 0 TData(Value)[24] := TData(Value)[24] + 0 + Carry
JC RaiseHashOverflowError;
end;
{$ENDIF !X64ASM}
{$ELSE PUREPASCAL}
type
TData = packed array[0..7] of UInt32;
var
HiBits: UInt32;
Add8: UInt32;
Carry: Boolean;
procedure AddC(var Value: UInt32; const Add: UInt32; var Carry: Boolean);
begin
if Carry then
begin
Value := Value + 1;
Carry := (Value = 0); // we might cause another overflow by adding the carry bit
end
else
Carry := False;
Value := Value + Add;
Carry := Carry or (Value < Add); // set Carry Flag on overflow or keep it if already set
end;
begin
HiBits := Add shr 29; // Save most significant 3 bits in case an overflow occurs
Add8 := Add * 8;
Carry := False;
AddC(TData(Value)[0], Add8, Carry);
AddC(TData(Value)[1], HiBits, Carry);
AddC(TData(Value)[2], 0, Carry);
AddC(TData(Value)[3], 0, Carry);
AddC(TData(Value)[4], 0, Carry);
AddC(TData(Value)[5], 0, Carry);
AddC(TData(Value)[6], 0, Carry);
AddC(TData(Value)[7], 0, Carry);
if Carry then
RaiseHashOverflowError;
end;
{$IFEND PUREPASCAL}
procedure TDECHash.RaiseHashOverflowError;
begin
raise EDECHashException.CreateRes(@sRaiseHashOverflowError);
end;
procedure TDECHash.SetPaddingByte(Value: Byte);
begin
FPaddingByte := Value;
end;
procedure TDECHash.RaiseHashNotInitialized;
begin
raise EDECHashException.CreateRes(@sHashNotInitialized);
end;
procedure TDECHash.Calc(const Data; DataSize: Integer);
var
Remain: Integer;
Value: PByte;
begin
if DataSize <= 0 then
Exit;
if not Assigned(FBuffer) then
RaiseHashNotInitialized;
Increment8(FCount, DataSize);
Value := @TByteArray(Data)[0];
if FBufferIndex > 0 then
begin
Remain := FBufferSize - FBufferIndex;
if DataSize < Remain then
begin
Move(Value^, FBuffer[FBufferIndex], DataSize);
Inc(FBufferIndex, DataSize);
Exit;
end;
Move(Value^, FBuffer[FBufferIndex], Remain);
DoTransform(Pointer(FBuffer));
Dec(DataSize, Remain);
Inc(Value, Remain);
end;
while DataSize >= FBufferSize do
begin
DoTransform(Pointer(Value));
Inc(Value, FBufferSize);
Dec(DataSize, FBufferSize);
end;
Move(Value^, FBuffer^, DataSize);
FBufferIndex := DataSize;
end;
function TDECHash.DigestAsBytes: TBytes;
begin
SetLength(Result, DigestSize);
if DigestSize <> 0 then
Move(Digest^, Result[0], DigestSize);
end;
function TDECHash.DigestAsRawByteString(Format: TDECFormatClass): RawByteString;
begin
Result := BytesToRawString(ValidFormat(Format).Encode(DigestAsBytes));
end;
function TDECHash.DigestAsString(Format: TDECFormatClass): string;
begin
Result := StringOf(ValidFormat(Format).Encode(DigestAsBytes));
end;
class function TDECHash.DigestSize: UInt32;
begin
// C++ does not support virtual static functions thus the base cannot be
// marked 'abstract'. This is our workaround:
raise EDECAbstractError.Create(GetShortClassName);
end;
class function TDECHash.BlockSize: UInt32;
begin
// C++ does not support virtual static functions thus the base cannot be
// marked 'abstract'. This is our workaround:
raise EDECAbstractError.Create(GetShortClassName);
end;
function TDECHash.CalcBuffer(const Buffer; BufferSize: Integer): TBytes;
var
DataPtr: PByte;
begin
Init;
if (FFinalByteLength = 0) or (BufferSize = 0) then
Calc(Buffer, BufferSize)
else
if (BufferSize > 0) then
begin
// Remember last byte as this might be required for padding for such
// algorithms which have some automatic padding logic
DataPtr := @Buffer;
Inc(DataPtr, BufferSize - 1);
FFinalByte := DataPtr^;
// Last byte is incomplete so do not process normally
Calc(Buffer, BufferSize-1);
end;
Done;
Result := DigestAsBytes;
end;
function TDECHash.CalcBytes(const Data: TBytes): TBytes;
begin
SetLength(Result, 0);
if Length(Data) > 0 then
Result := CalcBuffer(Data[0], Length(Data))
else
Result := CalcBuffer(Data, Length(Data));
end;
function TDECHash.CalcString(const Value: string; Format: TDECFormatClass): string;
var
Size : Integer;
Data : TBytes;
begin
Result := '';
if Length(Value) > 0 then
begin
{$IF CompilerVersion >= 24.0}
Size := Length(Value) * SizeOf(Value[low(Value)]);
Data := CalcBuffer(Value[low(Value)], Size);
{$ELSE}
Size := Length(Value) * SizeOf(Value[1]);
Data := CalcBuffer(Value[1], Size);
{$IFEND}
Result := StringOf(ValidFormat(Format).Encode(Data));
end
else
begin
SetLength(Data, 0);
result := StringOf(ValidFormat(Format).Encode(CalcBuffer(Data, 0)));
end;
end;
function TDECHash.CalcString(const Value: RawByteString; Format: TDECFormatClass): RawByteString;
var
Buf : TBytes;
begin
Result := '';
if Length(Value) > 0 then
{$IF CompilerVersion >= 24.0}
result := BytesToRawString(
ValidFormat(Format).Encode(
CalcBuffer(Value[low(Value)],
Length(Value) * SizeOf(Value[low(Value)]))))
{$ELSE}
result := BytesToRawString(
ValidFormat(Format).Encode(
CalcBuffer(Value[1],
Length(Value) * SizeOf(Value[1]))))
{$IFEND}
else
begin
SetLength(Buf, 0);
Result := BytesToRawString(ValidFormat(Format).Encode(CalcBuffer(Buf, 0)));
end;
end;
class function TDECHash.ClassByIdentity(Identity: Int64): TDECHashClass;
begin
Result := TDECHashClass(ClassList.ClassByIdentity(Identity));
end;
class function TDECHash.ClassByName(const Name: string): TDECHashClass;
begin
Result := TDECHashClass(ClassList.ClassByName(Name));
end;
procedure TDECHash.CalcStream(const Stream: TStream; Size: Int64;
var HashResult: TBytes; const OnProgress:TDECProgressEvent);
var
Buffer: TBytes;
Bytes: Integer;
Max, Pos: Int64;
begin
Assert(Assigned(Stream), 'Stream to calculate hash on is not assigned');
// Last byte is incomplete so it mustn't be processed
if (FFinalByteLength > 0) then
Dec(Size);
Max := 0;
SetLength(HashResult, 0);
try
Init;
if StreamBufferSize <= 0 then
StreamBufferSize := 8192;
Pos := Stream.Position;
if Size < 0 then
Size := Stream.Size - Pos;
Max := Pos + Size;
if Assigned(OnProgress) then
OnProgress(Max, 0, Started);
Bytes := StreamBufferSize mod FBufferSize;
if Bytes = 0 then
Bytes := StreamBufferSize
else
Bytes := StreamBufferSize + FBufferSize - Bytes;
if Bytes > Size then
SetLength(Buffer, Size)
else
SetLength(Buffer, Bytes);
while Size > 0 do
begin
Bytes := Length(Buffer);
if Bytes > Size then
Bytes := Size;
Stream.ReadBuffer(Buffer[0], Bytes);
Calc(Buffer[0], Bytes);
Dec(Size, Bytes);
Inc(Pos, Bytes);
if Assigned(OnProgress) then
OnProgress(Max, Pos, Processing);
end;
// Last byte is incomplete but algorithm may need its value for padding
if (FFinalByteLength > 0) then
Stream.ReadBuffer(FFinalByte, 1);
Done;
HashResult := DigestAsBytes;
finally
ProtectBytes(Buffer);
if Assigned(OnProgress) then
OnProgress(Max, Max, Finished);
end;
end;
function TDECHash.CalcStream(const Stream: TStream; Size: Int64;
Format: TDECFormatClass; const OnProgress:TDECProgressEvent): RawByteString;
var
Hash: TBytes;
begin
CalcStream(Stream, Size, Hash, OnProgress);
Result := BytesToRawString(ValidFormat(Format).Encode(Hash));
end;
procedure TDECHash.CalcFile(const FileName: string; var HashResult: TBytes;
const OnProgress:TDECProgressEvent);
var
S: TFileStream;
begin
SetLength(HashResult, 0);
S := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
try
CalcStream(S, S.Size, HashResult, OnProgress);
finally
S.Free;
end;
end;
function TDECHash.CalcFile(const FileName: string; Format: TDECFormatClass;
const OnProgress:TDECProgressEvent): RawByteString;
var
Hash: TBytes;
begin
CalcFile(FileName, Hash, OnProgress);
Result := BytesToRawString(ValidFormat(Format).Encode(Hash));
end;
{$IFDEF DELPHIORBCB}
procedure ModuleUnload(Instance: NativeInt);
var // automaticaly deregistration/releasing
i: Integer;
begin
if TDECHash.ClassList <> nil then
begin
for i := TDECHash.ClassList.Count - 1 downto 0 do
begin
if NativeInt(FindClassHInstance(TClass(TDECHash.ClassList[i]))) = Instance then
TDECHash.ClassList.Remove(TDECFormat.ClassList[i].Identity);
end;
end;
end;
{$ENDIF DELPHIORBCB}
initialization
// Code for packages and dynamic extension of the class registration list
{$IFDEF DELPHIORBCB}
AddModuleUnloadProc(ModuleUnload);
{$ENDIF DELPHIORBCB}
TDECHash.ClassList := TDECClassList.Create;
finalization
// Ensure no further instances of classes registered in the registration list
// are possible through the list after this unit has been unloaded by unloding
// the package this unit is in
{$IFDEF DELPHIORBCB}
RemoveModuleUnloadProc(ModuleUnload);
{$ENDIF DELPHIORBCB}
TDECHash.ClassList.Free;
end.

89
contrib/DelphiEncryptionCompendium/Source/DECHashBitBase.pas Normal file
View File

@@ -0,0 +1,89 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Base unit for all the hash algorithms which can operate on bit sized
/// messsages as well.
/// </summary>
unit DECHashBitBase;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
DECHashAuthentication, DECHashInterface, DECUtil;
type
/// <summary>
/// Base class for all hash algorithms which can operate on bit sized
/// messsages as well.
/// </summary>
TDECHashBit = class(TDECHashAuthentication, IDECHashBitsized)
strict private
/// <summary>
/// Returns the number of bits the final byte of the message consists of
/// </summary>
function GetFinalByteLength: UInt8;
/// <summary>
/// Sets the number of bits the final byte of the message consists of
/// </summary>
procedure SetFinalByteLength(const Value: UInt8);
public
/// <summary>
/// Setting this to a number of bits allows to process messages which have
/// a length which is not a exact multiple of bytes.
/// </summary>
property FinalByteLength : UInt8
read GetFinalByteLength
write SetFinalByteLength;
end;
implementation
resourcestring
/// <summary>
/// Exception message for the exception raised when a to long final byte
/// length is specified.
/// </summary>
rFinalByteLengthTooBig = 'Final byte length too big (%0:d) must be 0..7';
{ TDECHashBit }
function TDECHashBit.GetFinalByteLength: UInt8;
begin
Result := FFinalByteLength;
end;
procedure TDECHashBit.SetFinalByteLength(const Value: UInt8);
begin
// if length of final byte is 8 this value shall be 0 as the normal specification
// of message length is good enough then.
Assert(Value < 8, 'Length of final byte too big, a byte has 8 bit maximum');
if (Value > 7) then
raise EDECHashException.CreateFmt(rFinalByteLengthTooBig, [Value]);
FFinalByteLength := Value;
end;
end.

290
contrib/DelphiEncryptionCompendium/Source/DECHashInterface.pas Normal file
View File

@@ -0,0 +1,290 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit DECHashInterface;
interface
uses
{$IFDEF FPC}
SysUtils, Classes,
{$ELSE}
System.SysUtils, System.Classes,
{$ENDIF}
DECFormat, DECUtil;
type
/// <summary>
/// Generic interface for all hash classes.
/// Unfortunately without all the class methods, as they are not accepted
/// in interface declarations
/// </summary>
IDECHash = Interface
/// <summary>
/// Generic initialization of internal data structures. Additionally the
/// internal algorithm specific (because of being overridden by each
/// hash algorithm) DoInit method. Needs to be called before each hash
/// calculation.
/// </summary>
procedure Init;
/// <summary>
/// Calculates one chunk of data to be hashed.
/// </summary>
/// <param name="Data">
/// Data on which the hash value shall be calculated on
/// </param>
/// <param name="DataSize">
/// Size of the data in bytes
/// </param>
procedure Calc(const Data; DataSize: Integer);
/// <summary>
/// Frees dynamically allocated buffers in a way which safeguards agains
/// data stealing by other methods which afterwards might allocate this memory.
/// Additionaly calls the algorithm spercific DoDone method.
/// </summary>
procedure Done;
/// <summary>
/// Returns the calculated hash value as byte array
/// </summary>
function DigestAsBytes: TBytes;
/// <summary>
/// Returns the calculated hash value as formatted Unicode string
/// </summary>
/// <param name="Format">
/// Optional parameter. If a formatting class is being passed the formatting
/// will be applied to the returned string. Otherwise no formatting is
/// being used.
/// </param>
/// <returns>
/// Hash value of the last performed hash calculation
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the Unicode string might
/// result in strange characters in the returned result.
/// </remarks>
function DigestAsString(Format: TDECFormatClass = nil): string;
/// <summary>
/// Returns the calculated hash value as formatted RawByteString
/// </summary>
/// <param name="Format">
/// Optional parameter. If a formatting class is being passed the formatting
/// will be applied to the returned string. Otherwise no formatting is
/// being used.
/// </param>
/// <returns>
/// Hash value of the last performed hash calculation
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the RawByteString might
/// result in strange characters in the returned result.
/// </remarks>
function DigestAsRawByteString(Format: TDECFormatClass = nil): RawByteString;
/// <summary>
/// Calculates the hash value (digest) for a given buffer
/// </summary>
/// <param name="Buffer">
/// Untyped buffer the hash shall be calculated for
/// </param>
/// <param name="BufferSize">
/// Size of the buffer in byte
/// </param>
/// <returns>
/// Byte array with the calculated hash value
/// </returns>
function CalcBuffer(const Buffer; BufferSize: Integer): TBytes;
/// <summary>
/// Calculates the hash value (digest) for a given buffer
/// </summary>
/// <param name="Data">
/// The TBytes array the hash shall be calculated on
/// </param>
/// <returns>
/// Byte array with the calculated hash value
/// </returns>
function CalcBytes(const Data: TBytes): TBytes;
/// <summary>
/// Calculates the hash value (digest) for a given unicode string
/// </summary>
/// <param name="Value">
/// The string the hash shall be calculated on
/// </param>
/// <param name="Format">
/// Formatting class from DECFormat. The formatting will be applied to the
/// returned digest value. This parameter is optional.
/// </param>
/// <returns>
/// string with the calculated hash value
/// </returns>
function CalcString(const Value: string;
Format: TDECFormatClass = nil): string; overload;
/// <summary>
/// Calculates the hash value (digest) for a given rawbytestring
/// </summary>
/// <param name="Value">
/// The string the hash shall be calculated on
/// </param>
/// <param name="Format">
/// Formatting class from DECFormat. The formatting will be applied to the
/// returned digest value. This parameter is optional.
/// </param>
/// <returns>
/// string with the calculated hash value
/// </returns>
function CalcString(const Value: RawByteString;
Format: TDECFormatClass): RawByteString; overload;
/// <summary>
/// Calculates the hash value over a givens stream of bytes
/// </summary>
/// <param name="Stream">
/// Memory or file stream over which the hash value shall be calculated.
/// The stream must be assigned. The hash value will always be calculated
/// from the current position of the stream.
/// </param>
/// <param name="Size">
/// Number of bytes within the stream over which to calculate the hash value
/// </param>
/// <param name="HashResult">
/// In this byte array the calculated hash value will be returned
/// </param>
/// <param name="OnProgress">
/// Optional callback routine. It can be used to display the progress of
/// the operation.
/// </param>
procedure CalcStream(const Stream: TStream; Size: Int64; var HashResult: TBytes;
const OnProgress:TDECProgressEvent = nil); overload;
/// <summary>
/// Calculates the hash value over a givens stream of bytes
/// </summary>
/// <param name="Stream">
/// Memory or file stream over which the hash value shall be calculated.
/// The stream must be assigned. The hash value will always be calculated
/// from the current position of the stream.
/// </param>
/// <param name="Size">
/// Number of bytes within the stream over which to calculate the hash value
/// </param>
/// <param name="Format">
/// Optional formatting class. The formatting of that will be applied to
/// the returned hash value.
/// </param>
/// <param name="OnProgress">
/// Optional callback routine. It can be used to display the progress of
/// the operation.
/// </param>
/// <returns>
/// Hash value over the bytes in the stream, formatted with the formatting
/// passed as format parameter, if used.
/// </returns>
function CalcStream(const Stream: TStream; Size: Int64; Format: TDECFormatClass = nil;
const OnProgress:TDECProgressEvent = nil): RawByteString; overload;
/// <summary>
/// Calculates the hash value over the contents of a given file
/// </summary>
/// <param name="FileName">
/// Path and name of the file to be processed
/// </param>
/// <param name="HashResult">
/// Here the resulting hash value is being returned as byte array
/// </param>
/// <param name="OnProgress">
/// Optional callback. If being used the hash calculation will call it from
/// time to time to return the current progress of the operation
/// </param>
procedure CalcFile(const FileName: string; var HashResult: TBytes;
const OnProgress:TDECProgressEvent = nil); overload;
/// <summary>
/// Calculates the hash value over the contents of a given file
/// </summary>
/// <param name="FileName">
/// Path and name of the file to be processed
/// </param>
/// <param name="Format">
/// Optional parameter: Formatting class. If being used the formatting is
/// being applied to the returned string with the calculated hash value
/// </param>
/// <param name="OnProgress">
/// Optional callback. If being used the hash calculation will call it from
/// time to time to return the current progress of the operation
/// </param>
/// <returns>
/// Calculated hash value as RawByteString.
/// </returns>
/// <remarks>
/// We recommend to use a formatting which results in 7 bit ASCII chars
/// being returned, otherwise the conversion into the RawByteString might
/// result in strange characters in the returned result.
/// </remarks>
function CalcFile(const FileName: string; Format: TDECFormatClass = nil;
const OnProgress:TDECProgressEvent = nil): RawByteString; overload;
/// <summary>
/// Returns the current value of the padding byte used to fill up data
/// if necessary
/// </summary>
function GetPaddingByte: Byte;
/// <summary>
/// Changes the value of the padding byte used to fill up data
/// if necessary
/// </summary>
/// <param name="Value">
/// New value for the padding byte
/// </param>
procedure SetPaddingByte(Value: Byte);
/// <summary>
/// Defines the byte used in the KDF methods to padd the end of the data
/// if the length of the data cannot be divided by required size for the
/// hash algorithm without reminder
/// </summary>
property PaddingByte: Byte read GetPaddingByte write SetPaddingByte;
end;
/// <summary>
/// Interface for all hash classes which are able to operate on bit sized
/// message lengths instead of byte sized ones only.
/// </summary>
IDECHashBitsized = Interface(IDECHash)
/// <summary>
/// Returns the number of bits the final byte of the message consists of
/// </summary>
function GetFinalByteLength: UInt8;
/// <summary>
/// Sets the number of bits the final byte of the message consists of
/// </summary>
procedure SetFinalByteLength(const Value: UInt8);
/// <summary>
/// Setting this to a number of bits allows to process messages which have
/// a length which is not a exact multiple of bytes.
/// </summary>
property FinalBitLength : UInt8
read GetFinalByteLength
write SetFinalByteLength;
end;
implementation
end.

210
contrib/DelphiEncryptionCompendium/Source/DECOptions.inc Normal file
View File

@@ -0,0 +1,210 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
//------------------------------------------------------------------------------
// Reset Defines (do not change!)
//------------------------------------------------------------------------------
{$UNDEF NATIVEINT_UNDEFINED}
{$UNDEF PUREPASCAL}
{$UNDEF X86ASM}
{$UNDEF X64ASM}
{$UNDEF NO_ASM}
{$UNDEF OLD_SHA_NAME}
{$UNDEF OLD_WHIRLPOOL_NAMES}
{$UNDEF OLD_REGISTER_FAULTY_CIPHERS}
{$UNDEF AUTO_PRNG}
{$UNDEF DEC52_IDENTITY}
{$UNDEF DEC3_CMCTS}
{$UNDEF RESTORE_RANGECHECKS}
{$UNDEF RESTORE_OVERFLOWCHECKS}
//------------------------------------------------------------------------------
// User Configuration (feel free to edit)
//------------------------------------------------------------------------------
// If on, the old class name THash_SHA for the THash_SHA0 class will be available
// This should only be necessary for cases where the identity value has been
// used to determine the algorithm to be used and thus it's necessary that the
// same result will be produced. It is recommended to switch to the new class
// names where possible
// Currently this does not work together with using x86 ASM! Either ASM or the
// old name works
{.$DEFINE OLD_SHA_NAME} (* default off *)
// if on the old outdated class names THash_Whirlpool and THash_Whirlpool1 are
// being used. Nowadays Whirlpool versions are named like this:
// Whirlpool -> Whirlpool0. Whrilpool1 -> WhirlpoolT and there's a new Whirlpool1
// variant which differs to WhrilpoolT only by the initialization of internal data
// This should only be necessary for cases where the identity value has been
// used to determine the algorithm to be used and thus it's necessary that the
// same result will be produced. It is recommended to switch to the new class
// names where possible
{.$DEFINE OLD_WHIRLPOOL_NAMES} (* default off *)
// when enabling this define, the automatic registration of all those cipher and
// hash classes in initialization sections is not being done.
{.$DEFINE ManualRegisterClasses} (* default off *}
// Automatically use DEC's Pseudo Random Number Generator
{$DEFINE AUTO_PRNG} (* default ON *)
// if the compiler does not support assembler turn usage off and even if restrict
// it to Windows, as those non Windows platforms which actually do support ASM
// in Delphi do not use Intel x86 ASM
{$IFNDEF FPC}
{$IFNDEF ASSEMBLER}
{$DEFINE NO_ASM} (* default ON *)
{$ELSE}
{$IFDEF WINDOWS}
{.$DEFINE NO_ASM} (* default OFF *)
{$ELSE
{$DEFINE NO_ASM} (* default ON *)
{$ENDIF}
{$ENDIF}
{$ELSE}
// Turn ASM off for FPC as we do not know enough about ASM support on FPC
{$DEFINE NO_ASM} (* default ON *)
{$ENDIF}
// Enable the following option to restore the *wrong* Identity behavior of
// DEC version 5.2. See TDECObject.Identity in DECBaseClass.pas for more details
{.$DEFINE DEC52_IDENTITY} (* default OFF *)
// Enable the following option to include the cmCTS3 block cipher mode in
// DECCipher. This mode is less secure due to the padding used on data smaller
// that cipher's block size but it might help when having to deal with
// data which needs to be compatible to the DEC 3.0 cmCTS mode. Not recommended!
{.$DEFINE DEC3_CMCTS} (* default OFF *)
/// <summary>
/// When building a Firemonkey project for non Windows platforms
/// ressource strings are not available. Enabling this enables some
/// alternative translation mechanism for exception messages based
/// on Firemonkey's TLang architecture
/// </summary>
{$IF DECLARED(FireMonkeyVersion)}
{$DEFINE FMXTranslateableExceptions}
{$IFEND} { TODO: convert to $ENDIF when raising minimum supported version to XE4+}
//------------------------------------------------------------------------------
// Do NOT change anything below!
//------------------------------------------------------------------------------
{$DEFINE DELPHIORBCB}
//------------------------------------------------------------------------------
// FPC v2.x support (Experimental)
//------------------------------------------------------------------------------
{$IFDEF FPC}
{$UNDEF DELPHIORBCB}
{$DEFINE PUREPASCAL}
{$DEFINE NATIVEINT_UNDEFINED}
// use compatibility mode
{$MODE DELPHI}
// defines for Mac OS X
{$IFDEF DARWIN}
{$DEFINE MACOS}
{$DEFINE ALIGN_STACK}
{$ENDIF}
{$ENDIF FPC}
//------------------------------------------------------------------------------
// Architecture (x86ASM, x64ASM, PurePascal)
//------------------------------------------------------------------------------
//{$DEFINE NO_ASM}
{$IFDEF NO_ASM}
// User config override (see top of this file)
{$UNDEF X86ASM}
{$UNDEF X64ASM}
{$DEFINE PUREPASCAL}
{$ENDIF}
{$IFNDEF PUREPASCAL}
// ignored by FPC (already in PurePascal mode as defined in FPC block above)
{$IFDEF CPUX86}
{$DEFINE X86ASM}
{$ELSE !CPUX86}
{$IFDEF CPUX64}
{$DEFINE X64ASM}
{$ELSE !CPUX64}
{$DEFINE PUREPASCAL}
{$ENDIF !CPUX64}
{$ENDIF}
{$ENDIF !PUREPASCAL}
{$IF SizeOf(Pointer) = 4}
{$DEFINE CPU32BITS}
{$IFEND}
{$IF SizeOf(Pointer) = 8}
{$DEFINE CPU64BITS}
{$IFEND}
//------------------------------------------------------------------------------
// Delphi and C++ Builder
//------------------------------------------------------------------------------
{$IFDEF DELPHIORBCB}
{$BOOLEVAL OFF} // short-circuit bool eval (Default OFF; Local Scope)
{$IF CompilerVersion >= 20} // Delphi 2009 and newer
{$IF CompilerVersion >= 21} // Delphi 2010 and newer
{$DEFINE DELPHI_2010_UP}
{$IFEND}
{$ELSE}
Sorry, but Delphi 2007 and lower are no longer supported!
{$IFEND}
{$ENDIF}
//------------------------------------------------------------------------------
// Asm Core
//------------------------------------------------------------------------------
{$IFDEF X86ASM}
{$DEFINE THash_MD4_asm}
{$DEFINE THash_MD5_asm}
{$DEFINE THash_RipeMD128_asm}
{$DEFINE THash_RipeMD160_asm}
{$DEFINE THash_RipeMD256_asm}
{$DEFINE THash_RipeMD320_asm}
{$DEFINE THash_SHA_asm}
{$DEFINE THash_SHA256_asm}
{$DEFINE THashBaseHaval_asm}
{$DEFINE THash_Panama_asm}
{$DEFINE THashBaseWhirlpool_asm}
{$DEFINE THash_Sapphire_asm}
// The following asm optimized Hashes were incompatible with newer C++
// Builder versions. Due to the fact that BCB detection is not implemented
// in newer Delphi versions anymore, we leave them out for now:
// {$DEFINE THash_MD2_asm}
// {$DEFINE THash_SHA384_asm}
// {$DEFINE THash_Tiger_asm}
// {$DEFINE THash_Square_asm}
// {$DEFINE THash_Snefru128_asm}
// {$DEFINE THash_Snefru256_asm}
{$ENDIF}

431
contrib/DelphiEncryptionCompendium/Source/DECRandom.pas Normal file
View File

@@ -0,0 +1,431 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Secure Pseudo Random Number Generator based on Yarrow. If used without
/// doing anything special for initialization a repeatable generator will be
/// initialized always using the same start value.
/// </summary>
unit DECRandom;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils,
{$ELSE}
System.SysUtils,
{$ENDIF}
DECHashBase, DECHash;
/// <summary>
/// Create a seed for the random number generator from system time and
/// PerformanceCounter.
/// </summary>
/// <remarks>
/// Avoid initializing the seed using this fuction if you can as it is not
/// really secure. Use RandomBuffer instead and provide user generated input
/// as Buffer value but ensure that this is not uniform e.g. not a buffer only
/// containing $00 all over or something like this.
/// </remarks>
/// <returns>
/// Created hash value
/// </returns>
function RandomSystemTime: Int64;
/// <summary>
/// Fills the provided buffer with random values. If the DoRandomBuffer
/// variable is assigned (which is usually the case because DoBuffer is
/// assigned to it in initialization of this unit) the hash based algorithm
/// in DoBuffer will be used, otherwise the weaker one in DoRndBuffer.
/// </summary>
/// <param name="Buffer">
/// Buffer to be filled with random values
/// </param>
/// <param name="Size">
/// Size of the buffer in byte
/// </param>
procedure RandomBuffer(out Buffer; Size: Integer);
/// <summary>
/// Creates a buffer of the specified size filled with random bytes
/// </summary>
/// <param name="Size">
/// Size of the buffer to be created in bytes
/// </param>
/// <returns>
/// Buffer of the specified size in bytes filled with random data
/// </returns>
function RandomBytes(Size: Integer): TBytes;
/// <summary>
/// Creates a RawByteString of the specified length filled with random bytes.
/// </summary>
/// <remarks>
/// This function is deprecated. Better use RandomBytes where ever possible!
/// </remarks>
/// <param name="Size">
/// Length of the string to be created in bytes
/// </param>
/// <returns>
/// String of the specified length in bytes filled with random data
/// </returns>
function RandomRawByteString(Size: Integer): RawByteString; deprecated 'please use RandomBytes now';
/// <summary>
/// Creates a random UInt32 value
/// </summary>
/// <returns>
/// Random value
/// </returns>
function RandomLong: UInt32;
/// <summary>
/// If the default value of the global DoRandomSeed variable is kept, this
/// procedure initializes a repeatable or a non repeatable seed,
/// depending on the parameters specified. Otherwise the alternative DoRandomSeed
/// implementation is called. The FRndSeed variable is initialized with the
/// seed value generated.
/// </summary>
/// <param name="Buffer">
/// If a repeatable seed is to be initialized, the contents of this buffer is
/// a parameter to the seed generation and a buffer containing at least Size
/// bytes needs to be passed.
/// </param>
/// <param name="Size">
/// If Size is > 0 a repeatable seed is initialized. If Size is 0 the
/// internal seed variable FRndSeed is initialized with 0. If Size is
/// less than 0 the internal FRndSeed variable is initialized with
/// a value derrived from current system time/performance counter using
/// RandomSystemTime.
/// </param>
procedure RandomSeed(const Buffer; Size: Integer); overload;
/// <summary>
/// Creates a seed (starting) value for the random number generator. If the
/// default value of the global DoRandomSeed variable is kept, a non repeatable
/// seed based on RandomSystemTime (based on system time and potentially
/// QueryPerformanceCounter) is created and assigned to the internal FRndSeed
/// variable.
/// </summary>
procedure RandomSeed; overload;
var
// secure PRNG initialized by this unit
/// <summary>
/// This variable allows overriding the random number generation procedure
/// used for data buffers. By default it is initialized to point to DoBuffer,
/// which is a DECRandom internal procedure.
/// </summary>
/// <param name="Buffer">
/// Buffer in which the random bytes shall be written. The buffer needs to
/// exist and must be of at least Size bytes length.
/// </param>
/// <param name="Size">
/// Length of the buffer to be filled in Byte.
/// </param>
DoRandomBuffer: procedure(out Buffer; Size: Integer); register = nil;
/// <summary>
/// This variable allows overriding the seed value generation procedure.
/// By default it is initialized with the DECRandom internal procedure DoSeed.
/// </summary>
DoRandomSeed: procedure(const Buffer; Size: Integer); register = nil;
/// <summary>
/// Defines the hash-algorithm used for generatin seed values or hashed buffers
/// </summary>
RandomClass: TDECHashClass = THash_SHA256;
implementation
uses
{$IFDEF DELPHI_2010_UP}
System.Diagnostics
{$ELSE}
{$IFDEF FPC}
{$IFDEF MSWINDOWS}
Windows
{$ELSE}
LclIntf
{$ENDIF}
{$ELSE}
Winapi.Windows
{$ENDIF}
{$ENDIF}
;
{$IFOPT Q+}{$DEFINE RESTORE_OVERFLOWCHECKS}{$Q-}{$ENDIF}
{$IFOPT R+}{$DEFINE RESTORE_RANGECHECKS}{$R-}{$ENDIF}
var
/// <summary>
/// A sequence of values which over time will be random by replacing each
/// value with a derived value generated by applying the hash algorithm.
/// </summary>
FRegister: array[0..127] of Byte;
/// <summary>
/// The hash used to generate derived values stored in FRegister is calculated
/// using this counter as input and this counter additionaly defines the index
/// in FRegister where the value will be stored. The counter can assume higher
/// values than the lngth of FRegister. The index calculation takes this into
/// account.
/// </summary>
FCounter: Cardinal;
/// <summary>
/// Object instance for the hash generation algorithm used. The object is
/// created the first time it is needed and freed in finalization of this unit.
/// </summary>
FHash: TDECHash = nil;
/// <summary>
/// Seed value, stores the last generated random number as start value for
/// the next randum number generation
/// </summary>
FRndSeed: Cardinal = 0;
function RandomSystemTime: Int64;
type
TInt64Rec = packed record
Lo, Hi: UInt32;
end;
var
{$IF defined(MSWINDOWS) and not defined(DELPHI_2010_UP)}
SysTime: TSystemTime;
{$ELSE}
Hour, Minute, Second, Milliseconds: Word;
{$IFEND}
Counter: TInt64Rec;
Time: Cardinal;
begin
{$IF defined(MSWINDOWS) and not defined(DELPHI_2010_UP)}
GetSystemTime(SysTime);
Time := ((Cardinal(SysTime.wHour) * 60 + SysTime.wMinute) * 60 + SysTime.wSecond) * 1000 + SysTime.wMilliseconds;
QueryPerformanceCounter(Int64(Counter));
{$ELSE}
DecodeTime(Now, Hour, Minute, Second, Milliseconds);
Time := ((Cardinal(Hour) * 60 + Minute) * 60 + Second) * 1000 + Milliseconds;
{$IFDEF DELPHI_2010_UP}
Int64(Counter) := TStopWatch.GetTimeStamp; // uses System.Diagnostics
{$ELSE}
{$IFDEF FPC}
Int64(Counter) := LclIntf.GetTickCount * 10000 {TicksPerMillisecond}; // uses LclIntf
{$ENDIF}
{$ENDIF}
{$IFEND}
Result := Time + Counter.Hi;
Inc(Result, Ord(Result < Time)); // add "carry flag"
Inc(Result, Counter.Lo);
end;
/// <summary>
/// Simplistic algorithm for filling a buffer with random numbers. This
/// algorithm is directly dependant on the seed passed, which by internal use
/// will normally be FRndSeed.
/// </summary>
/// <param name="Seed">
/// Seed value as starting value
/// </param>
/// <param name="Buffer">
/// Buffer which shall be filled with random bytes
/// </param>
/// <param name="Size">
/// Size of the buffer in byte
/// </param>
/// <returns>
/// New seed value after calculating the random number for the last byte in
/// the buffer.
/// </returns>
function DoRndBuffer(Seed: Cardinal; out Buffer; Size: Integer): Cardinal;
// comparable to Delphi Random() function
var
P: PByte;
begin
Result := Seed;
P := @Buffer;
if P <> nil then
begin
while Size > 0 do
begin
Result := Result * $08088405 + 1;
P^ := Byte(Result shr 24);
Inc(P);
Dec(Size);
end;
end;
end;
procedure RandomBuffer(out Buffer; Size: Integer);
begin
if Assigned(DoRandomBuffer) then
DoRandomBuffer(Buffer, Size)
else
FRndSeed := DoRndBuffer(FRndSeed, Buffer, Size);
end;
function RandomBytes(Size: Integer): TBytes;
begin
SetLength(Result, Size);
RandomBuffer(Result[0], Size);
end;
function RandomRawByteString(Size: Integer): RawByteString;
begin
SetLength(Result, Size);
{$IF CompilerVersion >= 24.0}
RandomBuffer(Result[Low(Result)], Size);
{$ELSE}
RandomBuffer(Result[1], Size);
{$IFEND}
end;
function RandomLong: UInt32;
begin
RandomBuffer(Result, SizeOf(Result));
end;
procedure RandomSeed(const Buffer; Size: Integer);
begin
if Assigned(DoRandomSeed) then
DoRandomSeed(Buffer, Size)
else
begin
if Size >= 0 then
begin
FRndSeed := 0;
while Size > 0 do
begin
Dec(Size);
FRndSeed := (FRndSeed shl 8 + FRndSeed shr 24) xor TByteArray(Buffer)[Size]
end;
end
else
FRndSeed := RandomSystemTime;
end;
end;
procedure RandomSeed;
begin
RandomSeed('', -1);
end;
/// <summary>
/// Generate one random byte and modify FCounter and FRegister
/// </summary>
function DoGenerateRandomByte: Byte;
begin
if FHash = nil then
FHash := RandomClass.Create;
FHash.Init;
FHash.Calc(FCounter, SizeOf(FCounter));
FHash.Calc(FRegister, SizeOf(FRegister));
FHash.Done;
FRegister[FCounter mod SizeOf(FRegister)] := FRegister[FCounter mod SizeOf(FRegister)] xor FHash.DigestAsBytes[0];
Inc(FCounter);
Result := FHash.DigestAsBytes[1]; // no real predictable dependency to above FHash.Digest[0] !
end;
procedure DoBuffer(out Buffer; Size: Integer);
var
i: Integer;
begin
for i := 0 to Size - 1 do
TByteArray(Buffer)[i] := DoGenerateRandomByte;
end;
/// <summary>
/// Initializes a repeatable or a non repeatable seed, depending on the
/// parameters specified
/// </summary>
/// <param name="Buffer">
/// If a repeatable seed is to be initialized, the contents of this buffer is
/// a parameter to the seed generation and a buffer containing at least Size
/// bytes needs to be passed.
/// </param>
/// <param name="Size">
/// If Size is >= 0 a repeatable seed is initialized, otherwise a non repeatable
/// based on system time
/// </param>
procedure DoSeed(const Buffer; Size: Integer);
var
i: Integer;
t: Cardinal;
begin
if Size >= 0 then
begin
// initalize a repeatable Seed
FillChar(FRegister, SizeOf(FRegister), 0);
FCounter := 0;
for i := 0 to Size - 1 do
FRegister[i mod SizeOf(FRegister)] := FRegister[i mod SizeOf(FRegister)] xor TByteArray(Buffer)[i];
end
else
begin
// ! ATTENTION !
// Initalizes a non-repeatable Seed based on Timers, which is not secure
// and inpredictable. The user should call RandomSeed(Data, SizeOf(Data))
// instead, where Date contains i.e. user generated (Human) input.
t := RandomSystemTime;
for i := Low(FRegister) to High(FRegister) do
begin
FRegister[i] := FRegister[i] xor Byte(t);
t := t shl 1 or t shr 31;
end;
end;
for i := Low(FRegister) to High(FRegister) do
DoGenerateRandomByte;
FCounter := 0;
end;
procedure DoInit;
begin
DoRandomBuffer := DoBuffer;
DoRandomSeed := DoSeed;
DoSeed('', 0);
end;
procedure DoDone;
begin
try
if FHash <> nil then
FHash.Free;
except
end;
FHash := nil;
FillChar(FRegister, SizeOf(FRegister), 0);
FCounter := 0;
end;
{$IFDEF RESTORE_RANGECHECKS}{$R+}{$ENDIF}
{$IFDEF RESTORE_OVERFLOWCHECKS}{$Q+}{$ENDIF}
initialization
{$DEFINE AUTO_PRNG}
DoInit;
{$IFDEF AUTO_PRNG} // see DECOptions.inc
RandomSeed;
{$ENDIF AUTO_PRNG}
finalization
DoDone;
end.

52
contrib/DelphiEncryptionCompendium/Source/DECTypes.pas Normal file
View File

@@ -0,0 +1,52 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Declarations of various datatypes, some of those have not been
/// declared for certain platforms but are used in DEC and some do change
/// meanings between platforms like PLongWord where LongWord is 32 bit on
/// Windows and Android but 64 bit on iOS for instance
/// </summary>
unit DECTypes;
interface
type
{$IFNDEF FPC}
{$IF CompilerVersion <= 20}
// In D2009 NativeInt was not properly treated by the compiler under certain
// conditions. See: http://qc.embarcadero.com/wc/qcmain.aspx?d=71292
NativeInt = Integer;
{$IFEND}
{$ENDIF}
PUInt32Array = ^TUInt32Array;
TUInt32Array = array[0..1023] of UInt32;
/// <summary>
/// Replacement for PLongWord, as LongWord changes between platforms from
/// 32 to 64 bit
/// </summary>
PUInt32 = ^UINT32;
PUInt64Array = ^TUInt64Array;
TUInt64Array = array[0..1023] of UInt64;
implementation
end.

733
contrib/DelphiEncryptionCompendium/Source/DECUtil.pas Normal file
View File

@@ -0,0 +1,733 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory
of this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Utility functions
/// </summary>
unit DECUtil;
interface
{$INCLUDE DECOptions.inc}
uses
{$IFDEF FPC}
SysUtils, Classes;
{$ELSE}
System.SysUtils, System.Classes;
{$ENDIF}
type
// Exception Classes
/// <summary>
/// Base exception class for all DEC specific exceptions,
/// </summary>
EDECException = class(Exception)
public
{$IFDEF FMXTranslateableExceptions}
/// <summary>
/// Creates the exception instance and makes the exception message translateable
/// via Firemonkey's TLang translation mechanism. Normal ressource strings
/// are not translated in the same way on mobile platforms as they are on
/// Win32/Win64.
/// </summary>
/// <param name="Msg">
/// String with a failure message to be output or logged
/// </param>
constructor Create(const Msg: string); reintroduce; overload;
/// <summary>
/// Creates the exception instance and makes the exception message translateable
/// via Firemonkey's TLang translation mechanism. Normal ressource strings
/// are not translated in the same way on mobile platforms as they are on
/// Win32/Win64.
/// </summary>
/// <param name="Msg">
/// String with a failure message to be output or logged
/// </param>
/// <param name="Args">
/// Array with values for the parameters specified in the format string
/// </param>
constructor CreateFmt(const Msg: string;
const Args: array of const); reintroduce; overload;
{$ENDIF}
end;
/// <summary>
/// Exception class used when reporting that a class searched in a list is
/// not contained in that list, e.g. when searching for a non existant
/// formatting class.
/// </summary>
EDECClassNotRegisteredException = class(EDECException);
/// <summary>
/// Exception class for reporting formatting related exceptions
/// </summary>
EDECFormatException = class(EDECException);
/// <summary>
/// Exception class for reporting exceptions related to hash functions
/// </summary>
EDECHashException = class(EDECException);
/// <summary>
/// Exception class for reporting encryption/decryption caused exceptions
/// </summary>
EDECCipherException = class(EDECException);
/// <summary>
/// Exception class for reporting the use of abstract things which cannot
/// be called directly
/// </summary>
EDECAbstractError = class(EDECException)
/// <summary>
/// Create the exception using a meaningfull error message
/// </summary>
constructor Create(ClassName: string); overload;
end;
/// <summary>
/// Reason for calling the progress event
/// </summary>
TDECProgressState = (Started, Processing, Finished {, Error});
/// <summary>
/// Event type used by several hash- and cipher methods to display their
/// progress. It can be implemented as regular method, procedure and as
/// anonymous method, means: in place.
/// </summary>
/// <param name="Size">
/// Number of bytes to process. For files this is usually the file size. For
/// streams this can be less than the stream size if the stream is not being
/// processed from the beginning.
/// </param>
/// <param name="Pos">
/// Position within size in byte. For streams this may be a position
/// relative to the starting position for processing.
/// </param>
TDECProgressEvent = reference to procedure(Size, Pos: Int64; State: TDECProgressState);
// Byte Ordering
/// <summary>
/// Reverses all bits in the passed value, 1111 0000 will be 0000 1111 afterwards
/// </summary>
/// <param name="Source">
/// Value who's bits are to be reversed
/// </param>
/// <returns>
/// Representation of Source but with all bits reversed
/// </returns>
function ReverseBits(Source: UInt32): UInt32; overload;
/// <summary>
/// Reverses all bits in the passed value, 1111 0000 will be 0000 1111 afterwards
/// </summary>
/// <param name="Source">
/// Value who's bits are to be reversed
/// </param>
/// <returns>
/// Representation of Source but with all bits reversed
/// </returns>
function ReverseBits(Source: UInt8): UInt8; overload;
/// <summary>
/// Reverses the order of the bytes contained in the buffer passed in.
/// e.g. 1 2 3 will be 3 2 1 afterwards
/// </summary>
/// <param name="Buffer">
/// Buffer who's contents is to be reversed.
/// </param>
/// <param name="Size">
/// Size of the passed buffer in byte
/// </param>
procedure SwapBytes(var Buffer; Size: Integer);
/// <summary>
/// Reverses the byte order of the passed variable
/// </summary>
/// <param name="Source">
/// value who's byte order shall be reversed
/// </param>
/// <returns>
/// value of the passed vallue with reversed byte order
/// </returns>
function SwapUInt32(Source: UInt32): UInt32;
/// <summary>
/// Reverses the byte order for all entries of a passed array of UInt32 values
/// </summary>
/// <param name="Source">
/// Data with a layout like an array of UInt32 values for which the byte order
/// of all entries shall be reversed
/// </param>
/// <param name="Dest">
/// In this variable the reversed values will be stored. Layout is like an
/// array of UInt32 values
/// </param>
/// <param name="Count">
/// Number of values to be reversed
/// </param>
procedure SwapUInt32Buffer(const Source; var Dest; Count: Integer);
/// <summary>
/// Reverses the byte order of an Int64 value
/// </summary>
/// <param name="Source">
/// Value who's byte order shall be reversed
/// </param>
/// <returns>
/// Representation of the passed value after reversing its byte order
/// </returns>
function SwapInt64(Source: Int64): Int64;
/// <summary>
/// Reverses the byte order for all entries of a passed array of Int64 values
/// </summary>
/// <param name="Source">
/// Data with a layout like an array of Int64 values for which the byte order
/// of all entries shall be reversed
/// </param>
/// <param name="Dest">
/// In this variable the reversed values will be stored. Layout is like an
/// array of Int64 values
/// </param>
/// <param name="Count">
/// Number of values to be reversed
/// </param>
procedure SwapInt64Buffer(const Source; var Dest; Count: Integer);
/// <summary>
/// XORs the contents of two passed buffers and stores the result into a 3rd one
/// </summary>
/// <param name="Left">
/// One source buffer of bytes to be XORed
/// </param>
/// <param name="Right">
/// The other source buffer of bytes to be XORed. Buffer size must be equal
/// or bigger than Left
/// </param>
/// <param name="Size">
/// Buffer size in byte.
/// </param>
/// <param name="Dest">
/// Buffer where the result is to be stored in. Must be of equal or bigger
/// size than Left
/// </param>
procedure XORBuffers(const Left, Right; Size: Integer; var Dest);
// Buffer and Data Protection
/// <summary>
/// Fills a given buffer with zeros in a secure way
/// </summary>
/// <param name="Buffer">
/// Buffer to be zeroed. In case of TBytes to be passed as Buf[0]
/// </param>
/// <param name="Size">
/// Buffer size in byte
/// </param>
procedure ProtectBuffer(var Buffer; Size: NativeUInt);
/// <summary>
/// Fills a given stream with zeros in a secure way
/// </summary>
/// <param name="Stream">
/// Stream to be zeroed.
/// </param>
/// <param name="SizeToProtect">
/// Number of bytes of that stream to be zeroed. Starting point is Stream.Position
/// </param>
procedure ProtectStream(Stream: TStream; SizeToProtect: Int64 = 0);
/// <summary>
/// Fills a given byte array with zeros in a secure way and then empties the
/// buffer.
/// </summary>
/// <param name="Source">
/// Byte array to be zeroed. The length of the passed buffer is 0 afterwards!
/// </param>
procedure ProtectBytes(var Source: TBytes);
/// <summary>
/// Overwrites the string's contents in a secure way and returns an empty string.
/// </summary>
/// <param name="Source">
/// String to be safely overwritten
/// </param>
procedure ProtectString(var Source: string); overload;
/// <summary>
/// Overwrites the string's contents in a secure way and returns an empty string.
/// </summary>
/// <param name="Source">
/// String to be safely overwritten
/// </param>
procedure ProtectString(var Source: RawByteString); overload;
{$IFDEF ANSISTRINGSUPPORTED}
/// <summary>
/// Overwrites the string's contents in a secure way and returns an empty string.
/// </summary>
/// <param name="Source">
/// String to be safely overwritten
/// </param>
procedure ProtectString(var Source: AnsiString); overload;
{$ENDIF}
{$IFNDEF NEXTGEN}
/// <summary>
/// Overwrites the string's contents in a secure way and returns an empty string.
/// </summary>
/// <param name="Source">
/// String to be safely overwritten
/// </param>
procedure ProtectString(var Source: WideString); overload;
{$ENDIF}
// Byte/String conversion
/// <summary>
/// Converts a byte array to a RawByteString
/// </summary>
/// <param name="Source">
/// Byte array to be converted into a string. An empty byte array is allowed
/// and results in an empty string.
/// </param>
/// <returns>
/// RawByteString with the same length as Source and all bytes copied over.
/// No conversion of any sort is being applied to the bytes.
/// </returns>
/// <remarks>
/// Not easily replaced by some RTL function as none for TBytes to RawByteString
/// seems to exist
/// </remarks>
function BytesToRawString(const Source: TBytes): RawByteString;
implementation
{$IFDEF FMXTranslateableExceptions}
uses
FMX.Types,
{$ELSE}
uses
{$ENDIF}
DECUtilRawByteStringHelper, DECTypes;
const
{ TODO :
Pr<EFBFBD>fen warum das eine Konstante ist, die gleich vom Ressourcestring
benutzt wird. Weil es keine Ressorcestrings bei FMX gibt? }
cAbstractError = 'Abstract Error: %s is not implemented';
resourcestring
sAbstractError = cAbstractError;
const
// Bit Lookup Table - see 'Bit Twiddling Hacks' by Sean Eron Anderson
// http://graphics.stanford.edu/~seander/bithacks.html
ReverseBitLookupTable256: array[0..255] of Byte = ($00, $80, $40, $C0,
$20, $A0, $60, $E0, $10, $90, $50, $D0, $30, $B0, $70, $F0, $08, $88,
$48, $C8, $28, $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8,
$04, $84, $44, $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4,
$74, $F4, $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC,
$3C, $BC, $7C, $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92,
$52, $D2, $32, $B2, $72, $F2, $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA,
$1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA, $06, $86, $46, $C6, $26, $A6,
$66, $E6, $16, $96, $56, $D6, $36, $B6, $76, $F6, $0E, $8E, $4E, $CE,
$2E, $AE, $6E, $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81,
$41, $C1, $21, $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1,
$09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, $39, $B9,
$79, $F9, $05, $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5,
$35, $B5, $75, $F5, $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D,
$5D, $DD, $3D, $BD, $7D, $FD, $03, $83, $43, $C3, $23, $A3, $63, $E3,
$13, $93, $53, $D3, $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB,
$6B, $EB, $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7,
$27, $A7, $67, $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7, $0F, $8F,
$4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF);
function ReverseBits(Source: UInt32): UInt32;
begin
Result := (ReverseBitLookupTable256[Source and $FF] shl 24) or
(ReverseBitLookupTable256[(Source shr 8) and $FF] shl 16) or
(ReverseBitLookupTable256[(Source shr 16) and $FF] shl 8) or
(ReverseBitLookupTable256[(Source shr 24) and $FF]);
end;
function ReverseBits(Source: UInt8): UInt8;
begin
Result := ReverseBitLookupTable256[Source];
end;
procedure SwapBytes(var Buffer; Size: Integer);
{$IFDEF X86ASM}
asm
CMP EDX,1
JLE @@3
AND EAX,EAX
JZ @@3
PUSH EBX
MOV ECX,EDX
LEA EDX,[EAX + ECX - 1]
SHR ECX,1
@@1: MOV BL,[EAX]
XCHG BL,[EDX]
DEC EDX
MOV [EAX],BL
INC EAX
DEC ECX
JNZ @@1
@@2: POP EBX
@@3:
end;
{$ELSE !X86ASM}
var
T: Byte;
P, Q: PByte;
i: Integer;
begin
P := @Buffer;
Inc(P, Size - 1);
Q := @Buffer;
for i := 0 to Size div 2 - 1 do // using P/Q comparison with 'while' breaks some compilers
begin
T := Q^;
Q^ := P^;
P^ := T;
Dec(P);
Inc(Q);
end;
end;
{$ENDIF !X86ASM}
function SwapUInt32(Source: UInt32): UInt32;
{$IF defined(X86ASM) or defined(X64ASM)}
asm
{$IFDEF X64ASM}
MOV EAX, ECX
{$ENDIF X64ASM}
BSWAP EAX
end;
{$ELSE PUREPASCAL}
begin
Result := Source shl 24 or
Source shr 24 or
Source shl 8 and $00FF0000 or
Source shr 8 and $0000FF00;
end;
{$IFEND PUREPASCAL}
procedure SwapUInt32Buffer(const Source; var Dest; Count: Integer);
{$IFDEF X86ASM}
asm
TEST ECX,ECX
JLE @Exit
PUSH EDI
SUB EAX,4
SUB EDX,4
@@1: MOV EDI,[EAX + ECX * 4]
BSWAP EDI
MOV [EDX + ECX * 4],EDI
DEC ECX
JNZ @@1
POP EDI
@Exit:
end;
{$ELSE !X86ASM}
var
i: Integer;
T: UInt32;
begin
for i := 0 to Count - 1 do
begin
T := TUInt32Array(Source)[i];
TUInt32Array(Dest)[i] := (T shl 24) or (T shr 24) or
((T shl 8) and $00FF0000) or ((T shr 8) and $0000FF00);
end;
end;
{$ENDIF !X86ASM}
function SwapInt64(Source: Int64): Int64;
{$IFDEF X86ASM}
asm
MOV EDX,Source.DWord[0]
MOV EAX,Source.DWord[4]
BSWAP EDX
BSWAP EAX
end;
{$ELSE !X86ASM}
var
L, H: Cardinal;
begin
L := Int64Rec(Source).Lo;
H := Int64Rec(Source).Hi;
L := L shl 24 or L shr 24 or L shl 8 and $00FF0000 or L shr 8 and $0000FF00;
H := H shl 24 or H shr 24 or H shl 8 and $00FF0000 or H shr 8 and $0000FF00;
Int64Rec(Result).Hi := L;
Int64Rec(Result).Lo := H;
end;
{$ENDIF !X86ASM}
procedure SwapInt64Buffer(const Source; var Dest; Count: Integer);
{$IFDEF X86ASM}
asm
TEST ECX,ECX
JLE @Exit
PUSH ESI
PUSH EDI
LEA ESI,[EAX + ECX * 8]
LEA EDI,[EDX + ECX * 8]
NEG ECX
@@1: MOV EAX,[ESI + ECX * 8]
MOV EDX,[ESI + ECX * 8 + 4]
BSWAP EAX
BSWAP EDX
MOV [EDI + ECX * 8 + 4],EAX
MOV [EDI + ECX * 8],EDX
INC ECX
JNZ @@1
POP EDI
POP ESI
@Exit:
end;
{$ELSE !X86ASM}
var
H, L: Cardinal;
i: Integer;
begin
for i := 0 to Count - 1 do
begin
H := TUInt32Array(Source)[i * 2 ];
L := TUInt32Array(Source)[i * 2 + 1];
TUInt32Array(Dest)[i * 2 ] := L shl 24 or L shr 24 or L shl 8 and $00FF0000 or L shr 8 and $0000FF00;
TUInt32Array(Dest)[i * 2 + 1] := H shl 24 or H shr 24 or H shl 8 and $00FF0000 or H shr 8 and $0000FF00;
end;
end;
{$ENDIF !X86ASM}
procedure XORBuffers(const Left, Right; Size: Integer; var Dest);
// Dest^ = Source1^ xor Source2^
// Buffers must have the same size!
{$IFDEF X86ASM}
asm
AND ECX,ECX
JZ @@5
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,Dest
@@1: TEST ECX,3
JNZ @@3
@@2: SUB ECX,4
JL @@4
MOV EAX,[ESI + ECX]
XOR EAX,[EDX + ECX]
MOV [EDI + ECX],EAX
JMP @@2
@@3: DEC ECX
MOV AL,[ESI + ECX]
XOR AL,[EDX + ECX]
MOV [EDI + ECX],AL
JMP @@1
@@4: POP EDI
POP ESI
@@5:
end;
{$ELSE !X86ASM}
var
P, Q, D: PByte;
i: Integer;
begin
P := @Left;
Q := @Right;
D := @Dest;
for i := 0 to Size - 1 do
begin
D^ := P^ xor Q^;
Inc(P);
Inc(Q);
Inc(D);
end;
end;
{$ENDIF !X86ASM}
const
WipeCount = 4;
WipeBytes: array[0..WipeCount - 1] of Byte = (
$55, // 0101 0101
$AA, // 1010 1010
$FF, // 1111 1111
$00 // 0000 0000
);
procedure ProtectBuffer(var Buffer; Size: NativeUInt);
var
Count: Integer;
begin
if Size > 0 then
begin
for Count := 0 to WipeCount - 1 do
FillChar(Buffer, Size, WipeBytes[Count]);
end;
end;
procedure ProtectStream(Stream: TStream; SizeToProtect: Int64 = 0);
const
BufferSize = 512;
var
Buffer: string;
Count, Bytes, Size: Integer;
Position: Integer;
begin
Position := Stream.Position;
Size := Stream.Size;
if SizeToProtect <= 0 then
begin
SizeToProtect := Size;
Position := 0;
end else
begin
Dec(Size, Position);
if SizeToProtect > Size then
SizeToProtect := Size;
end;
SetLength(Buffer, BufferSize);
for Count := 0 to WipeCount -1 do
begin
Stream.Position := Position;
Size := SizeToProtect;
{$IF CompilerVersion >= 24.0}
FillChar(Buffer[Low(Buffer)], BufferSize, WipeBytes[Count]);
{$ELSE}
FillChar(Buffer[1], BufferSize, WipeBytes[Count]);
{$IFEND}
while Size > 0 do
begin
Bytes := Size;
if Bytes > BufferSize then
Bytes := BufferSize;
{$IF CompilerVersion >= 24.0}
Stream.Write(Buffer[Low(Buffer)], Bytes);
{$ELSE}
Stream.Write(Buffer[1], Bytes);
{$IFEND}
Dec(Size, Bytes);
end;
end;
end;
procedure ProtectBytes(var Source: TBytes);
begin
if (Source <> nil) and (Length(Source) > 0) then
begin
ProtectBuffer(Source[0], Length(Source));
SetLength(Source, 0);
end;
end;
procedure ProtectString(var Source: string);
begin
if Length(Source) > 0 then
begin
System.UniqueString(Source);
{$IF CompilerVersion >= 24.0}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[Low(Source)]));
{$ELSE}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[1]));
{$IFEND}
Source := '';
end;
end;
procedure ProtectString(var Source: RawByteString);
begin
if Length(Source) > 0 then
begin
// UniqueString(Source); cannot be called with a RawByteString as there is
// no overload for it, so we need to call our own one.
DECUtilRawByteStringHelper.UniqueString(Source);
{$IF CompilerVersion >= 24.0}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[Low(Source)]));
{$ELSE}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[1]));
{$IFEND}
Source := '';
end;
end;
{$IFNDEF NEXTGEN}
procedure ProtectString(var Source: AnsiString); overload;
begin
if Length(Source) > 0 then
begin
System.UniqueString(Source);
{$IF CompilerVersion >= 24.0}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[Low(Source)]));
{$ELSE}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[1]));
{$IFEND}
Source := '';
end;
end;
procedure ProtectString(var Source: WideString); overload;
begin
if Length(Source) > 0 then
begin
System.UniqueString(Source); // for OS <> Win, WideString is not RefCounted on Win
{$IF CompilerVersion >= 24.0}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[Low(Source)]));
{$ELSE}
ProtectBuffer(Pointer(Source)^, Length(Source) * SizeOf(Source[1]));
{$IFEND}
Source := '';
end;
end;
{$ENDIF}
function BytesToRawString(const Source: TBytes): RawByteString;
begin
SetLength(Result, Length(Source));
if Length(Source) > 0 then
begin
// determine lowest string index for handling of ZeroBasedStrings
{$IF CompilerVersion >= 24.0}
Move(Source[0], Result[Low(result)], Length(Source));
{$ELSE}
Move(Source[0], Result[1], Length(Source));
{$IFEND}
end;
end;
{ EDECException }
{$IFDEF FMXTranslateableExceptions}
constructor EDECException.Create(const Msg: string);
begin
inherited Create(Translate(msg));
end;
constructor EDECException.CreateFmt(const Msg: string;
const Args: array of const);
begin
inherited Create(Format(Translate(Msg), Args));
end;
constructor EDECAbstractError.Create(ClassName: string);
begin
inherited Create(Format(Translate(sAbstractError), [ClassName]));
end;
{$ELSE}
constructor EDECAbstractError.Create(ClassName: string);
begin
inherited CreateResFmt(@sAbstractError, [ClassName]);
end;
{$ENDIF}
end.

137
contrib/DelphiEncryptionCompendium/Source/DECUtilRawByteStringHelper.pas Normal file
View File

@@ -0,0 +1,137 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit DECUtilRawByteStringHelper;
interface
{$INCLUDE DECOptions.inc}
/// <summary>
/// System.pas does not contain a RawByteString compatible version of this
/// routine so we created our own, copying and adapting code from system.pas
/// for the NextGen compiler and using a solution from Remy Lebeau for the
/// Win32/Win64 compiler.
/// </summary>
/// <param name="str">
/// String to be processed
/// </param>
procedure UniqueString(var Str: RawByteString);
implementation
uses
{$IFDEF FPC}
SysUtils;
{$ELSE}
System.SysUtils;
{$ENDIF}
type
// Duplicate of the System.pas internal declaration. Needs to be kept in sync.
PStrRec = ^StrRec;
StrRec = packed record
{$IFDEF CPU64BITS}
_Padding: Integer; // Make 16 byte align for payload..
{$ENDIF}
codePage: Word;
elemSize: Word;
refCnt: Integer;
length: Integer;
end;
function _NewAnsiString(CharLength: Integer; CodePage: Word): Pointer;
var
P: PStrRec;
begin
Result := nil;
if CharLength > 0 then
begin
// Alloc an extra null for strings with even length. This has no actual
// cost since the allocator will round up the request to an even size
// anyway. All _WideStr allocations have even length, and need a double
// null terminator.
if CharLength >= MaxInt - SizeOf(StrRec) then
raise EIntOverflow.Create(
'IntOverflow in _NewAnsiString. CharLength: ' + IntToStr(CharLength));
GetMem(P, CharLength + SizeOf(StrRec) + 1 + ((CharLength + 1) and 1));
Result := Pointer(PByte(P) + SizeOf(StrRec));
P.length := CharLength;
P.refcnt := 1;
if CodePage = 0 then
{$IFDEF NEXTGEN}
CodePage := Word(CP_UTF8);
{$ELSE NEXTGEN}
CodePage := Word(DefaultSystemCodePage);
{$ENDIF NEXTGEN}
P.codePage := CodePage;
P.elemSize := 1;
PWideChar(Result)[CharLength div 2] := #0; // length guaranteed >= 2
end;
end;
function _LStrClr(var S): Pointer;
var
P: PStrRec;
begin
if Pointer(S) <> nil then
begin
P := Pointer(PByte(S) - SizeOf(StrRec));
Pointer(S) := nil;
if P.refCnt > 0 then
begin
{$IFDEF FPC}
if InterlockedDecrement(P.refCnt) = 0 then
{$ELSE}
{$IF CompilerVersion >= 24.0}
if AtomicDecrement(P.refCnt) = 0 then
{$ELSE}
Dec(P.refCnt);
if (P.refCnt = 0) then
{$IFEND}
{$ENDIF}
FreeMem(P);
end;
end;
Result := @S;
end;
function InternalUniqueStringA(var Str: RawByteString): Pointer;
var
P: PStrRec;
begin
Result := Pointer(Str);
if Result <> nil then
begin
Result := Pointer(Str);
P := Pointer(PByte(Str) - sizeof(StrRec));
if P.refCnt <> 1 then
begin
Result := _NewAnsiString(P.length, P.codePage);
Move(Pointer(Str)^, Pointer(Result)^, P.length);
_LStrClr(Str);
Pointer(Str) := Result;
end;
end;
end;
procedure UniqueString(var Str: RawByteString);
begin
InternalUniqueStringA(Str);
end;
end.

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/GUITestRunner/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/SysInit/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/Classes/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/Generics/Collections/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/Generics/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/SysUtils/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/TypInfo/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/System/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/TestFramework/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/TextTestRunner/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/Vcl/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/Winapi/default.txaPackage Normal file
View File

0
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/default.txaPackage Normal file
View File

8
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/default.txvpck Normal file
View File

@@ -0,0 +1,8 @@
<?xml version="1.0" encoding="utf-8"?>
<nodeSet version="1.0">
<view uin="y77zdiaku6k_v">
<property name="$defaultDiagram" value="true" />
<property name="$metaclass" value="Package Diagram" />
<property name="$name" value="default" />
</view>
</nodeSet>

2
contrib/DelphiEncryptionCompendium/Source/LibrarySupport/DelphiWin32/default_diagram.tvsconfig Normal file
View File

@@ -0,0 +1,2 @@
<?xml version="1.0"?>
<TgConfig Version="3" SubLevelDisabled="False" />

24
contrib/DelphiEncryptionCompendium/Source/SearchPaths-Demo.optset Normal file
View File

@@ -0,0 +1,24 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\..\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)__Demos</DCC_DcuOutput>
<DCC_ExeOutput>.\..\..\Compiled\BIN_IDExx.x_$(Platform)__Demos</DCC_ExeOutput>
<DCC_HppOutput>.\..\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_HppOutput>
<DCC_ObjOutput>.\..\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)__Demos</DCC_ObjOutput>
<DCC_BpiOutput>.\..\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_BpiOutput>
<DCC_UnitSearchPath>.\..\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config);$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_BplOutput>.\..\..\Compiled\BIN_IDExx.x_$(Platform)__Demos</DCC_BplOutput>
<DCC_DcpOutput>.\..\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_DcpOutput>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<SanitizedProjectName></SanitizedProjectName>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>OptionSet</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality/>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>

24
contrib/DelphiEncryptionCompendium/Source/SearchPaths-Source.optset Normal file
View File

@@ -0,0 +1,24 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\..\Compiled\BIN_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_ExeOutput>
<DCC_HppOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_HppOutput>
<DCC_ObjOutput>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_ObjOutput>
<DCC_BpiOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_BpiOutput>
<DCC_UnitSearchPath>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config);$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_BplOutput>.\..\Compiled\BIN_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_BplOutput>
<DCC_DcpOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_DcpOutput>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<SanitizedProjectName>DEC60</SanitizedProjectName>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>OptionSet</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality/>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>

24
contrib/DelphiEncryptionCompendium/Source/SearchPaths-Test.optset Normal file
View File

@@ -0,0 +1,24 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)__Demos</DCC_DcuOutput>
<DCC_ExeOutput>.\..\Compiled\BIN_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_ExeOutput>
<DCC_HppOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_HppOutput>
<DCC_ObjOutput>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)__Demos</DCC_ObjOutput>
<DCC_BpiOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_BpiOutput>
<DCC_UnitSearchPath>.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_$(Config);.\..\Compiled\DCU_IDE$(ProductVersion)_$(Platform)_Debug;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_BplOutput>.\..\Compiled\BIN_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_BplOutput>
<DCC_DcpOutput>.\..\Compiled\DCP_IDE$(ProductVersion)_$(Platform)_$(Config)</DCC_DcpOutput>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<SanitizedProjectName>DECDUnitTestSuite</SanitizedProjectName>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>OptionSet</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality/>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>