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

Шифрование 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}
function rol(const x:integer;const y:byte):integer ; //сдвиг числа x на y бит влево
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;
function PADDING(s:string;FS:integer):string; //добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам
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 Find(SearchRec)<>0;
FindClose(SearchRec);
end;

procedure TForm1.Button2Click(Sender: TObject); //Scan Button pressed
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.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...