Здравствуйте, Андрей Куманюк. Ответ на пункт 6 в приложении. ABC-Pascal. Источник:
http://www.cyberforum.ru/pascal/thread33245.html, внесены некоторые исправления в индексы элементов массива.
Приложение:
{Разработать программу, осуществляющую шифрование и
расшифрование методом решетки Кардано размером 6х6
}
{ http://www.cyberforum.ru/pascal/thread33245.html }
{ Исправлено: lamed }
program p178014;
const
n = 6;
type
sType = string[n];
matrix = array[1 .. n] of sType;
const
mask: matrix = (
'.x..x.',
'.x.x..',
'..x..x',
'......',
'...x..',
'x.x...'
);
st: string =
'когдаумолкнутвсепесникоторыхянезнаю!';
var
encoded: matrix;
masked: matrix;
{ Процедура поворота матрицы }
procedure T(var res: matrix);
var
i, j: integer;
mx: matrix;
begin
mx := res;
for i := 1 to n do
for j := 1 to n do
res[j][n - i + 1] := mx[i][j];
end;
{ Зашифровка текста }
procedure EncodeText(const s: string;
const mask: matrix; var mx: matrix);
var
i, j, count: integer;
masked: matrix;
begin
{ Заполнение матрицы mx строками по N пробелов }
for i := 1 to n do
for j := 1 to n do mx[i] := mx[i] + #32;
masked := mask;
count := 1;
while count <= length(s) do begin
for i := 1 to n do
for j := 1 to n do
if masked[i][j] = 'x' then begin
mx[i][j] := s[count];
inc(count)
end;
T(masked);
end;
end;
{ Расшифровка текста }
function DecodeText(const mask, encoded: matrix): string;
var
s: string;
i, j, count: integer;
masked: matrix;
begin
masked := mask;
count := 0; s := '';
while length(s) < n*n do begin
for i := 1 to n do
for j := 1 to n do
if masked[i][j] = 'x' then s := s + encoded[i][j];
T(masked);
end;
DecodeText := s;
end;
var
i: integer;
begin
EncodeText(st, mask, encoded);
writeln('encoded text: ');
for i := 1 to n do begin
writeln(encoded[i]);
end;
writeln(DecodeText(mask, encoded));
end.