unit EncryptingAutokey;

interface

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

type
  TRusLetters = set of Char;

  TfmEncryptingAutoKey = 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 }
    function  GetKey: String;
    function  EncryptString(strEncryptMsg: String; var strKey: String): String;
    function  DecryptString(strDecryptMsg: String; var strKey: String): String;
    procedure EncryptDecrypt(SrcLines, DstLines: TStrings; bEncrypt: Boolean);
  public
    { Public declarations }
  end;

const
  RusLetters: TRusLetters = ['А'..'я'];
var
  fmEncryptingAutoKey: TfmEncryptingAutoKey;

implementation

{$R *.dfm}

// получает текстовый ключ состоящий только из русских букв
// в случае ошибки результат - пустая строка
function TfmEncryptingAutoKey.GetKey: String;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(edKey.Text) do
    if not (edKey.Text[i] in RusLetters) then
      Exit;
  Result := edKey.Text;
end;

// шифрует строку с помощью ключа и криптограммы
function TfmEncryptingAutoKey.EncryptString(strEncryptMsg: String;
  var strKey: String): String;
var
  i: Integer;
begin
  for i := 1 to Length(strEncryptMsg) do
    if strEncryptMsg[i] in RusLetters then
      begin
        strEncryptMsg[i] := Chr(((Ord(strEncryptMsg[i]) - Ord('А')) +
                       (Ord(strKey[1]) - Ord('А'))) mod 64 + Ord('А'));
        Delete(strKey, 1, 1);
        strKey := strKey + strEncryptMsg[i];
      end;
  Result := strEncryptMsg;
end;

// дешифрует строку с помощью ключа и криптограммы
function TfmEncryptingAutoKey.DecryptString(strDecryptMsg: String;
  var strKey: String): String;
var
  i: Integer;
begin
  for i := 1 to Length(strDecryptMsg) do
    if strDecryptMsg[i] in RusLetters then
      begin
        strKey := strKey + strDecryptMsg[i];
        strDecryptMsg[i] := Chr((((Ord(strDecryptMsg[i]) - Ord('А')) -
                 (Ord(strKey[1]) - Ord('А'))) + 64) mod 64 + Ord('А'));
        Delete(strKey, 1, 1);
      end;
  Result := strDecryptMsg;
end;

// шифрует/дешифрует текст сообщения в зависимости от параметра bEncrypt
// bEncrypt = True - шифровать
// bEncrypt = False - дешифровать
procedure TfmEncryptingAutoKey.EncryptDecrypt(SrcLines,
  DstLines: TStrings; bEncrypt: Boolean);
var
  i: Integer;
  strKey: String;
begin
  strKey := GetKey;
  if strKey <> '' then
    begin
      DstLines.BeginUpdate;
      DstLines.Clear;
      if bEncrypt then
        for i := 0 to SrcLines.Count - 1 do
          DstLines.Add(EncryptString(SrcLines[i], strKey))
      else
        for i := 0 to SrcLines.Count - 1 do
          DstLines.Add(DecryptString(SrcLines[i], strKey));
      DstLines.EndUpdate;
    end
  else
    MessageDlg('Ошибка: ключ задан не верно', mtError, [mbOk], 0);
end;

procedure TfmEncryptingAutoKey.btnEncryptMessageClick(Sender: TObject);
begin
  EncryptDecrypt(mmDecryptMessage.Lines, mmEncryptMessage.Lines, True);
end;

procedure TfmEncryptingAutoKey.btnDecpyptMessageClick(Sender: TObject);
begin
  EncryptDecrypt(mmEncryptMessage.Lines, mmDecryptMessage.Lines, False);
end;

end.

