unit SimpleSubstitution;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ValEdit, StdCtrls;

type
  TRusDstAlphabet = array [Char] of Char;

  TfmSubstitution = class(TForm)
    mmDecryptMessage: TMemo;
    mmEncryptMessage: TMemo;
    lbDecryptMessage: TLabel;
    lbEncryptMessage: TLabel;
    btnEncryptMessage: TButton;
    btnDecpyptMessage: TButton;
    btnGenRearrangement: TButton;
    vleSubst: TValueListEditor;
    procedure FormCreate(Sender: TObject);
    procedure btnGenRearrangementClick(Sender: TObject);
    procedure btnEncryptMessageClick(Sender: TObject);
    procedure btnDecpyptMessageClick(Sender: TObject);
  private
    { Private declarations }
    RusDstAlphabet: TRusDstAlphabet;
    procedure GenRearrangment;
    function  ValidateRearrangement: Boolean;
    function  UpCaseRus(Ch: Char): Char;
    function  LowCaseRus(Ch: Char): Char;
    procedure RecalcAlphabet(nKey: Integer);
    function  EncryptDecryptString(strMsg: String): String;
  public
    { Public declarations }
  end;

var
  fmSubstitution: TfmSubstitution;

implementation

{$R *.dfm}

// функция генерации случайной перестановки
procedure TfmSubstitution.GenRearrangment;
var
  Ch, c: char;
  // нужен для определения встречался ли символ ранее
  WasGen: array [Char] of Boolean;
begin
  // заполняем массив значением False
  FillChar(WasGen, SizeOf(WasGen), False);
  for Ch := 'А' to 'Я' do
    begin
      // генерируем случайный символ до тех пор, пока
      // не будет получен еще не сгенерированный
      repeat
        c := Chr(Ord('А') + random(32));
      until not WasGen[c];
      // помечаем, что символ сгенерирован
      WasGen[c] := True;
      vleSubst.Values[Ch] := c;
    end;
end;

// проверяет корректность перестановки введенной пользователем
function TfmSubstitution.ValidateRearrangement: Boolean;
var
  i: Integer;
  s: String;
  Used: array [Char] of Boolean;
begin
  Result := False;
  FillChar(Used, SizeOf(Used), False);
  for i := 1 to vleSubst.RowCount - 1 do
    Begin
      // символ единственный в строчке?
      s := vleSubst.Cells[1, i];
      if (Length(s) <> 1) then
        Exit;
      // символ - буква русского языка?
      s[1] := UpCaseRus(s[1]);
      if not (s[1] in ['А'..'Я']) then
        Exit;
      // уже встречался ранее?
      if Used[s[1]] then Exit;
      Used[s[1]] := True;
    End;
  Result := True;
end;

function TfmSubstitution.UpCaseRus(Ch: Char): Char;
begin
  if Ch = 'ё' then Ch := 'Е';
  if Ch in ['а'..'я'] then Dec(Ch, 32);
  Result := Ch;
end;

function TfmSubstitution.LowCaseRus(Ch: Char): Char;
begin
  if Ch = 'Ё' then Ch := 'е';
  if Ch in ['А'..'Я'] then Inc(Ch, 32);
  Result := Ch;
end;

procedure TfmSubstitution.FormCreate(Sender: TObject);
var
  Ch: char;
begin
  Randomize;
  // инициализация редактора значений
  for Ch := 'А' to 'Я' do
    vleSubst.InsertRow(Ch, '', True);
  // генерация случайной перестанвки
  GenRearrangment;
end;

procedure TfmSubstitution.btnGenRearrangementClick(Sender: TObject);
begin
  GenRearrangment;
end;

procedure TfmSubstitution.btnEncryptMessageClick(Sender: TObject);
var
  i: Integer;
begin
  // проверяем корректность ввода перестановки
  if ValidateRearrangement then
    begin
      // создаем алфавит преобразования открытого текста
      RecalcAlphabet(0);
      // предотвращаем перерисовку компонента до тех пор, пока не
      // зашифруем все строчки сообщения
      mmEncryptMessage.Lines.BeginUpdate;
      // очищаем текстовый редактор
      mmEncryptMessage.Clear;
      // шифруем открытый текст построчно
      for i := 0 to mmDecryptMessage.Lines.Count - 1 do
        mmEncryptMessage.Lines.Add(EncryptDecryptString(mmDecryptMessage.Lines[i]));
      // разрешаем перерисовку компонента
      mmEncryptMessage.Lines.EndUpdate;
    end
  else
    MessageDlg('Ошибка: символы подстановки заданы не верно', mtError, [mbOk], 0);
end;

procedure TfmSubstitution.btnDecpyptMessageClick(Sender: TObject);
var
  i: Integer;
begin
  // проверяем корректность ввода перестановки
  if ValidateRearrangement then
    begin
      // создаем алфавит преобразования шифрованного текста
      RecalcAlphabet(1);
      mmDecryptMessage.Lines.BeginUpdate;
      mmDecryptMessage.Clear;
      // дешифруем шифрованный текст построчно
      for i := 0 to mmEncryptMessage.Lines.Count - 1 do
        mmDecryptMessage.Lines.Add(EncryptDecryptString(mmEncryptMessage.Lines[i]));
      mmDecryptMessage.Lines.EndUpdate;
    end
  else
    MessageDlg('Ошибка: символы подстановки заданы не верно', mtError, [mbOk], 0);
end;

procedure TfmSubstitution.RecalcAlphabet(nKey: Integer);
var
  Ch: Char;
  i: Integer;
begin
  // предварительно все символы в алфавите шифрования
  // соответствуют символам из незашифрованного алфавита
  for Ch := Low(RusDstAlphabet) to High(RusDstAlphabet) do
    RusDstAlphabet[Ch] := Ch;
  // формируем алфавит отдельно для каждого из регистров букв
  // здесь для верхнего
  for i := 1 to vleSubst.RowCount - 1 do
    RusDstAlphabet[vleSubst.Cells[nKey, i][1]] := vleSubst.Cells[1 - nKey, i][1];
  // здесь для нижнего
  for i := 1 to vleSubst.RowCount - 1 do
    RusDstAlphabet[LowCaseRus(vleSubst.Cells[nKey, i][1])] :=
        LowCaseRus(vleSubst.Cells[1 - nKey, i][1]);
end;

function TfmSubstitution.EncryptDecryptString(strMsg: String): String;
var
  i: Integer;
begin
  // преобразуем строчку посимвольно
  for i := 1 to Length(strMsg) do
    strMsg[i] := RusDstAlphabet[strMsg[i]];
  Result := strMsg;
end;

end.
