Шифрование SHA-1

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
Category:Алгоритмы
Category:Шифрование