SHA1-хеширование, реализация на Delphi

unit sha1hash;

interface

uses sysutils;

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;

function sha1(z: RawByteString): string;

implementation

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;
end;

// добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам
function PADDING(S: RawByteString; FS: integer): RawByteString; 
var
  size, i: integer;
begin
  size := Length(S) * 8; // size -входной размер в битах
  S := S + #$80; // добавление одного бита  (1000000=128)

  while (Length(S) mod 64) <> 0 do
    S := S + #0; // добавление нулей до кратности 64  байтам

  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 := ansichar(byte(size)); // получение младшего байта
    size := size shr 8; // сдвиг вправо на 8 бит - перенос старшего байта на место младшего
    i := i - 1;
  end;
  Result := S;
end;

Procedure START(const S_IN: RawByteString);
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 := (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 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;
end;

function min(A, B: integer): integer;
begin
  Result := (-abs(A - B) + A + B) div 2;
end;

function sha1(z: RawByteString): string;
var
  S, s1: RawByteString;
  i, L, FS: integer;
begin
  S := '';
  FS := Length(z);
  INIT;
  repeat
    L := min(65536, Length(z));
    S := copy(z, 1, L);
    delete(z, 1, L);
    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 = 0 then
    begin
      s1 := PADDING(S, FS);
      START(copy(s1, 1, 64));
    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 Length(z) = 0;
  Result := IntToHex(H0, 8) + IntToHex(H1, 8) + IntToHex(H2, 8) + IntToHex(H3,
    8) + IntToHex(H4, 8);
end;

end.