const
  n = 10000;

var
  Form1: TForm1;
  a: string;
  lin: array [1..n] of shortstring;
  kol, lenn: integer;

implementation

{$R *.dfm}

function check(f: string; var kol2: integer; len: integer): boolean;
  var
    i: integer;
    ok: boolean;
begin
  ok:=false;
  for i:=1 to kol do
    if f = lin[i] then
      begin
        delete(a, kol2 - len, len);
        dec(kol2, len);
        dec(lenn, len);
        ok:=true;
        break;
      end;
  if not ok then
    begin
      inc(kol);
      lin[kol]:=f;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    i: integer;
    f: shortstring;
begin
  a:=Edit1.Text;
  for i:=1 to kol do
    lin[i]:='';
  i:=1;
  kol:=0;
  f:='';
  a:=a+' ';

  lenn:=length(a);
  while i <= lenn do
    begin
      if a[i] in ['A'..'Z', 'a'..'z'] then f:=f + a[i]
      else
        if (a[i] in [',', '.', '!', ';', ':', ' ']) then
          begin
            check(f, i, length(f));
            f:='';
            if a[i] = ' ' then if a[i-1] = ' ' then
              begin
                delete(a, i-1, 1);
                dec(i);
                dec(lenn);
              end;
          end;
      inc(i);
    end;
  Edit2.Text:=a;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ComCtrls, ExtCtrls, XPMan;
const     Lmax=100;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    Label2: TLabel;
    XPManifest1: TXPManifest;

    procedure Button3Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  type TArr=array[1..Lmax] of integer;
   Tmar=array[1..Lmax] of integer;

var
  Form1: TForm1;
  a: SET of 1..255;
  shifr:array[1..Lmax] of char;
  b: SET of 1..Lmax;
  str1,str2:string;
  i1,j1,k1:integer;
  password:TArr;
implementation

{$R *.dfm}


procedure TForm1.Button3Click(Sender: TObject);
var str, S,t: String; lk,jjj: Integer;
begin
Button4.Enabled:=true;
str:=Edit1.Text;
S:='';
LK:=1;
i1:=1;
begin
For k1:=1 to Length(EDIT1.Text) do
BEGIN
FOR J1:=1 TO 32 DO
IF STR[I1]=StringGrid1.Cells[j1,0] THEN begin
S:=S+StringGrid1.Cells[J1,LK]; Inc(i1); LK:=lk+1; break;
END;
If lk=Length(EDIT4.Text)+1 then lk:=1;
END;
end;
Edit2.Text:=S;
end;




procedure TForm1.Edit1Change(Sender: TObject);
begin
If edit1.Text='' then Button3.Enabled:=false else
Button3.Enabled:=true;
Button4.Enabled:=false;
edit2.Text:=''; edit3.Text:='';
end;

procedure TForm1.Button4Click(Sender: TObject);
var str, S: String; lk,jjj: Integer;
begin
str:=Edit2.Text;
S:='';
LK:=1;
i1:=1;
begin
For k1:=1 to Length(EDIT1.Text) do
BEGIN
FOR J1:=1 TO 32 DO
IF STR[I1]=StringGrid1.Cells[J1,LK] THEN begin
S:=S+StringGrid1.Cells[j1,0]; Inc(i1); LK:=lk+1; break;
END;
If lk=Length(EDIT4.Text)+1 then lk:=1;
END;
end;
Edit3.Text:=S;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
J1:=1;
 FOR I1:=ORD('А') TO ORD('Я') DO BEGIN
 StringGrid1.Cells[J1,0]:=CHR(I1);
 J1:=J1+1;
 end;
 Edit4Change(sender); Edit1Change(sender);
 end;

procedure TForm1.Edit4Change(Sender: TObject);
var str :string;
kol:integer;
begin
For i1:=1 to length(edit4.text) do begin
StringGrid1.Cells[0,i1]:=Edit4.text[i1];
StringGrid1.RowCount:=length(edit4.text)+1;
J1:=1;
iF StringGrid1.Cells[0,I1]<>'А' THEN begin
str:=StringGrid1.Cells[0,I1];
kol:=32-(Ord('Я')-ord(str[1])+1);
For k1:=kol to 31 do begin
StringGrid1.Cells[j1,I1]:=chr(192+K1);
j1:=J1+1;
end;
For k1:=0 to KOL do begin
StringGrid1.Cells[j1,I1]:=chr(192+K1);
j1:=J1+1;
end;
END ELSE
For J1:=1 to 32 do begin
StringGrid1.Cells[j1,I1]:=chr(192+J1);
end;
end;
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['А'..'Я',#8]) then key:=#0;
end;

end.

unit Enciphering;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  n = 1000; // длина строки
  dif  = 224; // разница между символами в ASCII
var
  Form1: TForm1;
  key, tex: string;
  tqu, kqu: integer;
  rez: string;
  tx: set of 'а'..'я';
  tnum, knum, code: array [1..n] of integer;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
  var
    i: integer;
begin
  tex:=Edit1.Text; // Для текста
  key:=Edit2.Text; // Для ключа
  rez:=''; // Наш ответ
  tqu:=length(tex); // Длина текста
  kqu:=length(key); // Длина ключа
  for i:=1 to length(tex) do tnum[i]:=-1; // Исключение инородных сиволов
  for i:=1 to length(tex) do knum[i]:=0; // Обнуление
  code:=knum;
  for i:=1 to tqu do
    if tex[i] in tx then tnum[i]:=ord(tex[i]) - dif; // Нахождение порядкового номера в алфавите (отсчет от 0 до 30)
  for i:=1 to kqu do
    knum[i]:=ord(key[i]) - dif;
  for i:=kqu + 1 to tqu  do
    knum[i]:=knum[i - kqu]; // Дополнение ключа в случае если его длина меньше длины строки
  for i:=1 to tqu do
    if tnum[i]<> -1 then code[i]:=(tnum[i] + knum[i]) mod 32  
    else code[i]:=ord(' ')-dif; // Само шифрование
  for i:=1 to tqu do
    rez:= rez + chr(code[i] + dif); // Получение ответа
  stringgrid1.ColCount:=tqu+1; 
  for i:=1 to tqu do
    StringGrid1.Cells[i, 0]:=tex[i]; 
  for i:=1 to tqu do
    StringGrid1.Cells[i, 1]:=rez[i]; // Вывод ответа
end;

end.