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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.10.2013, 18:12   #1
nata34
Новичок
Джуниор
 
Регистрация: 07.10.2013
Сообщений: 1
По умолчанию подправить прогу

исправить код, чтобы искаженный разряд менялся не с лева на права, а наоборот

Код:
{$R *.dfm}
function COD(s:string):string; 
var i:Integer; 
    m:string;  
begin
 m:='11001';
 SetLength(Result,5);  // прописываем длину строки
 for i:=1 to 5 do Result[i]:=IntToStr((StrToInt(s[i])+StrToInt(m[i])) mod 2)[1];
       // шифруем полученный бит
 Result:=IntToStr(StrToInt(Result)); // получаем результат без начальных нулей
end;

function Chifr(str:string):string;
// функция кодирует исходный  код
// возвращает закодированные данные
var i,l,all:Integer;  // itog - контролируем  количество "использованых" в кодировании символов
    s,st,s1:string;
begin
 all:=0;
 st:=str+'0000';  // приписываем нули к информационной части кода
 s1:=COD(Copy(st,1,5));  // шифровка первых 6 символов
 all:=all+5;
 while all<length(str)+4 do begin
   s:=s1+Copy(st,all+1,5-length(s1)); // добавляем к обработанному фрагменту символы,  чтобы дина составляла 5
   all:=all+5-length(s1); // считаем количество "использованых" символов
   if length(s) = 5 then s1:=COD(s) else s1:=s; // проверка условия завершения шифрования, по длине оставшейся части
 end;
 l:=length(s1);  // длина полученной комбинации
 for i:=1 to 4-l do s1:='0'+s1; // добавление к получившемуся коду нулей до достижения длины в 5 символов
 Result:=str+s1;  // получение итоговой избыточной комбинации
end;

function Raschifr(str:string):string;
// функция выполняет дешифрование кода, возвращает остаток от деления
var all,i,l:Integer;  // itog - для контроля за номером текущего символа
    s,st,s1:string;
begin
 all:=0;
 st:=str;
 s1:=COD(Copy(st,1,5));  // дешифровка первых 5 символов
 all:=all+5;
 while all<length(str) do begin
   s:=s1+Copy(st,all+1,5-length(s1));  // добавление к обработанному фрагменту символы, чтобы длина составляла 5
   all:=all+5-length(s1); // фиксация номера последнего использованного символа
   if length(s)=5 then s1:=COD(s) else s1:=s; // проверка условия завершения дешифрования
 end;
 l:=length(s1);  // длина полученной комбинации
 for i:=1 to 4-l do s1:='0'+s1;  // добавление к остатку нулей для достижения длины равной5
 Result:=s1;  // получаем результат
end;


procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin  // распознание на ввод "0" и "1"
 if Key in ['0','1'] then
    if length(Edit1.Text)=11 then Key:=Chr(0) else Key:=Key
 else Key:=Chr(0);
    
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 iter:=0; // обнуление счётчика сдвига влево
 Edit2.Text:=Chifr(Edit1.Text);  // запускаем функцию кодирования
end;
function MakeError(str:string; n,len:Byte) : string;// функция искажения заданных битов
begin
 if str[n]='1' then str[n]:='0' else str[n]:='1'; // меняем бит на противоположный
 Result:=str;
end;

procedure TForm1.Button2Click(Sender: TObject);
var n:Integer;
begin
 if Edit3.Text='' then n:=0 else n:=StrToInt(Edit3.Text); // исправление некорректно введенных данных
 Edit4.Text:=MakeError(Edit2.Text,n,length(Edit2.Text)); // запуск функции искажения разряда

end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin  // обеспечение корректного ввода данных
 if not (Key in ['0','1','2','3','4','5','6','7','8','9']) then Key:=Chr(0);
end;
function vlevo(str:string):string;// вводим функция для осуществления сдвига влево
var s:string; i,len:Integer;
begin
 len:=length(str);
 SetLength(s,len);
 for i:=1 to len-1 do s[i]:=str[i+1];
 s[len]:=str[1];
 Result:=s;
end;

function vpravo(str:string):string;// вводим функцию для осуществления сдвига вправо
var s:string; i,len:Integer;
begin
 len:=length(str);
 SetLength(s,len);
 for i:=1 to len-1 do s[i+1]:=str[i];
 s[1]:=str[len];
 Result:=s;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form1.close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 Edit4.Text:=vlevo(Edit4.Text); // запускаем функцию сдвига влево
 iter:=iter+1;  // считаем количество сдвигов влево
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Edit5.Text:=Raschifr(Edit4.Text); // запускаем функцию декодирования
end;

procedure TForm1.Button5Click(Sender: TObject);
var i,len,l:Integer; s,kor,err:string;
begin
 kor:=Edit5.Text;
 err:=Edit4.Text;
 len:=length(err);  // длина искаженной комбинации
 l:=length(kor); // длина остатка
 s:=err;
 for i:=0 to l-1 do s[len-i]:=IntToStr((StrToInt(err[len-i])+StrToInt(kor[l-i])) mod 2)[1];
 for i:=1 to Tag do s:=vpravo(s); // сдвигаем полученную комбинацию вправо
 Edit6.Text:=s;   // выводим полученный результат
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
edit4.Text:='';
edit5.Text:='';
edit6.Text:='';
end;

procedure TForm1.Label7Click(Sender: TObject);
begin
panel1.visible:=false;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
panel1.Visible:=true;
end;
Вложения
Тип файла: rar Циклический код.rar (194.0 Кб, 9 просмотров)

Последний раз редактировалось Stilet; 07.10.2013 в 22:56.
nata34 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Подправить макрос. ТРИУМФ Microsoft Office Excel 10 07.08.2013 10:55
c++ подправить grom333 Помощь студентам 4 27.05.2011 21:02
Подправить код werser Помощь студентам 4 14.03.2010 23:26
как ппеределать обычную прогу в прогу из функциональных блоков серг Помощь студентам 0 07.12.2009 22:08