Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.09.2016, 15:05   #1
Анна997
Пользователь
 
Регистрация: 15.04.2016
Сообщений: 26
По умолчанию Исправьте задачу на шифровку и расшифровку

Исправьте пожалуйста, нужно , что бы в задачи выбиралось 3 режима :
1) шифрование
2)расшифровка
3)выход
(программа работает, и кроме как режимов , ничего исправлять не нужно)
const n=30;
var a,b:array[1..n] of integer;
s,s1,s2,r:string;
i, j, p, key:byte;
m:set of byte;
begin
writeln('Введите текст для шифрования: ');
readln(s);
writeln('-------------------------------------------------');
write('Введите количество цифр в ключе от 2 до ',n,' key= ');
readln(key);
while length(s) mod key<>0 do s:=s+' ';
writeln('Введите ключ из ',key,' цифр: ');
m:=[];
for i:=1 to key do
begin
repeat
readln(p);
until(p in [1..key])and not(p in m);
a[i]:=p;
m:=m+[p];
end;
r:='';
i:=1;
while i<=length(s)-key+1 do
begin
s1:=copy(s,i,key);
s2:='';
for j:=1 to key do
s2:=s2+s1[a[j]];
r:=r+s2;
i:=i+key;
end;
for i:=length(r) downto 1 do
if r[i]=' ' then delete(r,i,1);
writeln('--------------------------------------------------');
writeln('Зашифрованный текст: ');
writeln(r);
//создадим ключ для дешифровки
for i:=1 to key do
begin
for j:=1 to key do
if a[j]=i then b[i]:=j
end;
s:=r;
while length(s) mod key<>0 do s:=s+' ';
r:='';
i:=1;
while i<=length(s)-key+1 do
begin
s1:=copy(s,i,key);
s2:='';
for j:=1 to key do
s2:=s2+s1[b[j]];
r:=r+s2;
i:=i+key;
end;
for i:=length(r) downto 1 do
if r[i]=' ' then delete(r,i,1);
writeln('Расшифрованный текст');
writeln(r);
End.
Анна997 вне форума Ответить с цитированием
Старый 26.09.2016, 09:26   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,532
По умолчанию

Цитата:
Сообщение от Анна997 Посмотреть сообщение
Исправьте пожалуйста, нужно , что бы в задачи выбиралось 3 режима :
1) шифрование
2)расшифровка
3)выход
Код:
const 
  n=30;

procedure DoShifr;
var 
  a,b:array[1..n] of integer;
  s,s1,s2,r:string;
  i, j, p, key:byte;
  m:set of byte;
begin
// ЗДЕСЬ код шифрования
end;

procedure DoRashifr;
var 
  a,b:array[1..n] of integer;
  s,s1,s2,r:string;
  i, j, p, key:byte;
  m:set of byte;
begin
// А ЗДЕСЬ код расшифрования
end;

var
  vkey:  integer;
begin
  repeat
    writeln('укажите режим работы:1-шифр. 2-расш. 0-закончить работу:');
    readln(vkey);
    case vkey of
    1: DoShifr;
    2: DoRashifr;
    0: ;//ничего не делаем и выходим по until
    else writeln('выбран несуществующий режим работы');
    end;
  until vkey<>0;
end.
Цитата:
(программа работает, и кроме как режимов , ничего исправлять не нужно)
Код:
// ВЕСЬ этот(последующий) код НАДО "распихать" по ДВУМ процедурам 
//DoShifr --код для шифрования
//DOrashifr --код для расшифрования

  writeln('Введите текст для шифрования: ');
  readln(s);
  writeln('-------------------------------------------------');
  write('Введите количество цифр в ключе от 2 до ',n,' key= ');
  readln(key);
  while length(s) mod key<>0 do s:=s+' ';
  writeln('Введите ключ из ',key,' цифр: ');
  m:=[];
  for i:=1 to key do begin
    repeat
      readln(p);
    until(p in [1..key])and not(p in m);
    a[i]:=p;
   m:=m+[p];
  end;

  r:='';
  i:=1;
  while i<=length(s)-key+1 do begin
    s1:=copy(s,i,key);
    s2:='';
    for j:=1 to key do
      s2:=s2+s1[a[j]];
    r:=r+s2;
    i:=i+key;
  end;
  for i:=length(r) downto 1 do
    if r[i]=' ' then delete(r,i,1);
  
  writeln('--------------------------------------------------');
  writeln('Зашифрованный текст: ');
  writeln(r);

  //создадим ключ для дешифровки
  for i:=1 to key do begin
    for j:=1 to key do
      if a[j]=i then b[i]:=j
  end;
  
  s:=r;
  while length(s) mod key<>0 do s:=s+' ';
  r:='';
  i:=1;
  while i<=length(s)-key+1 do begin
    s1:=copy(s,i,key);
    s2:='';
    for j:=1 to key do
      s2:=s2+s1[b[j]];
    r:=r+s2;
    i:=i+key;
  end;
  for i:=length(r) downto 1 do
    if r[i]=' ' then delete(r,i,1);

  writeln('Расшифрованный текст');
  writeln(r);
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задание на шифровку цифр по паскалю не умею писать проги... Denisokin Паскаль, Turbo Pascal, PascalABC.NET 3 04.04.2013 17:04
исправьте задачу. Работа с динамическими списками SnegovikON Помощь студентам 2 20.12.2011 13:13
Интересная задача на расшифровку. Marfeys Паскаль, Turbo Pascal, PascalABC.NET 2 26.12.2010 22:42
исправьте пл3 задачу pavel42 Помощь студентам 3 15.05.2009 06:55