الگوریتم رمزنگاری SHA256

[younes-98]

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.

[Batman]

با تشکر
دوست عزیز ممکنه طریقه استفاده از unit و همچنین اینکه چجوری باید چکش کرد رو توضیح بدید؟
ممنونم.
ضمن تشکر از اینکه الگوریتم md5 رو هم گذاشته بودید کدوم یکیش بهتره.

[AliReza Vafakhah]

من هم با آقای Batman هم عقیده ام ، میشه یه خورده توضیح بدید

[younes-98]

شرمنده از اینکه دیر پاسخ دادم
برای استفاده از این یونیت میتونید یک یونیت جدید ایجاد کنید بانام sha256 و کد الگوریتم sha256 را در آن کپی کنید.
در این یونیت چهار تابع اصلی و کاربردی وجود دارد که عبارتند از :


function SHA256MessageDigest(const Message;Length: Cardinal): TSHA256MessageDigest;
function SHA256StringMessageDigest(const S: string): TSHA256MessageDigest;
function SHA256FileMessageDigest(const FileName: string;OnProgress: TProgressEvent = nil): TSHA256MessageDigest;
function SHA256MessageDigestToString(const D: TSHA256MessageDigest): string;

یک مثال در محیط دلفی می تواند اینگونه باشد :


procedure TForm1.Button1Click(Sender: TObject);
var
hold:SHA256MessageDigest;
begin
hold:=HA256StringMessageDigest('younes');
Edit1.text:=SHA256MessageDigestToString(hold);
end;

[Batman]

هر چی که وارد می کنم یه کد برمیگردونه.


یعنی تمامی کدهای برگردونده شده شبیه به همه

[Batman]

حل شد.
برای هر دو تاپیک الگوریتم رمز نگاری

[kianoosh59]

الگوریتم RC2 ? مثال