unit sha1DK;

// implementation of SHA1 hash algo - pretty ugly, but working - of course you can use any other SHA1 library instead of this one

interface

uses Windows;

procedure SHA1_starts(pSHA_context: pointer);
procedure SHA1_update(pSHA_context: pointer; psrc: pointer; size: dword);
procedure SHA1_finish(pSHA_context: pointer; pdest: pointer);

// no special comments for these functions :)

type
  SHA1_context = record
    key: array [0..19] of byte;
    var1: dword;
    var2: dword;
    buffer: array [0..63] of byte;
  end;


implementation

procedure copy_block(psrc: pointer; pdest: pointer; size: dword);
type
  tdata = array [0..65535] of byte;
var
  src:  ^tdata;
  dest: ^tdata;
  i:    dword;
begin
  if (size = 0) then
    exit;
  src  := psrc;
  dest := pdest;
  for i := 0 to (size - 1) do
    dest^[i] := src^[i];
end;

procedure SHA1_process(pdata: pointer; var H1: dword; var H2: dword;
  var H3: dword; var H4: dword; var H5: dword);
type
  tbuffer = array [0..63] of byte;
const
  K: array [0..3] of Dword = ($5A827999, $6ED9EBA1, $8F1BBCDC, $CA62C1D6);
var
  t:      dword;
  buffer: ^tbuffer;
  W:      array [0..79] of dword;
  tmp, tmp2: dword;
  A, B, C, D, E: dword;

begin
  buffer := pdata;

  A := H1;
  B := H2;
  C := H3;
  D := H4;
  E := H5;

  for t := 0 to 15 do
    W[t] := (buffer^[t * 4] shl 24) or (buffer^[t * 4 + 1] shl 16) or
      (buffer^[t * 4 + 2] shl 8) or (buffer^[t * 4 + 3]);

  for t := 16 to 79 do
  begin
    tmp2 := (W[t - 3] xor W[t - 8] xor W[t - 14] xor W[t - 16]);
    W[t] := ((tmp2 shl 1) or (tmp2 shr 31));
  end;

  for t := 0 to 19 do
  begin
    tmp := ((A shl 5) or (A shr 27)) + ((B and C) or ((not B) and D)) + E + W[t] + K[0];
    E   := D;
    D   := C;
    C   := ((B shl 30) or (B shr 2));
    B   := A;
    A   := tmp;
  end;

  for t := 20 to 39 do
  begin
    tmp := ((A shl 5) or (A shr 27)) + (B xor C xor D) + E + W[t] + K[1];
    E   := D;
    D   := C;
    C   := ((B shl 30) or (B shr 2));
    B   := A;
    A   := tmp;
  end;

  for t := 40 to 59 do
  begin
    tmp := ((A shl 5) or (A shr 27)) + ((B and C) or (B and D) or (C and D)) +
      E + W[t] + K[2];
    E   := D;
    D   := C;
    C   := ((B shl 30) or (B shr 2));
    B   := A;
    A   := tmp;
  end;

  for t := 60 to 79 do
  begin
    tmp := ((A shl 5) or (A shr 27)) + (B xor C xor D) + E + W[t] + K[3];
    E   := D;
    D   := C;
    C   := ((B shl 30) or (B shr 2));
    B   := A;
    A   := tmp;
  end;

  H1 := H1 + A;
  H2 := H2 + B;
  H3 := H3 + C;
  H4 := H4 + D;
  H5 := H5 + E;
end;

procedure SHA1_starts;
var
  tmp: ^SHA1_context;
begin
  tmp := pSHA_context;
  tmp^.key[$00] := $01;
  tmp^.key[$01] := $23;
  tmp^.key[$02] := $45;
  tmp^.key[$03] := $67;

  tmp^.key[$04] := $89;
  tmp^.key[$05] := $AB;
  tmp^.key[$06] := $CD;
  tmp^.key[$07] := $EF;

  tmp^.key[$08] := $FE;
  tmp^.key[$09] := $DC;
  tmp^.key[$0A] := $BA;
  tmp^.key[$0B] := $98;

  tmp^.key[$0C] := $76;
  tmp^.key[$0D] := $54;
  tmp^.key[$0E] := $32;
  tmp^.key[$0F] := $10;

  tmp^.key[$10] := $F0;
  tmp^.key[$11] := $E1;
  tmp^.key[$12] := $D2;
  tmp^.key[$13] := $C3;

  tmp^.var1 := 0;
  tmp^.var2 := 0;
end;

procedure SHA1_step(pkey: pointer; pdata: pointer);
type
  tKey = array [0..4] of dword;
var
  key: ^tKey;

  buffer: array [0..63] of byte;
begin
  key := pkey;

  copy_block(pdata, @buffer, $40);

  SHA1_process(@buffer, key^[0], key^[1], key^[2], key^[3], key^[4]);
end;

procedure SHA1_update;
type
  tdata = array [0..65535] of byte;
var
  crypt_key: ^SHA1_context;
  src: ^tdata;

  tmp_alreadycopied: dword;
  tmp_currentpos:    dword;

begin
  crypt_key := pSHA_context;
  src := psrc;

  tmp_currentpos  := (crypt_key^.var1 and 511) shr 3;
  crypt_key^.var1 := crypt_key^.var1 + (size shl 3);

  if ((crypt_key^.var1 + (size * 8)) < (size * 8)) then
    crypt_key^.var2 := crypt_key^.var2 + 1;

  crypt_key^.var2 := crypt_key^.var2 + (size shr $1D);

  if ((tmp_currentpos + size) <= $3F) then
    copy_block(src, addr(crypt_key^.buffer[tmp_currentpos]), size)// not full
  else begin // full
    tmp_alreadycopied := $40 - (tmp_currentpos);
    copy_block(src, addr(crypt_key^.buffer[tmp_currentpos]), tmp_alreadycopied);

    SHA1_step(addr(crypt_key^.key), addr(crypt_key^.buffer));

    while ((tmp_alreadycopied + $3F) < size) do
    begin
      SHA1_step(addr(crypt_key^.key), addr(src^[tmp_alreadycopied]));
      tmp_alreadycopied := tmp_alreadycopied + $40;
    end;

    copy_block(addr(src^[tmp_alreadycopied]), addr(crypt_key^.buffer),
      (size - tmp_alreadycopied));
  end;
end;

procedure SHA1_finish;
type
  tdata = array [0..65535] of byte;
var
  crypt_key: ^SHA1_context;
  sp_key: array [0..7] of byte;
  dest: ^tdata;
  i: dword;

  tmp_val:  dword;
  tmp_pos1: dword;
  tmp_pos2: dword;

  tmp_crypt: dword;
begin
  crypt_key := pSHA_context;
  dest      := pdest;

  // part1
  for i := 0 to 7 do
  begin
    if i < 4 then
      tmp_val := crypt_key^.var2
    else
      tmp_val := crypt_key^.var1;
    tmp_pos1 := (3 - (i mod 4));
    sp_key[i] := (tmp_val shr (tmp_pos1 * 8));
  end;

  //part2
  tmp_crypt := $80;
  SHA1_update(crypt_key, addr(tmp_crypt), 1);
  tmp_crypt := $00;
  while (((crypt_key^.var1 shr 3) and 63) < $38) do
    SHA1_update(crypt_key, addr(tmp_crypt), 1);
  SHA1_update(crypt_key, addr(sp_key), 8);

  // part3
  for i := 0 to $13 do
  begin
    tmp_pos2 := (i div 4) * 4;
    tmp_val  := ((crypt_key^.key[tmp_pos2 + 0])) +
      ((crypt_key^.key[tmp_pos2 + 1]) shl $08) +
      ((crypt_key^.key[tmp_pos2 + 2]) shl $10) +
      ((crypt_key^.key[tmp_pos2 + 3]) shl $18);
    tmp_pos1 := (3 - (i mod 4));
    dest^[i] := (tmp_val shr (tmp_pos1 * 8));
  end;

  // part4
  for i := 0 to 7 do
    sp_key[i] := 0;
  for i := 0 to $13 do
    crypt_key^.key[i] := 0;
  for i := 0 to $3F do
    crypt_key^.buffer[i] := 0;
  crypt_key^.var1 := 0;
  crypt_key^.var2 := 0;
end;

end.