Приложение 2

Система Цезаря с ключевым словом

unit Unit1

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, math, Unit2, Unit3;

type

TForm1 = class(TForm)

edit_key_word: TEdit;

Label1: TLabel;

edit_key_number: TEdit;

Label2: TLabel;

Memo1: TMemo;

Label3: TLabel;

Button1: TButton;

Button2: TButton;

Memo2: TMemo;

Memo3: TMemo;

Label4: TLabel;

Label5: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

function crypt_sym(x: widechar): widechar; // функция, которая будет заменять символ из шифруемого текста на символ из подстановки. Она при вызове принимает аргумент типа widechar и возвращает результат типа widechar

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

mass_1: array of char;

i, j, k, key_number: integer;

FLAG_1: boolean;

str_2, str_1, key_word: string;

str_text, str_text_1: widestring;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

setlength(str_1, 26);

for i := 1 to 26 do //цикл для вывода алфавита

begin

str_1[i] := chr(i + 96);

memo1.Lines[0] := memo1.Lines[0] + str_1[i] + ' ';

end;end;

procedure TForm1.Button1Click(Sender: TObject);

begin

setlength(mass_1, 52);

setlength(str_2, 26); // в str_2 будем формировать подстановку

setlength(key_word, length(edit_key_word.Text)); // длина строки равна длине строки, полученной с формы

key_word := edit_key_word.Text;

key_number := strtoint(edit_key_number.Text);

k := 1; // будем использовать в качестве индкса элемнтов mass_1

for i := 1 to key_number do //цикл для заполнения первой чатсти массива

begin

FLAG_1 := true;

for j := 1 to length(key_word) do // цикл проверяющий повторяется ли элемент алфавита. В строку пишутся только те, которых нет в key_word и которые располагаются до номера первой буквы ключевого слова

begin

if key_word[j] = str_1[i] then

begin

FLAG_1 := false;

break;

end; end;

if FLAG_1 = false then continue

else begin

str_2[k] := str_1[i];

inc(k);

end; end;

for i := 1 to length(key_word) do // цикл продолжающий заполнение массива

begin

str_2[k] := key_word[i];

inc(k); end;

for i := length(key_word) + 1 to 26 do

begin

FLAG_1 := true;

for j := 1 to length(key_word) do // цикл проверяющий повторяется ли элемент алфавита. В строку не пишутся те буквы, которые есть в key_word

begin

if key_word[j] = str_1[i] then

begin

FLAG_1 := false;

break;

end; end;

if FLAG_1 = false then continue

else begin

str_2[k] := str_1[i];

inc(k); end; end;

for i := 1 to 26 do //цикл для вывода подстановки

begin

memo1.Lines[2] := memo1.Lines[2] + str_2[i] + ' ';

end;

setlength(str_text, length(memo2.Lines[0])*memo2.Lines.Count); // задали длину такую, чтобы точно хватило

for i := 0 to memo2.Lines.Count do // цикл для записи всего шифруемого текста в одну строку

begin

str_text := str_text + memo2.Lines[i];

end;

for i := 1 to length(str_text) do

begin

str_text_1[i] := crypt_sym(str_text[i]); // присваиваем элементу строки результат функции crypt_sym(x: widechar): widechar

end;

memo3.Lines[0] := str_text_1 // вывод зашифрованного текста

end;

function TForm1.crypt_sym (x: widechar): widechar;

var

num: integer; // здесь будет хранить номер в алфавите того элемента, который пришёл. А потом заменять пришедший символ на символ из строки подстановки с тем же номером. А алфавит у нас хранится в строке str_1

begin

num := pos(x, str_1);

crypt_sym := widechar(str_2[num]); // widechar это функция, преобразующая строку (в нашем случае символ типа char) типа string в строку типа widestring (символ типа widechar). Это необходимо, потому что шифруемый текст у нас будет храниться в строке типа widestring, а подстановка хранится в строке типа string

end;end.

Шифр Гронсфельда

Private Sub Command1_Click()

Text3 = ""

dl = Len(Text1)

Dim a(126)

Dim b(126)

k = Val(Text2)

If k = 0 Or k > 126 Then

MsgBox "Неправильно введен ключ!", vbExclamation, "Шифрование не осуществимо!"

GoTo Z1

End If

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

q = 0

For i = 1 To 126

a(i) = Mid(ln, i, 1)

Next i

For i1 = 1 To 126

b(i1) = Mid(ln, k, 1)

k = k + 1

If k = 127 Then k = 1

Next i1

For j = 1 To dl

For j1 = 1 To 126

If Mid(Text1, j, 1) = a(j1) Then

Text3 = Text3 + b(j1)

q = 1

End If

Next j1

If q = 0 Then Text3 = Text3 + Mid(Text1, j, 1)

q = 0

Next j

Z1: End Sub

Private Sub Command2_Click()

Text6 = ""

dl = Len(Text4)

Dim a(126)

Dim b(126)

k = Val(Text5)

If k = 0 Or k > 126 Then

MsgBox "Неправильно введен ключ!", vbExclamation, "Цифрование не осуществимо!"

GoTo Z2

End If

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

For i = 1 To 126

a(i) = Mid(ln, i, 1)

Next i

For i1 = 1 To 126

b(i1) = Mid(ln, k, 1)

k = k + 1

If k = 127 Then k = 1

Next i1

For j = 1 To dl

For j1 = 1 To 126

If Mid(Text4, j, 1) = b(j1) Then

Text6 = Text6 + a(j1)

q = 1

End If

Next j1

If q = 0 Then Text6 = Text6 + Mid(Text4, j, 1)

q = 0

Next j

Z2: End Sub