unit EncryptDecpypt;

interface

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

type
  // исходный алфавит русского языка
  TRusSrcAlphabet = array [0..65] of Char;
  // сопоставление букв алфавита открытого текста и зашифрованного
  TRusDstAlphabet = array [Char] of Char;

  TfmCryptography = class(TForm)
    mmDecryptMessage: TMemo;
    mmEncryptMessage: TMemo;
    lbDecryptMessage: TLabel;
    lbEncryptMessage: TLabel;
    btnEncryptMessage: TButton;
    btnDecpyptMessage: TButton;
    edKey: TEdit;
    lbKey: TLabel;
    procedure btnEncryptMessageClick(Sender: TObject);
    procedure btnDecpyptMessageClick(Sender: TObject);
  private
    { Private declarations }
    RusDstAlphabet: TRusDstAlphabet;
    function  GetKey: Integer;
    procedure RecalcAlphabet(nKey: Integer);
    function  EncryptDecryptString(strMsg: String; nKey: Integer): String;
  public
    { Public declarations }
  end;

var
  RusSrcAlphabet: TRusSrcAlphabet = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ' +
                                    'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
  fmCryptography: TfmCryptography;

implementation

{$R *.dfm}

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

procedure TfmCryptography.btnDecpyptMessageClick(Sender: TObject);
var
  i: Integer;
  nKey: Integer;
begin
  nKey := GetKey;
  if nKey = -1 then
    Begin
      MessageDlg('Ошибка: ключ задан неверно', mtError, [mbOk], 0);
      Exit;
    End;
  // получаем алфавит, с помощью которого будет происходить дешифрование
  RecalcAlphabet(SizeOf(TRusSrcAlphabet) - nKey mod SizeOf(TRusSrcAlphabet));
  mmDecryptMessage.Lines.BeginUpdate;
  mmDecryptMessage.Clear;
  for i := 0 to mmEncryptMessage.Lines.Count - 1 do
    mmDecryptMessage.Lines.Add(
      EncryptDecryptString(mmEncryptMessage.Lines[i], nKey));
  mmDecryptMessage.Lines.EndUpdate;
end;

function TfmCryptography.GetKey: Integer;
var
  key, code: Integer;
begin
  Result := -1;
  // получаем текст элемента управления текстовая строка
  Val(edKey.Text, key, code);
  // ошибка во время преобразования к целому числу?
  // или ключ имеет не положительное значение?
  if (code = 0) and (0 < key) then
    Result := key;
end;

// процедура пересчета алфавита шифрования
procedure TfmCryptography.RecalcAlphabet(nKey: Integer);
var
  Ch: Char;
  i: Integer;
  LetCnt: Integer;
begin
  // предварительно все символы в алфавите шифрования
  // соответствуют символам из незашифрованного алфавита
  for Ch := Low(RusDstAlphabet) to High(RusDstAlphabet) do
    RusDstAlphabet[Ch] := Ch;
  // количество символов в алфавите
  LetCnt := SizeOf(TRusSrcAlphabet);
  // смещаем эталонный алфивит циклически влево на значение
  // заданное ключом nKey
  for i := 0 to LetCnt - 1 do
    RusDstAlphabet[RusSrcAlphabet[(i - nKey + LetCnt) mod LetCnt]] :=
        RusSrcAlphabet[i];
end;

function TfmCryptography.EncryptDecryptString(strMsg: String;
    nKey: Integer): String;
var
  i: Integer;
begin
  // каждый символ строки заменяется на соответствующий символ
  // алфавита шифрования
  for i := 1 to Length(strMsg) do
    strMsg[i] := RusDstAlphabet[strMsg[i]];
  Result := strMsg;
end;

end.
