xtool/contrib/DelphiEncryptionCompendium/Source/DECHashBase.pas

941 lines
30 KiB
ObjectPascal
Raw Blame History

{*****************************************************************************
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.