Шифрование SHA-1
Материал из DRKB
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
Dialogs;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
BStop: TButton;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure BStopClick(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
const
HC0 = $67452301;
HC1 = $EFCDAB89;
HC2 = $98BADCFE;
HC3 = $10325476;
HC4 = $C3D2E1F0;
K1 = $5A827999;
K2 = $6ED9EBA1;
K3 = $8F1BBCDC;
K4 = $CA62C1D6;
var
H0, H1, H2, H3, H4: Integer;
Hout: string; // Hout - результат
StopScan: Boolean;
implementation
{$R *.DFM}
// круговой сдвиг числа x на y бит влево
function rol(const x: Integer; const y: Byte): Integer;
begin
asm
mov eax,x
mov cl, y
rol eax,cl
mov x, eax
end;
Result := x;
end;
// Инициализация - присвоить переменным значения констант
procedure Init;
begin
H0 := HC0; // $67452301;
H1 := HC1; // $EFCDAB89;
H2 := HC2; // $98BADCFE;
H3 := HC3; // $10325476;
H4 := HC4; // $C3D2E1F0;
Hout := '';
end;
// добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам
function Padding(s: string; FS: Integer): string;
var
size, i: Integer;
begin
size := Length(s) * 8; // size -входной размер в битах
s := s + Char(128); // добавление одного бита (1000000=128)
while (Length(s) mod 64) <> 0 do
s := s + #0; // добавление нулей до кратности 64 байтам
// ############ #############
// IF ((size) >= 448) then // OLD
if ((size mod 512) >= 448) then // если хвост превышает 48 байт то добавить пустой блок из 64 нулей
begin
s := s + #0; // добавление нулей до кратности 64
while (Length(s) mod 64) <> 0 do
s := s + #0;
end;
i : =Length(s);
size := FS * 8;
while size > 0 do // запись в конец строки её размер
begin
s[i] := Char(Byte(size)); // получение младшего байта
size := size shr 8; // сдвиг вправо на 8 бит - перенос старшего байта на место младшего
i := i-1;
end;
Result := s;
end;
procedure Start(const S_IN: string);
var
A, B, C, D, E, TEMP: Integer;
t, i: Byte;
W: array[0..79] of integer;
begin
t := 1;
for i := 1 to ((Length(S_IN)) div 4) do
begin
// W[i-1] := Ord(S_IN[t])*256*256*256+ord(S_IN[t+1])*256*256+ord(S_IN[t+2])*256+ord(S_IN[t+3]);
W[i-1] := (Ord(S_IN[t]) shl 24) + (Ord(S_IN[t+1]) shl 16) + (Ord(S_IN[t+2]) shl 8) + Ord(S_IN[t+3]);
t := t + 4;
end;
for t := 16 to 79 do
W[t] := ROL(W[t-3] xor W[t-8] xor W[t-14] xor W[t-16], 1);
A := H0;
B := H1;
C := H2;
D := H3;
E := H4;
{ for t:=0 to 79 do // Разделить на 4 цикла !!! * * * * * * * * * * * * * * *
begin
if (t >= 0) AND (t <= 19) then TEMP := ROL(A, 5) + ((B AND C) OR ((NOT B) AND D)) + E + K1 + W[t];
if (t >= 20) AND (t <= 39) then TEMP := ROL(A, 5) + (B XOR C XOR D) + E + K2 + W[t];
if (t >= 40) AND (t <= 59) then TEMP := ROL(A, 5) + ((B AND C) OR (B AND D) OR (C AND D)) + E + K3 + W[t];
if (t >= 60) AND (t <= 79) then TEMP := ROL(A, 5) + (B XOR C XOR D) + E + K4 + W[t];
E := D;
D := C;
C := ROL(B, 30);
B := A;
A := TEMP;
end;
}
for t := 0 to 19 do
begin
TEMP := ROL(A, 5) + ((B and C) or ((not B) and D)) + E + K1 + W[t];
E := D;
D := C;
C := ROL(B, 30);
B := A;
A := TEMP;
end;
for t := 20 to 39 do
begin
TEMP := ROL(A, 5) + (B xor C xor D) + E + K2 + W[t];
E := D;
D := C;
C := ROL(B, 30);
B := A;
A := TEMP;
end;
for t := 40 to 59 do
begin
TEMP := ROL(A, 5) + ((B and C) or (B and D) or (C and D)) + E + K3 + W[t];
E := D;
D := C;
C := ROL(B, 30);
B := A;
A := TEMP;
end;
for t := 60 to 79 do
begin
TEMP := ROL(A, 5) + (B xor C xor D) + E + K4 + W[t];
E := D;
D := C;
C := ROL(B, 30);
B := A;
A := TEMP;
end;
H0 := A + H0;
H1 := B + H1;
H2 := C + H2;
H3 := D + H3;
H4 := E + H4;
//Form1.memo1.Lines.Add(IntToHex(H0,8)+' '+IntToHex(H1,8)+' '+IntToHex(H2,8)+' '+IntToHex(H3,8)+' '+IntToHex(H4,8));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowState := wsMaximized;
Form1.Memo1.Clear;
Button2.Enabled := False;
Form1.SaveDialog1.Filter := 'Text Files (*.txt)|*.TXT|All Files (*.*)|*.*';
CheckBox1.Checked := True;
CheckBox2.Checked := True;
Application.Title := 'SHA-1';
Caption := 'SHA-1';
end;
procedure Work(Z: string);
var
s, s1: string;
i, L, FS: Integer;
F: file;
n: Integer;
Buf: array[1..65536] of Char;
begin
Application.ProcessMessages;
if StopScan then exit;
s := '';
AssignFile(F, Z);
FileMode := FmOpenRead;
Reset(F, 1);
FS := FileSize(F);
Init();
repeat
BlockRead(F, Buf, SizeOf(Buf), n);
SetLength(s1, n);
for i := 1 to n do
s1[i] := Buf[i];
// s:=s+s1;
s := s1;
L := Length(s1);
if ((L < 65536) and (L > 0)) then
begin
s1 := Padding(s, FS);
i := 1;
L := Length(s1);
while i < L do
begin
Start(Copy(s1, i, 64));
i := i + 64;
end;
end;
if L = 65536 then
begin
i := 1;
L := Length(s1);
while i < L do
begin
Start(Copy(s1, i, 64));
i := i + 64;
end;
end;
until n = 0;
CloseFile(F);
{
Init();
s := Padding(s, FS);
L := Length(s);
i := 1;
while i < L do
begin
Start(Copy(s, i, 64));
i := i + 64;
end;
}
Hout := IntToHex(H0, 8)
+ ' ' + IntToHex(H1, 8)
+ ' ' + IntToHex(H2, 8)
+ ' ' + IntToHex(H3, 8)
+ ' ' + IntToHex(H4, 8);
s1 := Hout;
if (Form1.CheckBox1.Checked and Form1.CheckBox2.Checked) then
Form1.Memo1.Lines.Add(s1 + ' ' + IntToStr(FS) + ' ' + ExtractFileName(Z));
if not ((Form1.CheckBox1.Checked and Form1.CheckBox2.Checked)) then
Form1.Memo1.Lines.Add(s1);
if (Form1.CheckBox1.Checked and not Form1.CheckBox2.Checked) then
Form1.Memo1.Lines.Add(s1 + ' ' + IntToStr(FS));
if (not Form1.CheckBox1.Checked and Form1.CheckBox2.Checked) then
Form1.Memo1.Lines.Add(s1 + ' ' + ExtractFileName(Z));
// abc.....opq = 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1
// abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopqW = 39958831d7dd0a53e9bfba578cdf45e5ec542e8c
//abc = A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D;
//abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnop = 47B17281 0795699F E739197D 1A1F5960 700242F1
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Form1.OpenDialog1.Execute then
begin
StopScan := False;
Work(OpenDialog1.FileName);
Button2.Enabled := True;
end;
end;
function ScanDir(Dir: string): string;
var
SearchRec: TSearchRec;
//scan_result: string;
begin
Application.ProcessMessages;
if StopScan then exit;
if Dir <> '' then
if Dir[Length(Dir)] <> '\' then
Dir := Dir + '\';
if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
repeat
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
Continue;
if ((SearchRec.Attr and faDirectory) <> 0) then
begin
if Form1.CheckBox3.Checked then
ScanDir(Dir + SearchRec.Name)
end
else
Work(Dir + SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
// Scan Button pressed
procedure TForm1.Button2Click(Sender: TObject);
begin
if Button2.Enabled = False then exit;
StopScan := False;
Caption := 'Scanning ...';
ScanDir(ExtractFileDir(Form1.OpenDialog1.FileName));
Caption := 'SHA-1';
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Memo1.Height := Height - 70;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
if FileExists(SaveDialog1.FileName) then
if MessageDlg('File' + #13 + SaveDialog1.FileName + #13 + 'already exists!'
+ #13 + #13 + 'Overwrite (Yes/No) ?', mtWarning, [mbYes, mbNo], 0) = mrNo then exit;
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Form1.Memo1.Clear;
end;
procedure TForm1.BStopClick(Sender: TObject);
begin
StopScan := True;
end;
end.
ID: 03994