Delphi/FastReport_FMX_2.8.12
Delphi/FastReport_FMX_2.8.12
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f4b3d937f8
FastReport_FMX_2.8.12/Source/FMX.frxMD5.pas
Daso f4b3d937f8
Init
2024-07-06 22:41:12 +02:00

551 lines
15 KiB
ObjectPascal
Raw Blame History

{******************************************}
{ }
{ FastReport v4.0 }
{ MD5 checksum generation }
{ }
{******************************************}
// Original RSA Data Security, Inc. Copyright notice
/////////////////////////////////////////////////////////////////////////
//
// Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
// rights reserved.
//
// License to copy and use this software is granted provided that it
// is identified as the "RSA Data Security, Inc. MD5 Message-Digest
// Algorithm" in all material mentioning or referencing this software
// or this function.
// License is also granted to make and use derivative works provided
// that such works are identified as "derived from the RSA Data
// Security, Inc. MD5 Message-Digest Algorithm" in all material
// mentioning or referencing the derived work.
// RSA Data Security, Inc. makes no representations concerning either
// the merchantability of this software or the suitability of this
// software for any particular purpose. It is provided "as is"
// without express or implied warranty of any kind.
// These notices must be retained in any copies of any part of this
// documentation and/or software.
unit FMX.frxmd5;
{$I frx.inc}
interface
uses System.Classes;
const
//Magic initialization constants
MD5_INIT_STATE_0 = $67452301;
MD5_INIT_STATE_1 = $efcdab89;
MD5_INIT_STATE_2 = $98badcfe;
MD5_INIT_STATE_3 = $10325476;
//Constants for Transform routine.
MD5_S11 = 7;
MD5_S12 = 12;
MD5_S13 = 17;
MD5_S14 = 22;
MD5_S21 = 5;
MD5_S22 = 9;
MD5_S23 = 14;
MD5_S24 = 20;
MD5_S31 = 4;
MD5_S32 = 11;
MD5_S33 = 16;
MD5_S34 = 23;
MD5_S41 = 6;
MD5_S42 = 10;
MD5_S43 = 15;
MD5_S44 = 21;
//Transformation Constants - Round 1
MD5_T01 = $d76aa478;
MD5_T02 = $e8c7b756;
MD5_T03 = $242070db;
MD5_T04 = $c1bdceee;
MD5_T05 = $f57c0faf;
MD5_T06 = $4787c62a;
MD5_T07 = $a8304613;
MD5_T08 = $fd469501;
MD5_T09 = $698098d8;
MD5_T10 = $8b44f7af;
MD5_T11 = $ffff5bb1;
MD5_T12 = $895cd7be;
MD5_T13 = $6b901122;
MD5_T14 = $fd987193;
MD5_T15 = $a679438e;
MD5_T16 = $49b40821;
//Transformation Constants - Round 2
MD5_T17 = $f61e2562;
MD5_T18 = $c040b340;
MD5_T19 = $265e5a51;
MD5_T20 = $e9b6c7aa;
MD5_T21 = $d62f105d;
MD5_T22 = $02441453;
MD5_T23 = $d8a1e681;
MD5_T24 = $e7d3fbc8;
MD5_T25 = $21e1cde6;
MD5_T26 = $c33707d6;
MD5_T27 = $f4d50d87;
MD5_T28 = $455a14ed;
MD5_T29 = $a9e3e905;
MD5_T30 = $fcefa3f8;
MD5_T31 = $676f02d9;
MD5_T32 = $8d2a4c8a;
//Transformation Constants - Round 3
MD5_T33 = $fffa3942;
MD5_T34 = $8771f681;
MD5_T35 = $6d9d6122;
MD5_T36 = $fde5380c;
MD5_T37 = $a4beea44;
MD5_T38 = $4bdecfa9;
MD5_T39 = $f6bb4b60;
MD5_T40 = $bebfbc70;
MD5_T41 = $289b7ec6;
MD5_T42 = $eaa127fa;
MD5_T43 = $d4ef3085;
MD5_T44 = $04881d05;
MD5_T45 = $d9d4d039;
MD5_T46 = $e6db99e5;
MD5_T47 = $1fa27cf8;
MD5_T48 = $c4ac5665;
//Transformation Constants - Round 4
MD5_T49 = $f4292244;
MD5_T50 = $432aff97;
MD5_T51 = $ab9423a7;
MD5_T52 = $fc93a039;
MD5_T53 = $655b59c3;
MD5_T54 = $8f0ccc92;
MD5_T55 = $ffeff47d;
MD5_T56 = $85845dd1;
MD5_T57 = $6fa87e4f;
MD5_T58 = $fe2ce6e0;
MD5_T59 = $a3014314;
MD5_T60 = $4e0811a1;
MD5_T61 = $f7537e82;
MD5_T62 = $bd3af235;
MD5_T63 = $2ad7d2bb;
MD5_T64 = $eb86d391;
//Null data (except for first BYTE) used to finalise the checksum calculation
PADDING: array [0..63] of byte =
( $80, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0);
type
uint4 = longword;
uchar = byte;
Puint4 = ^uint4;
Puchar = ^uchar;
TfrxMD5 = class (TObject)
private
m_State: array [0..3] of uint4;
m_Count: array [0..1] of uint4;
m_Buffer: array [0..63] of uchar;
m_Digest: array [0..15] of uchar;
procedure Transform(block: Puchar);
procedure Encode(dest: Puchar; src: Puint4; nLength: uint4);
procedure Decode(dest: Puint4; src: Puchar; nLength: uint4);
function RotateLeft(x: uint4; n: uint4): uint4;
procedure FF(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
procedure GG(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
procedure HH(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
procedure II(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
public
constructor Create;
procedure Init;
procedure Update(chInput: Puchar; nInputLen: uint4);
procedure Finalize;
function Digest: Puchar;
end;
function MD5String(szString: AnsiString): AnsiString;
function MD5File(szFilename: String): AnsiString;
function MD5Stream(Stream: TStream): AnsiString;
procedure MD5Buf(Buf: Pointer; const Len: Integer; Digest: Pointer);
function PrintMD5(md5Digest: Puchar): AnsiString;
implementation
uses System.SysUtils{$IFDEF Delphi12}, System.AnsiStrings{$ENDIF};
{$IFOPT Q+}
{$DEFINE OVERDEF}
{$Q-}
{$ENDIF}
function Byte2Hex(const b: byte): AnsiString;
var
H, L: Byte;
function HexChar(N : Byte) : AnsiChar;
begin
if (N < 10) then Result := AnsiChar(Chr(Ord('0') + N))
else Result := AnsiChar(Chr(Ord('A') + (N - 10)));
end;
begin
SetLength(Result, 2);
H := (b shr 4) and $f;
L := b and $f;
Result[1] := HexChar(H);
Result[2]:= HexChar(L);
end;
// PrintMD5: Converts a completed md5 digest into a char* string.
function PrintMD5(md5Digest: Puchar): AnsiString;
var
nCount: Integer;
tmp: Puchar;
begin
Result := '';
tmp := md5Digest;
for nCount := 0 to 15 do
begin
Result := Result + LowerCase(Byte2Hex(Byte(tmp^)));
Inc(tmp);
end;
end;
// MD5String: Performs the MD5 algorithm on a char* string, returning
// the results as a char*.
function MD5String(szString: AnsiString): AnsiString;
var
nLen: Integer;
alg: TfrxMD5;
begin
Result := '';
alg := TfrxMD5.Create;
try
nLen := Length(szString);
alg.Update(Puchar(szString), nLen);
alg.Finalize;
Result := PrintMD5(alg.Digest);
finally
alg.Free;
end;
end;
function MD5Stream(Stream: TStream): AnsiString;
var
nLen: Integer;
buf: array [0..255] of AnsiChar;
alg: TfrxMD5;
oldpos: Longint;
begin
Result := '';
alg := TfrxMD5.Create;
oldpos := Stream.Position;
try
Stream.Position := 0;
nLen := 256;
while nLen = 256 do
begin
nLen := Stream.Read(buf, nLen);
alg.Update(@buf, nLen);
end;
alg.Finalize;
Result := PrintMD5(alg.Digest);
finally
Stream.Position := oldpos;
alg.Free;
end;
end;
function MD5File(szFilename: String): AnsiString;
var
f: TFileStream;
begin
Result := '';
f := TFileStream.Create(szFilename, fmOpenRead + fmShareDenyWrite);
try
Result := MD5Stream(f);
finally
f.Free
end;
end;
procedure MD5Buf(Buf: Pointer; const Len: Integer; Digest: Pointer);
var
md5: TfrxMD5;
d: Puchar;
begin
md5 := TfrxMD5.Create;
try
md5.Update(Buf, Len);
md5.Finalize;
d := md5.Digest;
Move(d^, digest^, 16);
finally
md5.Free;
end;
end;
{ TfrxMD5 }
constructor TfrxMD5.Create;
begin
Init;
end;
// md5::Init
// Initializes a new context.
procedure TfrxMD5.Init;
begin
FillChar(m_Count, 2 * SizeOf(uint4), 0);
m_State[0] := MD5_INIT_STATE_0;
m_State[1] := MD5_INIT_STATE_1;
m_State[2] := MD5_INIT_STATE_2;
m_State[3] := MD5_INIT_STATE_3;
end;
// MD5 block update operation. Continues an MD5 message-digest
// operation, processing another message block, and updating the
// context.
procedure TfrxMD5.Update(chInput: Puchar; nInputLen: uint4);
var
i, index, partLen: uint4;
tmp: Puchar;
begin
// Compute number of bytes mod 64
index := (m_Count[0] shr 3) and $3F;
// Update number of bits
m_Count[0] := m_Count[0] + (nInputLen shl 3);
if m_Count[0] < (nInputLen shl 3) then
m_Count[1] := m_Count[1] + 1;
m_Count[1] := m_Count[1] + (nInputLen shr 29);
partLen := 64 - index;
// Transform as many times as possible.
if nInputLen >= partLen then
begin
Move(chInput^, m_Buffer[index], partLen);
Transform(Puchar(@m_Buffer));
i := partLen;
while (i + 63) < nInputLen do
begin
tmp := chInput;
Inc(tmp, i);
Transform(tmp);
i := i + 64;
end;
index := 0;
end else
i := 0;
// Buffer remaining input
tmp := chInput;
Inc(tmp, i);
Move(tmp^, m_Buffer[index], nInputLen - i);
end;
// MD5 finalization. Ends an MD5 message-digest operation, writing
// the message digest and zeroizing the context.
procedure TfrxMD5.Finalize;
var
bits: array [0..7] of uchar;
index, padLen: uint4;
begin
// Save number of bits
Encode(Puchar(@bits), Puint4(@m_Count), 8);
// Pad out to 56 mod 64
index := (m_Count[0] shr 3) and $3f;
if index < 56 then
padLen := 56 - index
else
padLen := 120 - index;
Update(Puchar(@PADDING), padLen);
// Append length (before padding)
Update(Puchar(@bits), 8);
// Store state in digest
Encode(Puchar(@m_Digest), Puint4(@m_State), 16);
FillChar(m_Count, 2 * sizeof(uint4), 0);
FillChar(m_State, 4 * sizeof(uint4), 0);
FillChar(m_Buffer, 64 * sizeof(uchar), 0);
end;
function TfrxMD5.Digest: Puchar;
begin
Result := Puchar(@m_Digest);
end;
// MD5 basic transformation. Transforms state based on block.
procedure TfrxMD5.Transform(block: Puchar);
var
a, b, c, d: uint4;
X: array [0..15] of uint4;
begin
a := m_State[0];
b := m_State[1];
c := m_State[2];
d := m_State[3];
Decode(Puint4(@X), block, 64);
//Perform Round 1 of the transformation
FF (a, b, c, d, X[ 0], MD5_S11, MD5_T01);
FF (d, a, b, c, X[ 1], MD5_S12, MD5_T02);
FF (c, d, a, b, X[ 2], MD5_S13, MD5_T03);
FF (b, c, d, a, X[ 3], MD5_S14, MD5_T04);
FF (a, b, c, d, X[ 4], MD5_S11, MD5_T05);
FF (d, a, b, c, X[ 5], MD5_S12, MD5_T06);
FF (c, d, a, b, X[ 6], MD5_S13, MD5_T07);
FF (b, c, d, a, X[ 7], MD5_S14, MD5_T08);
FF (a, b, c, d, X[ 8], MD5_S11, MD5_T09);
FF (d, a, b, c, X[ 9], MD5_S12, MD5_T10);
FF (c, d, a, b, X[10], MD5_S13, MD5_T11);
FF (b, c, d, a, X[11], MD5_S14, MD5_T12);
FF (a, b, c, d, X[12], MD5_S11, MD5_T13);
FF (d, a, b, c, X[13], MD5_S12, MD5_T14);
FF (c, d, a, b, X[14], MD5_S13, MD5_T15);
FF (b, c, d, a, X[15], MD5_S14, MD5_T16);
//Perform Round 2 of the transformation
GG (a, b, c, d, X[ 1], MD5_S21, MD5_T17);
GG (d, a, b, c, X[ 6], MD5_S22, MD5_T18);
GG (c, d, a, b, X[11], MD5_S23, MD5_T19);
GG (b, c, d, a, X[ 0], MD5_S24, MD5_T20);
GG (a, b, c, d, X[ 5], MD5_S21, MD5_T21);
GG (d, a, b, c, X[10], MD5_S22, MD5_T22);
GG (c, d, a, b, X[15], MD5_S23, MD5_T23);
GG (b, c, d, a, X[ 4], MD5_S24, MD5_T24);
GG (a, b, c, d, X[ 9], MD5_S21, MD5_T25);
GG (d, a, b, c, X[14], MD5_S22, MD5_T26);
GG (c, d, a, b, X[ 3], MD5_S23, MD5_T27);
GG (b, c, d, a, X[ 8], MD5_S24, MD5_T28);
GG (a, b, c, d, X[13], MD5_S21, MD5_T29);
GG (d, a, b, c, X[ 2], MD5_S22, MD5_T30);
GG (c, d, a, b, X[ 7], MD5_S23, MD5_T31);
GG (b, c, d, a, X[12], MD5_S24, MD5_T32);
//Perform Round 3 of the transformation
HH (a, b, c, d, X[ 5], MD5_S31, MD5_T33);
HH (d, a, b, c, X[ 8], MD5_S32, MD5_T34);
HH (c, d, a, b, X[11], MD5_S33, MD5_T35);
HH (b, c, d, a, X[14], MD5_S34, MD5_T36);
HH (a, b, c, d, X[ 1], MD5_S31, MD5_T37);
HH (d, a, b, c, X[ 4], MD5_S32, MD5_T38);
HH (c, d, a, b, X[ 7], MD5_S33, MD5_T39);
HH (b, c, d, a, X[10], MD5_S34, MD5_T40);
HH (a, b, c, d, X[13], MD5_S31, MD5_T41);
HH (d, a, b, c, X[ 0], MD5_S32, MD5_T42);
HH (c, d, a, b, X[ 3], MD5_S33, MD5_T43);
HH (b, c, d, a, X[ 6], MD5_S34, MD5_T44);
HH (a, b, c, d, X[ 9], MD5_S31, MD5_T45);
HH (d, a, b, c, X[12], MD5_S32, MD5_T46);
HH (c, d, a, b, X[15], MD5_S33, MD5_T47);
HH (b, c, d, a, X[ 2], MD5_S34, MD5_T48);
//Perform Round 4 of the transformation
II (a, b, c, d, X[ 0], MD5_S41, MD5_T49);
II (d, a, b, c, X[ 7], MD5_S42, MD5_T50);
II (c, d, a, b, X[14], MD5_S43, MD5_T51);
II (b, c, d, a, X[ 5], MD5_S44, MD5_T52);
II (a, b, c, d, X[12], MD5_S41, MD5_T53);
II (d, a, b, c, X[ 3], MD5_S42, MD5_T54);
II (c, d, a, b, X[10], MD5_S43, MD5_T55);
II (b, c, d, a, X[ 1], MD5_S44, MD5_T56);
II (a, b, c, d, X[ 8], MD5_S41, MD5_T57);
II (d, a, b, c, X[15], MD5_S42, MD5_T58);
II (c, d, a, b, X[ 6], MD5_S43, MD5_T59);
II (b, c, d, a, X[13], MD5_S44, MD5_T60);
II (a, b, c, d, X[ 4], MD5_S41, MD5_T61);
II (d, a, b, c, X[11], MD5_S42, MD5_T62);
II (c, d, a, b, X[ 2], MD5_S43, MD5_T63);
II (b, c, d, a, X[ 9], MD5_S44, MD5_T64);
m_State[0] := m_State[0] + a;
m_State[1] := m_State[1] + b;
m_State[2] := m_State[2] + c;
m_State[3] := m_State[3] + d;
FillChar(X, sizeof(X), 0);
end;
// Encodes input (uint4) into output (uchar). Assumes nLength is
// a multiple of 4.
procedure TfrxMD5.Encode(dest: Puchar; src: Puint4; nLength: uint4);
var
j: uint4;
tmp: Puchar;
tmp2: Puint4;
begin
j := 0;
tmp := dest;
tmp2 := src;
while j < nLength do
begin
tmp^ := uchar(tmp2^ and $ff);
Inc(tmp);
tmp^ := uchar((tmp2^ shr 8) and $ff);
Inc(tmp);
tmp^ := uchar((tmp2^ shr 16) and $ff);
Inc(tmp);
tmp^ := uchar((tmp2^ shr 24) and $ff);
Inc(tmp);
Inc(tmp2);
j := j + 4;
end;
end;
// Decodes input (uchar) into output (uint4). Assumes nLength is
// a multiple of 4.
procedure TfrxMD5.Decode(dest: Puint4; src: Puchar; nLength: uint4);
var
j: uint4;
tmp2: Puchar;
tmp: Puint4;
begin
j := 0;
tmp := dest;
tmp2 := src;
while j < nLength do
begin
tmp^ := uint4(tmp2^);
Inc(tmp2);
tmp^ := tmp^ or uint4(tmp2^ shl 8);
Inc(tmp2);
tmp^ := tmp^ or uint4(tmp2^ shl 16);
Inc(tmp2);
tmp^ := tmp^ or uint4(tmp2^ shl 24);
Inc(tmp2);
Inc(tmp);
j := j + 4;
end;
end;
function TfrxMD5.RotateLeft(x: uint4; n: uint4): uint4;
begin
Result := (x shl n) or (x shr (32 - n));
end;
procedure TfrxMD5.FF(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
a := a + ((b and c) or (not b and d)) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure TfrxMD5.GG(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
a := a + ((b and d) or (c and (not d))) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure TfrxMD5.HH(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
a := a + (b xor c xor d) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure TfrxMD5.II(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
a := a + (c xor (b or (not d))) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
{$IFDEF OVERDEF}
{$UNDEF OVERDEF}
{$Q+}
{$ENDIF}
end.
Reference in New Issue View Git Blame Copy Permalink