Шифрование 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