Небольшой Генератор паролей на основе randomPoisson.

[fedan]

Код: Выделить всё

program gen_password;

uses
  SysUtils;
//  Math;
//  character;

function randomPoisson(mean: integer): integer;
  { Generator for Poisson distribution (Donald Knuth's algorithm) }
const
  RESOLUTION = 1000;
var
  k: integer;
  b, l: ValReal;
begin
  assert(mean > 0, 'mean < 1');
  k := 0;
  b := 1;
  l := exp(-mean);
  while b > l do
  begin
    k := k + 1;
    b := b * random(RESOLUTION) / RESOLUTION;
  end;
  Result := k - 1;
end;

const
  Keywords = '!$%&0123456789<>?ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz';
  KeywordsLength = Length(Keywords);

function makePass1: string;
var
  I, J, K: integer;
  tmp: string;
//  PassLen: integer;
  c: char;
  code, MaxCycles: integer;
begin
  tmp := Keywords;

  //  code := 1234;
  MaxCycles := 255;
  //  RandSeed := code;
  Randomize;
  for i := 1 to MaxCycles do
  begin
    j := trunc(KeywordsLength * random) + 1;
    k := trunc(KeywordsLength * random) + 1;
    c := tmp[j];
    tmp[j] := tmp[k];
    tmp[k] := c;
  end;

  I := randomPoisson(KeywordsLength shr 1);
  Writeln(I);
  Result := '';
  repeat
    c := tmp[randomPoisson(KeywordsLength)];
    while (Ord(c) = 0) or (Pos(c, Result) > 0) do
      c := tmp[randomPoisson(KeywordsLength)];
    Result := Result + c;
    Dec(I)
  until I = 0;
end;

function makePass2: string;
var
  PassLen: integer;
  c: char;
begin
  Result := '';
  Randomize;
  PassLen := randomPoisson(KeywordsLength shr 1);
  Writeln(PassLen);

  repeat
    c := Keywords[trunc(KeywordsLength * random) + 1];
    while (Ord(c) = 0) or (Pos(c, Result) > 0) do
      c := Keywords[trunc(KeywordsLength * random) + 1];
    Result := Result + c;
    Dec(PassLen)
  until PassLen = 0;
end;

begin
//  Writeln(makePass1);
  Writeln(makePass2);
end.


Добавлено спустя 14 минут 19 секунд:
Алгоритм всегда выбирает уникальные символы из набора, т.е. повторяющихся символов нет.
Может кому пригодится, я им генерирую пароли для разных сайтов.
Keywords можно расширить, но некоторые сайты не принимают спецсимволы.