Kod: Tümünü seç
unit SHA256;
interface
type
TSHA256MessageDigest = array[0..31] of Byte;
TSHA256HashValue = array[0..7] of LongWord;
TSHA256MessageBuffer = array[0..63] 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;
function SHA256FileMessageDigest(const FileName: string): TSHA256MessageDigest;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
implementation
{$IFDEF MSWINDOWS}
uses
Windows;
{$ENDIF}
type
Bytes = array[0..$7ffffffe] of Byte;
LongWords = array[0..$1ffffffe] 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);
{$IFDEF PUREPASCAL}
type
Bytes = array[0..3] of Byte;
var
I: Integer;
S, D: LongWord;
begin
for I := 0 to Count - 1 do
begin
S := LongWords(Source)[I];
Bytes(D)[0] := Bytes(S)[3];
Bytes(D)[1] := Bytes(S)[2];
Bytes(D)[2] := Bytes(S)[1];
Bytes(D)[3] := Bytes(S)[0];
LongWords(Dest)[I] := D;
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);
{$IFDEF PUREPASCAL}
type
Bytes = array[0..7] of Byte;
var
Temp: Bytes;
begin
Temp[0] := Bytes(Source)[7];
Temp[1] := Bytes(Source)[6];
Temp[2] := Bytes(Source)[5];
Temp[3] := Bytes(Source)[4];
Temp[4] := Bytes(Source)[3];
Temp[5] := Bytes(Source)[2];
Temp[6] := Bytes(Source)[1];
Temp[7] := Bytes(Source)[0];
Bytes(Dest) := Temp;
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 $3f;
Inc(FCount, Length);
PartLen := 64 - Index;
if Length >= PartLen then
begin
Move(Data, FBuffer[Index], PartLen);
Process(FBuffer, FHashValue);
I := PartLen;
while I + 63 < Length do
begin
Process(Bytes(Data)[I], FHashValue);
Inc(I, 64);
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
BitLength := FCount shl 3;
ConvertEndianness64(BitLength, BitLengthBigEndian);
PadLen := (119 - FCount and $3f) and $3f + 1;
FillChar(Padding, PadLen, 0);
Padding[0] := $80;
Input(Padding, PadLen);
Input(BitLengthBigEndian, SizeOf(Int64));
ConvertEndianness32(FHashValue, Result, Length(FHashValue));
Free;
end;
// ----------------------------------------------------------------------------
function SHA256MessageDigest(const Message;
Length: Cardinal): TSHA256MessageDigest;
begin
with TSHA256Calc.Create do
try
Input(Message, Length);
Result := Final;
except
Free;
raise;
end;
end;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
begin
Result := SHA256MessageDigest(Pointer(S)^, Length(S));
end;
function SHA256FileMessageDigest(const FileName: string): TSHA256MessageDigest;
{$IFDEF MSWINDOWS}
var
FileHandle: THandle;
MapHandle: THandle;
ViewPointer: Pointer;
{$ENDIF}
begin
FillChar(Result, SizeOf(TSHA256MessageDigest), 0);
{$IFDEF MSWINDOWS}
FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN, 0);
if FileHandle <> INVALID_HANDLE_VALUE then
try
MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if MapHandle <> 0 then
try
ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
if ViewPointer <> nil then
try
Result := SHA256MessageDigest(ViewPointer^,
GetFileSize(FileHandle, nil));
finally
UnmapViewOfFile(ViewPointer);
end;
finally
CloseHandle(MapHandle);
end;
finally
CloseHandle(FileHandle);
end;
{$ENDIF}
end;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;
const
Digits: array[0..15] of Char =
('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
var
I: Integer;
TempStr: string[64];
begin
TempStr := '';
for I := 0 to 31 do
TempStr := TempStr + Digits[D[I] shr 4] + Digits[D[I] and $f];
Result := TempStr;
end;
initialization
Frac32RootPrimes(K, 3);
Frac32RootPrimes(InitialHashValue, 2);
end.
