younes-98
سه شنبه 15 بهمن 1387, 20:35 عصر
unit SHA256;
interface
type
TSHA256MessageDigest = array[0..$1f] of Byte;
TSHA256HashValue = array[0..7] of LongWord;
TSHA256MessageBuffer = array[0..$3f] of Byte;
TSHA256Calc = class
private
FHashValue: TSHA256HashValue;
FCount: Int64;
FBuffer: TSHA256MessageBuffer;
public
constructor Create;
procedure Input(const Data; Length: Cardinal);
function Final: TSHA256MessageDigest;
end;
function SHA256MessageDigest(const Message;
Length: Cardinal): TSHA256MessageDigest;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
type
TProgressEvent = procedure(Current, Total: Int64) of object;
function SHA256FileMessageDigest(const FileName: string;
OnProgress: TProgressEvent = nil): TSHA256MessageDigest;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
implementation
type
Bytes = array[0..MaxInt - 1] of Byte;
LongWords = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord;
function ROR(X: LongWord; Count: Integer): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := (X shr Count) or (X shl (32 - Count));
end;
{$ELSE}
asm
MOV ECX,EDX
ROR EAX,CL
end;
{$ENDIF}
procedure ConvertEndianness32(const Source; var Dest; Count: Integer); overload;
{$IFDEF PUREPASCAL}
var
I: Integer;
SSS: LongWords absolute Source;
DDD: LongWords absolute Dest;
SS, DD: LongWord;
S: Bytes absolute SS;
D: Bytes absolute DD;
begin
for I := 0 to Count - 1 do
begin
DD := SSS[I];
D[0] := S[3];
D[1] := S[2];
D[2] := S[1];
D[3] := S[0];
DDD[I] := SS;
end;
end;
{$ELSE}
asm
JECXZ @@exit
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,EDX
@@loop:
LODSD
BSWAP EAX
STOSD
LOOP @@loop
POP EDI
POP ESI
@@exit:
end;
{$ENDIF}
procedure ConvertEndianness64(const Source; var Dest); overload;
{$IFDEF PUREPASCAL}
var
S: Bytes absolute Source;
D: Bytes absolute Dest;
begin
D[0] := S[7];
D[1] := S[6];
D[2] := S[5];
D[3] := S[4];
D[4] := S[3];
D[5] := S[2];
D[6] := S[1];
D[7] := S[0];
end;
{$ELSE}
asm
MOV ECX,[EAX]
MOV EAX,[EAX+4]
BSWAP EAX
BSWAP ECX
MOV [EDX],EAX
MOV [EDX+4],ECX
end;
{$ENDIF}
procedure Frac32RootPrimes(var Dest: array of LongWord; Base: Integer);
var
I, N, D: Integer;
IsPrime: Boolean;
begin
N := 1;
for I := 0 to High(Dest) do
begin
repeat
Inc(N);
IsPrime := True;
for D := N - 1 downto 2 do
if N mod D = 0 then
begin
IsPrime := False;
Break;
end;
until IsPrime;
Dest[I] := Trunc(Frac(Exp(Ln(N) / Base)) * $100000000);
end;
end;
// ----------------------------------------------------------------------------
function S0(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 2) xor ROR(x, 13) xor ROR(x, 22);
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,2
ROR EDX,13
ROR ECX,22
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function S1(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 6) xor ROR(x, 11) xor ROR(x, 25);
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,6
ROR EDX,11
ROR ECX,25
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function _s0(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 7) xor ROR(x, 18) xor x shr 3;
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,7
ROR EDX,18
SHR ECX,3
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function _s1(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 17) xor ROR(x, 19) xor x shr 10;
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,17
ROR EDX,19
SHR ECX,10
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
var
K: array[0..63] of LongWord;
InitialHashValue: TSHA256HashValue;
procedure Process(const M; var _H: TSHA256HashValue);
var
W: array[0..63] of LongWord;
t, a, b, c, d, e, f, g, h, T1, T2: LongWord;
begin
// 1. Preparing the message schedule, {Wt}:
ConvertEndianness32(M, W, 16);
for t := 16 to 63 do
W[t] := _s1(W[t - 2]) + W[t - 7] + _s0(W[t - 15]) + W[t - 16];
// 2. Initializing the eight working variables with the (i-1)'st hash value:
a := _H[0];
b := _H[1];
c := _H[2];
d := _H[3];
e := _H[4];
f := _H[5];
g := _H[6];
h := _H[7];
// 3.
for t := 0 to 63 do
begin
T1 := h + S1(e) + {Ch}((e and f) xor ((not e) and g)){/Ch} + K[t] + W[t];
T2 := S0(a) + {Maj}((a and b) xor (a and c) xor (b and c)){/Maj};
h := g;
g := f;
f := e;
e := d + T1;
d := c;
c := b;
b := a;
a := T1 + T2;
end;
// 4. Computing the i'th intermediate hash value H(i):
Inc(_H[0], a);
Inc(_H[1], b);
Inc(_H[2], c);
Inc(_H[3], d);
Inc(_H[4], e);
Inc(_H[5], f);
Inc(_H[6], g);
Inc(_H[7], h);
end;
{ TSHA256Calc }
constructor TSHA256Calc.Create;
begin
FHashValue := InitialHashValue;
end;
procedure TSHA256Calc.Input(const Data; Length: Cardinal);
var
I, Index, PartLen: Cardinal;
begin
Index := FCount and High(TSHA256MessageBuffer);
Inc(FCount, Length);
PartLen := SizeOf(TSHA256MessageBuffer) - Index;
if Length >= PartLen then
begin
Move(Data, FBuffer[Index], PartLen);
Process(FBuffer, FHashValue);
I := PartLen;
while I + SizeOf(TSHA256MessageBuffer) <= Length do
begin
Process(Bytes(Data)[I], FHashValue);
Inc(I, SizeOf(TSHA256MessageBuffer));
end;
Index := 0;
end
else
I := 0;
Move(Bytes(Data)[I], FBuffer[Index], Length - I);
end;
function TSHA256Calc.Final: TSHA256MessageDigest;
var
BitLength: Int64;
BitLengthBigEndian: array[0..7] of Byte;
Padding: TSHA256MessageBuffer;
PadLen: Integer;
begin
try
BitLength := FCount shl 3;
ConvertEndianness64(BitLength, BitLengthBigEndian);
PadLen := (SizeOf(TSHA256MessageBuffer) * 2 - SizeOf(BitLength) - 1 - FCount
and High(TSHA256MessageBuffer)) and High(TSHA256MessageBuffer) + 1;
FillChar(Padding, PadLen, 0);
Padding[0] := $80;
Input(Padding, PadLen);
Input(BitLengthBigEndian, SizeOf(Int64));
ConvertEndianness32(FHashValue, Result, Length(FHashValue));
finally
Free;
end;
end;
// ----------------------------------------------------------------------------
function SHA256MessageDigest(const Message;
Length: Cardinal): TSHA256MessageDigest;
begin
with TSHA256Calc.Create do
try
Input(Message, Length);
finally
Result := Final;
end;
end;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
begin
Result := SHA256MessageDigest(Pointer(S)^, Length(S));
end;
function SHA256FileMessageDigest(const FileName: string;
OnProgress: TProgressEvent): TSHA256MessageDigest;
var
F: file;
Buf: array[0..$fff] of Byte;
Read: Cardinal;
Current, Total: Int64;
begin
AssignFile(F, FileName);
FileMode := 0;
Reset(F, 1);
try
with TSHA256Calc.Create do
try
Current := 0;
Total := FileSize(F);
while True do
begin
BlockRead(F, Buf, SizeOf(Buf), Read);
if Read = 0 then
Break;
Input(Buf, Read);
Inc(Current, Read);
if Assigned(OnProgress) then
OnProgress(Current, Total);
end;
finally
Result := Final;
end;
finally
CloseFile(F);
end;
end;
var
HexChars: array[0..$f] of Char;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
var
I: Integer;
TempStr: string[SizeOf(TSHA256MessageDigest) * 2];
begin
TempStr := '';
for I := 0 to High(D) do
TempStr := TempStr + HexChars[D[I] shr 4] + HexChars[D[I] and $f];
Result := TempStr;
end;
var
I: Integer;
initialization
Frac32RootPrimes(K, 3);
Frac32RootPrimes(InitialHashValue, 2);
for I := 0 to 9 do
HexChars[I] := Chr(Ord('0') + I);
for I := $a to $f do
HexChars[I] := Chr(Ord('a') + (I - $a));
end.
interface
type
TSHA256MessageDigest = array[0..$1f] of Byte;
TSHA256HashValue = array[0..7] of LongWord;
TSHA256MessageBuffer = array[0..$3f] of Byte;
TSHA256Calc = class
private
FHashValue: TSHA256HashValue;
FCount: Int64;
FBuffer: TSHA256MessageBuffer;
public
constructor Create;
procedure Input(const Data; Length: Cardinal);
function Final: TSHA256MessageDigest;
end;
function SHA256MessageDigest(const Message;
Length: Cardinal): TSHA256MessageDigest;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
type
TProgressEvent = procedure(Current, Total: Int64) of object;
function SHA256FileMessageDigest(const FileName: string;
OnProgress: TProgressEvent = nil): TSHA256MessageDigest;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
implementation
type
Bytes = array[0..MaxInt - 1] of Byte;
LongWords = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord;
function ROR(X: LongWord; Count: Integer): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := (X shr Count) or (X shl (32 - Count));
end;
{$ELSE}
asm
MOV ECX,EDX
ROR EAX,CL
end;
{$ENDIF}
procedure ConvertEndianness32(const Source; var Dest; Count: Integer); overload;
{$IFDEF PUREPASCAL}
var
I: Integer;
SSS: LongWords absolute Source;
DDD: LongWords absolute Dest;
SS, DD: LongWord;
S: Bytes absolute SS;
D: Bytes absolute DD;
begin
for I := 0 to Count - 1 do
begin
DD := SSS[I];
D[0] := S[3];
D[1] := S[2];
D[2] := S[1];
D[3] := S[0];
DDD[I] := SS;
end;
end;
{$ELSE}
asm
JECXZ @@exit
PUSH ESI
PUSH EDI
MOV ESI,EAX
MOV EDI,EDX
@@loop:
LODSD
BSWAP EAX
STOSD
LOOP @@loop
POP EDI
POP ESI
@@exit:
end;
{$ENDIF}
procedure ConvertEndianness64(const Source; var Dest); overload;
{$IFDEF PUREPASCAL}
var
S: Bytes absolute Source;
D: Bytes absolute Dest;
begin
D[0] := S[7];
D[1] := S[6];
D[2] := S[5];
D[3] := S[4];
D[4] := S[3];
D[5] := S[2];
D[6] := S[1];
D[7] := S[0];
end;
{$ELSE}
asm
MOV ECX,[EAX]
MOV EAX,[EAX+4]
BSWAP EAX
BSWAP ECX
MOV [EDX],EAX
MOV [EDX+4],ECX
end;
{$ENDIF}
procedure Frac32RootPrimes(var Dest: array of LongWord; Base: Integer);
var
I, N, D: Integer;
IsPrime: Boolean;
begin
N := 1;
for I := 0 to High(Dest) do
begin
repeat
Inc(N);
IsPrime := True;
for D := N - 1 downto 2 do
if N mod D = 0 then
begin
IsPrime := False;
Break;
end;
until IsPrime;
Dest[I] := Trunc(Frac(Exp(Ln(N) / Base)) * $100000000);
end;
end;
// ----------------------------------------------------------------------------
function S0(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 2) xor ROR(x, 13) xor ROR(x, 22);
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,2
ROR EDX,13
ROR ECX,22
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function S1(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 6) xor ROR(x, 11) xor ROR(x, 25);
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,6
ROR EDX,11
ROR ECX,25
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function _s0(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 7) xor ROR(x, 18) xor x shr 3;
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,7
ROR EDX,18
SHR ECX,3
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
function _s1(x: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := ROR(x, 17) xor ROR(x, 19) xor x shr 10;
end;
{$ELSE}
asm
MOV EDX,EAX
MOV ECX,EAX
ROR EAX,17
ROR EDX,19
SHR ECX,10
XOR EAX,EDX
XOR EAX,ECX
end;
{$ENDIF}
var
K: array[0..63] of LongWord;
InitialHashValue: TSHA256HashValue;
procedure Process(const M; var _H: TSHA256HashValue);
var
W: array[0..63] of LongWord;
t, a, b, c, d, e, f, g, h, T1, T2: LongWord;
begin
// 1. Preparing the message schedule, {Wt}:
ConvertEndianness32(M, W, 16);
for t := 16 to 63 do
W[t] := _s1(W[t - 2]) + W[t - 7] + _s0(W[t - 15]) + W[t - 16];
// 2. Initializing the eight working variables with the (i-1)'st hash value:
a := _H[0];
b := _H[1];
c := _H[2];
d := _H[3];
e := _H[4];
f := _H[5];
g := _H[6];
h := _H[7];
// 3.
for t := 0 to 63 do
begin
T1 := h + S1(e) + {Ch}((e and f) xor ((not e) and g)){/Ch} + K[t] + W[t];
T2 := S0(a) + {Maj}((a and b) xor (a and c) xor (b and c)){/Maj};
h := g;
g := f;
f := e;
e := d + T1;
d := c;
c := b;
b := a;
a := T1 + T2;
end;
// 4. Computing the i'th intermediate hash value H(i):
Inc(_H[0], a);
Inc(_H[1], b);
Inc(_H[2], c);
Inc(_H[3], d);
Inc(_H[4], e);
Inc(_H[5], f);
Inc(_H[6], g);
Inc(_H[7], h);
end;
{ TSHA256Calc }
constructor TSHA256Calc.Create;
begin
FHashValue := InitialHashValue;
end;
procedure TSHA256Calc.Input(const Data; Length: Cardinal);
var
I, Index, PartLen: Cardinal;
begin
Index := FCount and High(TSHA256MessageBuffer);
Inc(FCount, Length);
PartLen := SizeOf(TSHA256MessageBuffer) - Index;
if Length >= PartLen then
begin
Move(Data, FBuffer[Index], PartLen);
Process(FBuffer, FHashValue);
I := PartLen;
while I + SizeOf(TSHA256MessageBuffer) <= Length do
begin
Process(Bytes(Data)[I], FHashValue);
Inc(I, SizeOf(TSHA256MessageBuffer));
end;
Index := 0;
end
else
I := 0;
Move(Bytes(Data)[I], FBuffer[Index], Length - I);
end;
function TSHA256Calc.Final: TSHA256MessageDigest;
var
BitLength: Int64;
BitLengthBigEndian: array[0..7] of Byte;
Padding: TSHA256MessageBuffer;
PadLen: Integer;
begin
try
BitLength := FCount shl 3;
ConvertEndianness64(BitLength, BitLengthBigEndian);
PadLen := (SizeOf(TSHA256MessageBuffer) * 2 - SizeOf(BitLength) - 1 - FCount
and High(TSHA256MessageBuffer)) and High(TSHA256MessageBuffer) + 1;
FillChar(Padding, PadLen, 0);
Padding[0] := $80;
Input(Padding, PadLen);
Input(BitLengthBigEndian, SizeOf(Int64));
ConvertEndianness32(FHashValue, Result, Length(FHashValue));
finally
Free;
end;
end;
// ----------------------------------------------------------------------------
function SHA256MessageDigest(const Message;
Length: Cardinal): TSHA256MessageDigest;
begin
with TSHA256Calc.Create do
try
Input(Message, Length);
finally
Result := Final;
end;
end;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
begin
Result := SHA256MessageDigest(Pointer(S)^, Length(S));
end;
function SHA256FileMessageDigest(const FileName: string;
OnProgress: TProgressEvent): TSHA256MessageDigest;
var
F: file;
Buf: array[0..$fff] of Byte;
Read: Cardinal;
Current, Total: Int64;
begin
AssignFile(F, FileName);
FileMode := 0;
Reset(F, 1);
try
with TSHA256Calc.Create do
try
Current := 0;
Total := FileSize(F);
while True do
begin
BlockRead(F, Buf, SizeOf(Buf), Read);
if Read = 0 then
Break;
Input(Buf, Read);
Inc(Current, Read);
if Assigned(OnProgress) then
OnProgress(Current, Total);
end;
finally
Result := Final;
end;
finally
CloseFile(F);
end;
end;
var
HexChars: array[0..$f] of Char;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
var
I: Integer;
TempStr: string[SizeOf(TSHA256MessageDigest) * 2];
begin
TempStr := '';
for I := 0 to High(D) do
TempStr := TempStr + HexChars[D[I] shr 4] + HexChars[D[I] and $f];
Result := TempStr;
end;
var
I: Integer;
initialization
Frac32RootPrimes(K, 3);
Frac32RootPrimes(InitialHashValue, 2);
for I := 0 to 9 do
HexChars[I] := Chr(Ord('0') + I);
for I := $a to $f do
HexChars[I] := Chr(Ord('a') + (I - $a));
end.