if ctx.lenlo < (len shl 3)
    then inc(ctx.lenhi);
  inc(ctx.lenhi, len shr 29);
end;

procedure HavalFlush(ctx: THaval_CTX);
begin
  ctx.lenhi := 0;
  ctx.lenlo := 0;
  ctx.index := 0;
  fillchar(ctx.hashbuffer, sizeof(ctx.hashbuffer), 0);
  fillchar(ctx.hash, sizeof(ctx.hash), 0);
end;

procedure HavalInit(ctx: THaval_CTX);
begin
  HavalFlush(ctx);
  ctx.hash[0] := $243F6A88;
  ctx.hash[1] := $85A308D3;
  ctx.hash[2] := $13198A2E;
  ctx.hash[3] := $03707344;
  ctx.hash[4] := $A4093822;
  ctx.hash[5] := $299F31D0;
  ctx.hash[6] := $082EFA98;
  ctx.hash[7] := $EC4E6C89;
end;

procedure HavalUpdate(ctx: THaval_CTX; const Buffer; Size: longint);
var
  p: ^byte;
begin
  HavalUpdateLen(ctx, size);
  p := @buffer;
  while size > 0 do
  begin
    if(sizeof(ctx.hashbuffer) - ctx.index) <= Longword(size) then
    begin
      move(p^, ctx.hashbuffer[ctx.index], sizeof(ctx.hashbuffer)-ctx.index);
      dec(size, sizeof(ctx.hashbuffer) - ctx.index);
      inc(p, sizeof(ctx.hashbuffer) - ctx.index);
      HavalCompress(ctx);
    end else
    begin
      move(p^, ctx.hashbuffer[ctx.index], size);
      inc(ctx.index, size);
      size := 0;
    end;
  end;
end;

procedure HavalFinal(ctx: THaval_CTX; var digest);
begin
  ctx.hashbuffer[ctx.index] := $80;
  if ctx.index>118 then
    HavalCompress(ctx);
  ctx.hashbuffer[118] := ((HASH_SIZE and 3) shl 6) or (5 shl 3) or 1;
  ctx.hashbuffer[119] := (HASH_SIZE shr 2) and $FF;
  move(ctx.lenlo, ctx.hashbuffer[120], sizeof(ctx.lenlo));
  move(ctx.lenhi, ctx.hashbuffer[124], sizeof(ctx.lenhi));
  HavalCompress(ctx);
  move(ctx.hash,digest, HASH_SIZE div 8);
  HavalFlush(ctx);
end;

//****************************************************************************
//                         PRNG
//****************************************************************************

procedure PrngInit(ctx: TPrng_CTX; seed: Longword);
var
  i: byte;
begin
  ctx.x1 := (seed+PrngC1) mod PrngM1;
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x2 := ctx.x1 mod PrngM2;
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x3 := ctx.x1 mod PrngM3;
  for i := 1 to 97 do
  begin
    ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
    ctx.x2 := (ctx.x2 * PrngI2 + PrngC2) mod PrngM2;
    ctx.r[i] := (ctx.x1 + ctx.x2 / PrngM2) / PrngM1;
 end;
end;

function Prng(ctx: TPrng_CTX): Longword;
var
  i: Longword;
begin
  ctx.x1 := (ctx.x1 * PrngI1 + PrngC1) mod PrngM1;
  ctx.x2 := (ctx.x2 * PrngI2 + PrngC2) mod PrngM2;
  ctx.x3 := (ctx.x3 * PrngI3 + PrngC3) mod PrngM3;
  i := 1 + (97 * ctx.x3) div PrngM3;
  Prng := trunc($FFFFFFFF * ctx.r[i]);
  ctx.r[i] := (ctx.x1 + ctx.x2 / PrngM2) / PrngM1;
end;

procedure PrngFlush(ctx: TPrng_CTX);
var
  i: byte;
begin
  ctx.x1 := 0;
  ctx.x2 := 0;
  ctx.x3 := 0;
  for i:=1 to 97 do ctx.r[i] := 0;
end;

//****************************************************************************
//                         Key Routines
//****************************************************************************

procedure MutateKey(var key: key256);
var
  i: byte;
  exp_key: array[0..1, 0..7] of Longword;
  ran_ctx: Prng_CTX;
  hash_ctx: Haval_CTX;
  temp_key: key256;
begin
  // [1]feed key as 8 seeds into PRNG to generate 16 longs
  for i := 0 to 7 do
  begin
    PrngInit(@ran_ctx,key[i]); //use key as seed data
    exp_key[0,i]:=Prng(@ran_ctx); //expand key
    exp_key[1,i]:=not Prng(@ran_ctx); //negate to reduce PRNG relationship
  end;

  // [2]feed [1] as 64 bytes into Haval
  for i := 0 to 7 do temp_key[i] := key[i];

  HavalInit(@hash_ctx);
  HavalUpdate(@hash_ctx, exp_key[0][0], 64); // feed expanded key as data
  HavalFinal(@hash_ctx, key);

  // [3]xor(^) [2] and [1] to produce the final key
   for i := 0 to 7 do key[i] := key[i] xor temp_key[i]; //reduce HASH relationship
end;

function PasswordToKey(pass: string): Key256;
var
  i,j: Integer;
  temp_chars: array[0..42] of byte;
  key_size: byte;
  temp_key: array[0..31] of byte;
  temp_pos: byte;
  bit_pos: byte;
begin
  // [1]convert 8bit Chars to 6bit bytes
  for i := 1 to length(pass)do
    case byte(pass[i]) of
      97..122 : temp_chars[i] := byte(pass[i])-97; // if a..z assign 0-25
      65..90 : temp_chars[i] := byte(pass[i])-39; // if A..Z assign 26-51
      48..57 : temp_chars[i] := byte(pass[i])+4; // if 0..9 assign 52-61
      byte('.') : temp_chars[i] := 62; // if . assign 62
      byte('_') : temp_chars[i] := 63; // if _ assign 63
    end;

  key_size := (length(pass) * 6) div 8; // Keysize with 6bit chars

  // [2]append 6bit Chars to each other
  temp_pos := 0; // temp buffer position
  bit_pos := 0; // bit position

  for i := 0 to key_size - 1 do //concatonate 6bit chars together
  begin
    temp_key[i]:=0;
    for j:=0 to 7 do
    begin
      inc(temp_key[i],
         ((temp_chars[temp_pos] and BIT_MASK[bit_pos]) shr bit_pos) shl j);
      inc(bit_pos,1);
      if bit_pos=6 then
      begin
        bit_pos := 0;
        inc(temp_pos,1);
      end;
    end;
  end;

  // [3]make full 256bit key
  // [EDITED 04/25/01] Sorry about the bug. This was originaly done to the
  //pass phrase, but I moved it to the process the key instead and forgot to
  //adjust the length from 43 to 32 bytes.  Just change the lines of step [3].
  //Again, sorry.

  if key_size < 32 then
  begin
    j := 0;
    for i := key_size - 1 to 31 do  //fill in empty bytes
    begin
      temp_key[i] := temp_key[j]xor i;
      inc(j,1);
    end;
  end;

  // [4]eliminate english language redundancy
  MutateKey(key256(temp_key));
  PasswordToKey := key256(temp_key);
end;

function AnalyzePassword(pass: string): KeyStatistics;
var
  i, j: Longword;
  key: array[0..1023] of byte;
  chars: array[0..255] of byte;
  pat_pos, pat_len: Longword;
  ones, zeros: Longword;
  stat: KeyStatistics;
begin
  // [1]count keylenght
  stat.KeyLength := length(pass);

  // [2]copy key to buffer
  for i := 0 to stat.KeyLength - 1 do key[i] := byte(pass[i]);

  // [3]count char repetition
  for i := 0 to 255 do chars[i] := 0;
  for i := 0 to stat.KeyLength - 1 do inc(chars[key[i]], 1);

  // [4]count different characters
  stat.CharCount := 0;
  for i := 0 to 255 do
    if chars[i] <> 0 then
      inc(stat.CharCount, 1);

  // [5]count charbits
   stat.CharBits := 0;
   for i := 0 to 7 do
     if stat.CharCount > BIT_MASK[i] then
       inc(stat.CharBits, 1);

  // [6]count patterns
  pat_pos := 0;
  pat_len := 0;
  repeat
    i := pat_pos;
    repeat
      if (key[i] = key[pat_pos]) and (i <> pat_pos) then // if match is found
        repeat
          inc(pat_len, 1); // increment pattern size
          inc(i, 1); // move to next char
          inc(pat_pos, 1); // next char in pattern
        until (key[i] <> key[pat_pos]) or (i = stat.KeyLength); //until pattern ends
         inc(i,1);
      until (i > stat.KeyLength - 1); // until finished searching for this pattern
      inc(pat_pos, 1); // start new pattern with the next char
  until pat_pos > stat.KeyLength; // until all patterns have been searched

  if pat_len=0 then
    stat.Patterns := 0
  else stat.Patterns := (pat_len * 100) div stat.KeyLength;

  // [7]count bit-differential
  ones := 0;
  zeros := 0;
  for i := 0 to stat.KeyLength - 1 do
    for j := 0 to 7 do
      if (key[i] and BIT_MASK[j]) = 0 then
        inc(zeros, 1)
      else
        inc(ones, 1);

  stat.Differential := (Longword(abs(ones-zeros)) * 100) div (stat.KeyLength * 8);

  // [8]count brutelength
  stat.BruteLength := stat.CharBits * stat.KeyLength;

  // [9]count keysize
  stat.KeySize := stat.KeyLength * 8;

  // [10]count rating  :=  BL - ((((pat+dif) /2) /100) *BL)
  stat.Rating := stat.BruteLength -
      ((((stat.Patterns + stat.Differential) div 2) * stat.BruteLength) div 100);

  AnalyzePassword := stat;
end;

function  SimpleEnDecrypt(const Password, Key: string): string;
var
  I,Q : Integer;
  O   : string[255];
begin
  Q := 1;
  O := '';
  for I := 1 to Length(Password) do
  begin
    O := O + Chr(Ord(Password[I]) xor Ord(Key[Q]));
    Inc(Q);
    if Q > Length(Key) then Q := 1;
  end;
  Result := O;
end;

end.