04.10.2012, 15:52 | #11 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
1. По ИСХОДНОЙ фразе (в данном случае "ШИФРОВАНИЕ ПЕРЕСТАНОВКОЙ") создать кодированную ("ПСНОРЙЕРВАИК ЕАНФОИЕОТШВ"). 2. По кодированной фразе восстановить исходную. В данной программе первая часть отсутствует. Предлагаю Вам написать ее самостоятельно - это несложно. Удачи. |
04.10.2012, 15:52 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Потратьте минутку на прочтение аналогичных по содержанию топиков При загрузке экран с буквами на ACER ASPIRE 5750G Матрицы в С++ Матрицы |
04.10.2012, 15:56 | #12 (permalink) |
Новичок
Регистрация: 29.09.2012
Сообщений: 5
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Код HTML:
program Project2; {$APPTYPE CONSOLE} uses SysUtils,windows; Var Text,Text_1,Text_2,text_3,S:String; Textmatr:Array[1..6,1..4] of Char; i,j,k,kolsimvolov:integer; key1:array[1..6] of Byte; key2:array[1..4] of Byte; p,t,m:Boolean; Begin SetConsoleCP(1251); SetConsoleOutputCP(1251); //------------------------------------------------------------- repeat Write('Введи текст для кодировки: '); Readln(Text); kolsimvolov:=Length(text); m:=True; if kolsimvolov>6*4 then m:=False; if not(m) then writeln('количество символов не должно превышать 24'); until m; //------------------------------------------------------------- If (kolsimvolov mod 24)<> 0 then //если кол-во символов текста не кратно кол-ву символов в блоке дополняем его пробелами begin text:=text+' '; Inc(kolsimvolov); end; //------------------------------------------------------------ Repeat Writeln('Введите ключ1'); for i:=1 to 6 do Readln(key1[i]); p:=true; for i:=1 to 5 do if (key1[i]=key1[i+1]) then p:=false; If Not(p) then writeln('Все символы должны быть различными!'); Until p; //------------------------------------------------------------- Repeat Writeln('Введите ключ2'); for i:=1 to 4 do Readln(key2[i]); t:=true; for i:=1 to 3 do if (key2[i]=key2[i+1]) then t:=false; If Not(t) then writeln('Все символы должны быть различными!'); Until t; Writeln; //------------------------------------------------------ For i:=1 to 6 do For j:=1 to 4 do Textmatr[key1[i],j]:=Text[(i-1)*4+j]; Writeln(' k1\k2 1 2 3 4'); For i:=1 to 6 do begin Write(' ',i,' '); For j:=1 to 4 do write(' ',textmatr[i,j],' '); Writeln; end; //------------------------------------------------------ Text_1:=''; For j:=1 to 4 do for i:=1 to 6 do begin S:=textmatr[i,key2[j]]; Text_1:=Text_1+S; end; Writeln('Закодированный текст:',' ',text_1); //------------------------------------------------------- Text_2:=''; For j:=1 to 4 do begin S:=Copy(Text_1,(key2[j]-1)*6+1,6); Text_2:=Text_2+S; end; Text_3:=''; For i:=1 to 6 do For j:=1 to 4 do begin S:=Copy(Text_2,(j-1)*6+key1[i],1); Text_3:=Text_3+S; end; Writeln('Раскодированный текст:',' ',Text_3); //------------------------------------------------------- Writeln; Readln; End. |
04.10.2012, 16:09 | #13 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
К сожалению, сходу не отвечу, надо это вспоминать, вникать, разбираться... Но для начала - мне не понравилась проверка на одинаковость цифр в коде: Вы тестируете только смежные, а надо все со всеми, т.е. тут необходим двойной цикл.
|
04.10.2012, 21:19 | #14 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Поправил. С ума сойти - уникальная комбинация: ошибка не вылезла в первом варианте. Но теперь всё нормально. Заодно еще кое-где кое-что подчистил.
Код:
program Project2; {$APPTYPE CONSOLE} uses SysUtils,windows; Var Text,Text_1,Text_2,text_3,S:String; SS:Array[1..4] of String; Textmatr:Array[1..6,1..4] of Char; i,j,k,kolsimvolov,Code:integer; key1:array[1..6] of Byte; key2:array[1..4] of Byte; p:Boolean; Begin SetConsoleCP(1251); SetConsoleOutputCP(1251); //------------------------------------------------------------- repeat Write('Введите текст для кодировки: '); Readln(Text); kolsimvolov:=Length(text); if kolsimvolov>6*4 then writeln('количество символов не должно превышать 24'); until kolsimvolov<=6*4; //------------------------------------------------------------- If kolsimvolov<24 then //если кол-во символов текста не кратно кол-ву символов в блоке дополняем его пробелами repeat text:=text+' '; Inc(kolsimvolov); until kolsimvolov=24; //------------------------------------------------------------ Repeat Write('Введите ключ1 (6 цифр): '); Readln(S); for i:=1 to 6 do Val(S[i],key1[i],Code); p:=true; for i:=1 to 5 do for j:=i+1 to 6 do if (key1[i]=key1[j]) then p:=false; If Not(p) then writeln('Все символы должны быть различными!'); Until p; //------------------------------------------------------------- Repeat Write('Введите ключ2 (4 цифры): '); Readln(S); for i:=1 to 4 do Val(S[i],key2[i],Code); p:=true; for i:=1 to 3 do for j:=i+1 to 4 do if (key2[i]=key2[j]) then p:=false; If Not(p) then writeln('Все символы должны быть различными!'); Until p; Writeln; //------------------------------------------------------ For i:=1 to 6 do For j:=1 to 4 do Textmatr[key1[i],j]:=Text[(i-1)*4+j]; Writeln(' k1\k2 1 2 3 4'); For i:=1 to 6 do begin Write(' ',i,' '); For j:=1 to 4 do write(' ',textmatr[i,j],' '); Writeln; end; //------------------------------------------------------ Text_1:=''; For j:=1 to 4 do for i:=1 to 6 do begin S:=textmatr[i,key2[j]]; Text_1:=Text_1+S; end; Writeln('Закодированный текст: ',text_1); //------------------------------------------------------- Text_2:=''; For j:=1 to 4 do SS[key2[j]]:=Copy(Text_1,(j-1)*6+1,6); For j:=1 to 4 do Text_2:=Text_2+SS[j]; //------------------------------------------------------- Text_3:=''; For i:=1 to 6 do For j:=1 to 4 do begin S:=Copy(Text_2,(j-1)*6+key1[i],1); Text_3:=Text_3+S; end; Writeln('Раскодированный текст: ',Text_3); //------------------------------------------------------- Writeln; Readln; End. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|