RosettaCodeData/Task/ADFGVX-cipher/Free-Pascal-Lazarus/adfgvx-cipher.pas

program adfgvxcipher;

uses
  SysUtils,
  Classes;

const
  ADFGVX = 'ADFGVX';
  ALPHABET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  MESSAGE = 'ATTACKAT1200AM';

type
  //tPolybiusarr = array[1..6,1..6] of string;
  tPolybiusarr = array[1..6, 1..6] of char;

  procedure init_Polybius(var Polybius: tPolybiusarr);

    procedure ShuffleString(var S: string);
    var
      i, j: integer;
      c: char;
    begin
      for i := Length(S) downto 2 do
      begin
        j := Random(i) + 1;  // 1..i
        c := S[i];
        S[i] := S[j];
        S[j] := c;
      end;
    end;

  var
    ShuffledAlphabet: string;
    x, y, i: integer;
  begin
    ShuffledAlphabet := ALPHABET;
    ShuffleString(ShuffledAlphabet);
    i := 1;
    for x := 1 to 6 do
      for y := 1 to 6 do
      begin
        Polybius[x, y] := ShuffledAlphabet[i];
        Inc(i);
      end;
  end;

  procedure PrintPolybius(Polybius: tPolybiusarr);
  var
    x, y: integer;
    ch: char;
  begin
    writeln('The 6 x 6 Polybius square:');
    writeln;
    Write('  |');
    for ch in ADFGVX do
      Write(ch: 2);
    writeln;
    writeln('---------------');
    for x := 1 to 6 do
    begin
      Write(ADFGVX[x], ' |');
      for y := 1 to 6 do
      begin
        Write(Polybius[x, y]: 2);
      end;
      writeln;
    end;
  end;

  function CreateKey(size: integer): string;

    procedure FilterList(var lst: TStringList; size: integer);

      function HasRepeatedCharacters(const str: string): boolean;
      var
        seen: array[0..255] of boolean;
        i: integer;
        c: byte;
      begin
        FillChar(seen, SizeOf(seen), False);
        for i := 1 to Length(str) do
        begin
          c := Ord(str[i]);
          if seen[c] then
            Exit(True);    // repeated character found
          seen[c] := True;
        end;
        Result := False;   // no repeats
      end;

    var
      x: integer;
    begin
      for x := lst.Count - 1 downto 0 do
        if (length(lst[x]) <> size) or HasRepeatedCharacters(lst[x]) then lst.Delete(x);
    end;

  const
    FNAME = 'unixdict.txt';
  var
    list: TStringList;
  begin
    if (size < 7) or (size > 12) then
    begin
      writeln('Key should contain between 7 and 12 letters, both inclusive.');
      halt;
    end;
    list := TStringList.Create;
    list.LoadFromFile(FNAME);
    filterlist(list, size);
    Result := UpperCase(list[random(list.Count)]);
    list.Free;
  end;

  function FindCharachter(ch: char; polybius: tPolybiusarr): string;
  var
    x, y: integer;
  begin
    for x := 1 to 6 do
      for y := 1 to 6 do
        if polybius[x, y] = ch then
          exit(ADFGVX[x] + ADFGVX[y]);
  end;

  function Encrypt(plainText, key: string; Polybius: tPolybiusarr): string;
  var
    ch: char;
    str: string;
    lst: TStringList;
    x, keylength: integer;
  begin
    str := '';
    keylength := length(key);
    lst := TStringList.Create;
    for x := 1 to keylength do
      lst.Add(key[x]);
    x := 0;
    for ch in plainText do
    begin
      lst[x] := lst[x] + FindCharachter(ch, Polybius);
      Inc(x);
      if x = keylength then x := 0;
    end;
    lst.Sort;
    writeln;
    for x := 0 to keylength - 1 do
      str := str + lst[x] + ' ';
    Result := TrimRight(str);
    lst.Free;
  end;

  function Decrypt(encryptedTex, key: string; polybius: tPolybiusarr): string;
    // Note: simplified decryption logic for demonstration purposes
    // need some work for longer messages
  var
    lst, tmp: TStringList;
    ch: char;
    s, str: string;
  begin
    lst := TStringList.Create;
    tmp := TStringList.Create;
    lst.AddDelimitedtext(encryptedTex, ' ', True);
    for ch in key do
      for str in lst do
        if str[1] = ch then
        begin
          tmp.Add(str);
          break;
        end;
    Result := '';
    s := '';
    for str in tmp do
    begin
      Result := Result + polybius[pos(str[2], ADFGVX), pos(str[3], ADFGVX)];
      if length(str) > 3 then s := s + polybius[pos(str[4], ADFGVX), pos(str[5], ADFGVX)];
    end;
    Result := Result + s;
    lst.Free;
    tmp.Free;
  end;

var
  Polybius: tPolybiusarr;
  key, encryptedMessage, decryptedMessage: string;

begin
  Randomize;
  init_Polybius(Polybius);
  PrintPolybius(Polybius);
  key := createkey(Random(12 - 7 + 1) + 7); //set length of word to 7 - 12
  encryptedMessage := Encrypt(MESSAGE, key, Polybius);
  decryptedMessage := Decrypt(encryptedMessage, key, polybius);
  writeln('The key is              : ', key);
  writeln('the plain message is    : ', MESSAGE);
  writeln('the encrypted message is: ', encryptedMessage);
  writeln('the decrypted message is: ', decryptedMessage);

end.