IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Программа не работает, помогите исправить
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Программа не работает, помогите исправить.

Задача:
открытый текст записывается в матрицу по определенному ключу k1,
определяющему порядок записи открытого текста в строки матрицы при
шифровании. Шифртекст образуется при считывании из этой матрицы по
ключу k2, определяющему, в каком порядке записывается информация из
столбцов матрицы. Для реализации такого варианта перестановки можно не использовать непосредственно матрицу, а осуществлять перерасчет коэф- фициентов.

Код



var
q, h: array of integer;

Text, Text_1, Text_2, text_3, S: String;

i, j,  kolsimvolov: integer;
key1: array of Byte;
key2: array of Byte;
p, m,t: Boolean;
r, b: integer;
Textmatr: Array of array of Char;

begin


write('введите кол-во строк в матрице : ');
readln(r);
write('введите кол-во столбцов в матрице : ');
readln(b);
//----
setlength(q, r);
setlength(h, b);
setlength(key1, r);
setlength(key2, b);
setlength(Textmatr, r);


repeat
Write('введите текст для кодировки: ');
Readln(Text);
kolsimvolov:=Length(text);
m:=True;
if kolsimvolov>r*b then
m:=False;
if not(m) then
writeln('Кол-во символов не должно привышать r*b ');
until m;
If (kolsimvolov div (r*b))<> 1 then
begin
text:=text+' ';
Inc(kolsimvolov);
end;
Repeat
Writeln('Введите ключ 1 , состоящий из  ',r,' символов, через "Enter"');
for i:=1 to r do
Readln(key1[i]);
p:=true;
for i:=1 to r-1 do
if (key1[i]=key1[i+1]) then
p:=false;
If Not(p) then
writeln('Все символы должны быть различны!');
Until p;
Repeat
Writeln('Введите ключ 2, состоящий из ',b,' символов, через "Enter"');
for i:=1 to b do
Readln(key2[i]);
t:=true;

for i:=1 to b-1 do
if (key2[i]=key2[i+1]) then
t:=false;
If Not(t) then
writeln('Все символы должны быть различны!');

Until t;
Writeln;
//----------------------------------------------------—
For i:=1 to r do
For j:=1 to b do
Textmatr[key1[i],j]:=Text[(i-1)*b+j];
Writeln(' k1\k2 ');
For i:=1 to r do
begin
Write(' ',i,' ');
For j:=1 to b do
write(' ',textmatr[i,j],' ');
Writeln;
end;
//----------------------------------------------------—
Text_1:='';
For j:=1 to b do
for i:=1 to r do
begin
S:=textmatr[i,key2[j]];
Text_1:=Text_1+S;
end;
Writeln('Закодированный текст:',' ',text_1);
//-----------------------------------------------------—
Text_2:='';
For j:=1 to b do
begin
S:=Copy(Text_1,(key2[j]-1)*r+1,r);
Text_2:=Text_2+S;
end;
Text_3:='';
For i:=1 to r do
For j:=1 to b do
begin
S:=Copy(Text_2,(j-1)*r+key1[i],1);
Text_3:=Text_3+S;
end;
Writeln('Раскодированный текст:',' ',Text_3);
//-----------------------------------------------------—
Writeln;
Readln;
End.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Знаток
****

Группа: Пользователи
Сообщений: 481
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  9  +


А как не работает?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Цитата(Федосеев Павел @ 21.10.2016 4:18) *

А как не работает?

После ввода ключей программа вылетает . Должно получиться как на картинке Прикрепленное изображение
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Большевик–концептуал
***

Группа: Пользователи
Сообщений: 194
Пол: Мужской
Реальное имя: Иван Левашев
Jabber: bu_gen@octagram.name
Skype: i.levashew
QQ: 3152538431
WeChat
Ада: Сторонник
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик
Turbo Pascal: Установлен

Репутация: -  1  +


Чтобы происходящее было более понятно, лучше включить проверку диапазонов в настройке проекта или директивой {$R+}. Правда, по моему опыту, некоторые версии Delphi ошибочно не проверяли диапазон динамического массива, так что не гарантирует.

У вас в SetLength для TextMatr только один размер указан.


--------------------
If you want to get to the top, you have to start at the bottom
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Цитата(OCTAGRAM @ 21.10.2016 16:39) *

Чтобы происходящее было более понятно, лучше включить проверку диапазонов в настройке проекта или директивой {$R+}. Правда, по моему опыту, некоторые версии Delphi ошибочно не проверяли диапазон динамического массива, так что не гарантирует.

У вас в SetLength для TextMatr только один размер указан.

Я исправила, но все равно не работает
Код

var
q, h: array of integer;

Text, Text_1, Text_2, text_3, S: String;

i, j,  kolsimvolov: integer;
key1: array of Byte;
key2: array of Byte;
p, m,t: Boolean;
r, b: integer;
Textmatr: Array of array of Char;

begin


write('введите кол-во строк в матрице : ');
readln(r);
write('введите кол-во столбцов в матрице : ');
readln(b);
//----
setlength(q, r);
setlength(h, b);
setlength(key1, r);
setlength(key2, b);
setlength(Textmatr, r, b);


repeat
Write('введите текст для кодировки: ');
Readln(Text);
kolsimvolov:=Length(text);
m:=True;
if kolsimvolov>r*b then
m:=False;
if not(m) then
writeln('Кол-во символов не должно привышать r*b ');
until m;
If (kolsimvolov div (r*b))<> 1 then
begin
text:=text+' ';
Inc(kolsimvolov);
end;
Repeat
Writeln('Введите ключ 1 , состоящий из  ',r,' символов, через "Enter"');
for i:=0 to r-1 do
Readln(key1[i]);
p:=true;
for i:=0 to r-1 do
if (key1[i]=key1[i+1]) then
p:=false;
If Not(p) then
writeln('Все символы должны быть различны!');
Until p;
Repeat
Writeln('Введите ключ 2, состоящий из ',b,' символов, через "Enter"');
for i:=0 to b-1 do
Readln(key2[i]);
t:=true;

for i:=0 to b-1 do
if (key2[i]=key2[i+1]) then
t:=false;
If Not(t) then
writeln('Все символы должны быть различны!');

Until t;
Writeln;
//----------------------------------------------------—
For i:=0 to r-1 do
For j:=0 to b-1 do
BEGIN
//OutPutDebugString(PWideChar(inttostr(i)+' '+inttostr(j)));
Textmatr[key1[i]-1,j]:=Text[(i)*b+j+1];
END;
Writeln(' k1\k2 ');
For i:=0 to r-1 do
begin
Write(' ',i,' ');
For j:=0 to b-1 do
write(' ',textmatr[i,j],' ');
Writeln;
end;
//----------------------------------------------------—
Text_1:='';
For j:=0 to b-1 do
for i:=0 to r-1 do
begin
S:=textmatr[i,key2[j]-1];
Text_1:=Text_1+S;
end;
Writeln('Закодированный текст:',' ',text_1);
//-----------------------------------------------------—
Text_2:='';
For j:=0 to b-1 do
begin
S:=Copy(Text_1,(key2[j]-1)*r+1,r);
Text_2:=Text_2+S;
end;
Text_3:='';
For i:=0 to r-1 do
For j:=0 to b-1 do
begin
S:=Copy(Text_2,(j-1)*r+key1[i],1);
Text_3:=Text_3+S;
end;
Writeln('Раскодированный текст:',' ',Text_3);
//-----------------------------------------------------—
Writeln;
Readln;
End.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Знаток
****

Группа: Пользователи
Сообщений: 481
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  9  +


Вот читаю сообщение студента: "После ввода ключей программа вылетает . Должно получиться как на картинке".
Куда "вылетает"?

При вводе строки для шифрования лучше так вместо нескольких строк.
    m := (kolsimvolov <= r * b);

Потом, что делают эти строки?
  if (kolsimvolov div (r * b)) <> 1 then
begin
Text := Text + ' ';
Inc(kolsimvolov);
end;

Проверка уникальности номеров ключа (ключей) - двумя циклами
  for i:=0 to r-1 do
for j:=i+1 to r-1 do
if (key1[i] = key1[j]) then
p := False;

Пока это - исправляйте. Кроме того - уважайте преподавателя и нас - воспользуйтесь форматтером исходного кода JediCodeFormat. У этого форматтера особенность - обязательно в начале должна присутствовать строка program.

Добавлено через 8 мин.
Плюс. При заполнении текстовой матрицы нужно учитывать, что размер матрицы может превосходить длину строки и тогда будет обращение к защищённой памяти и останов программы по ошибке (не "вылет").
Тут можно сделать так
  for i := 0 to r - 1 do
for j := 0 to b - 1 do
begin
//OutPutDebugString(PWideChar(inttostr(i)+' '+inttostr(j)));
if i * b + j + 1 <= Length(Text) then
Textmatr[key1[i] - 1, j] := Text[(i) * b + j + 1]
else
Textmatr[key1[i] - 1, j] := ' ';
end;


Добавлено через 8 мин.
После этих исправлений получаю
Код
введите кол-во строк в матрице : 6
введите кол-во столбцов в матрице : 4
введите текст для кодировки: ШИФРОВАНИЕ_ПЕРЕСТАНОВКОЙ
Введите ключ 1 , состоящий из  6 символов, через "Enter"
5
3
1
2
4
6
Введите ключ 2, состоящий из 4 символов, через "Enter"
4
2
3
1

k1\k2
0  И  Е  _  П
1  Е  Р  Е  С
2  О  В  А  Н
3  Т  А  Н  О
4  Ш  И  Ф  Р
5  В  К  О  Й
Закодированный текст: ПСНОРЙЕРВАИК_ЕАНФОИЕОТШВ
Раскодированный текст: ИШИФИОВАИИЕ_ИЕРЕИТАНИВКО

Т.е. обратное преобразование неправильное. Но сначала добейтесь правильного шифрования, а потом будем продолжать.

Сообщение отредактировано: Федосеев Павел -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Спасибо большое, программа заработала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Знаток
****

Группа: Пользователи
Сообщений: 481
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  9  +


Всё заработало (и кодирование и декодирование)?

Вы пользуетесь автоформаттером исходного кода?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Да, заработала и шифровка и дешифровка. И да, пользуюсь)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 4:18
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name