Программа шифрования и дешифрования по Виженеро

uekmyfp · #1 13.11.2007, 12:56

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

~ SaM ~ · #2 13.11.2007, 23:17

Код:

var
  Form1: TForm1;
 
const alphabet = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя1234567890АБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ ,.;:-+_()!?"№%*/=\|@#$^~`''&abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
 
implementation
 
uses About;
 
{$R *.dfm}
 
//шифрование Вижинера
for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; 
 
 
   dlina_text := length(Memo1.Lines[i]);     
 
    kkk := dlina_text div dlina_klu4a + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;
 
     for j:=1 to length(wifr) do
  begin
      t:=0;  k:=0;
          for p :=1 to dlina_alphabet do
            begin
              if wifr[j] = alphabet[p] then    t := p; 
                  if klu4[j] = alphabet[p] then   k := p;    
            end;
 
         w := (t + k) mod dlina_alphabet; 
 
     if w = 0 then w := dlina_alphabet;
 
           jj:=1;
 
h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
  Memo1.Lines[i] := wifr2; 
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;

//расшифрование текста

Код:

procedure TForm1.Button4Click(Sender: TObject);
      label h, h1;
  Var
                    key, wifr,wifr2, klu4 : String;
                  kkk, w, t, k, jj, i, j,p : integer;
 dlina_klu4a, dlina_text, dlina_alphabet : integer;
 
begin
 
for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; 
     dlina_text := length(wifr);
    kkk := (dlina_text div dlina_klu4a) + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;
    for j:=1 to length(wifr) do
  begin
      t:=0; k:=0;
          for p :=1 to dlina_alphabet do
            begin
              if wifr[j] = alphabet[p] then    t := p;
                  if klu4[j] = alphabet[p] then   k := p;
            end;
    if (t-k) > 0 then
            w := t-k   else  w := (t+dlina_alphabet) - k; 
           jj:=1;
h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
      Memo1.Lines[i] := wifr2;
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;

Winny · #3 14.11.2007, 00:11

Твой код у мя не работает. Выдает Devision By Zero. Выложи весь исходник. Чисто интересно.

~ SaM ~ · #4 14.11.2007, 12:53

Код:

var
  Form1: TForm1;
 
const alphabet = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя1234567890АБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ ,.;:-+_()!?"№%*/=\|@#$^~`''&abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
 
implementation
 
uses About;
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
  begin
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
    Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
end;
 
//процедура шифрования текста
procedure TForm1.Button2Click(Sender: TObject);
      label h, h1;
  Var
                    key, wifr, wifr2, klu4 : String;
           kkk, w, p,t, k, jj, i, j : integer;
 dlina_klu4a, dlina_text, dlina_alphabet : integer;
 
 
begin
 
  key := (edit1.Text) ;             // ключ (строка)
  dlina_text := 0;
 
 
  dlina_klu4a := length(key);     // длина ключа (строки)
  dlina_alphabet := length(alphabet);  //длина алфавита
 
 
// проверка на наличие текста и ключа
if (memo1.Lines[0] = '') or (key = '') then    // если нет текста или ключа
  begin
    Application.MessageBox('Введите текст и ключ!','Error');
    exit;
  end;
 
 
 
 
//шифрование Вижинера
for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; //i-я строка Memo1 в wifr для преобразований
 
 
   dlina_text := length(Memo1.Lines[i]);      // длина текста
 
  //чтобы длина ключа соответствовала длине текста
    kkk := dlina_text div dlina_klu4a + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;
 
     for j:=1 to length(wifr) do
  begin
      t:=0;  k:=0;
          for p :=1 to dlina_alphabet do
            begin
              if wifr[j] = alphabet[p] then    t := p; //t-номер символа открытого текста
                  if klu4[j] = alphabet[p] then   k := p;   //k-номер символа ключа
            end;
 
         w := (t + k) mod dlina_alphabet; //w - номер символа зашифрованного символа
 
     if w = 0 then w := dlina_alphabet;
 
           jj:=1;
 
h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
  Memo1.Lines[i] := wifr2; //в i-ю строку Memo2 помещаем защифрованную i-ю строку Memo1
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;
 
 
 
//процедура расшифрования текста
procedure TForm1.Button4Click(Sender: TObject);
      label h, h1;
  Var
                    key, wifr,wifr2, klu4 : String;
                  kkk, w, t, k, jj, i, j,p : integer;
 dlina_klu4a, dlina_text, dlina_alphabet : integer;
 
begin
 
  key := (edit1.Text) ;             // ключ (строка)
  dlina_text := 0;
 
 
  dlina_klu4a := length(key);     // длина ключа (строки)
  dlina_alphabet := length(alphabet);  //длина алфавита
 
 
// проверка на наличие текста и ключа
if (memo1.lines[0] = '') or (key = '') then    // если нет текста или ключа
  begin
    Application.MessageBox('Введите текст и ключ!','Error');
  end;
 
 
//расшифрование Вижинера
for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; //i-я строка Memo1 в wifr для преобразований
 
 
     dlina_text := length(wifr);      // длина текста
 
  //чтобы длина ключа соответствовала длине текста
    kkk := (dlina_text div dlina_klu4a) + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;
 
 
    for j:=1 to length(wifr) do
  begin
      t:=0; k:=0;
          for p :=1 to dlina_alphabet do
            begin
              if wifr[j] = alphabet[p] then    t := p; //t-номер символа открытого текста
                  if klu4[j] = alphabet[p] then   k := p;   //k-номер символа ключа
            end;
 
 
    if (t-k) > 0 then
            w := t-k   else  w := (t+dlina_alphabet) - k; //w-номер символа расшифр.текста
 
           jj:=1;
 
h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
      Memo1.Lines[i] := wifr2;
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;

~ SaM ~ · #5 14.11.2007, 12:58

to Winni

Не знаю почему у тебя ошибка деления на 0, но я пару недель назад сдавал в универе эту лабу и никаких проблем не было, НО единственный минус в том, что я не смог додуматься как при шифровании/дешифровании сохранять абзацы в тексте!

Может кто поможет?
А вобще сейчас делаю следующую лабу (тоже по Вижинеру) с автоключом, который в реестр пишется! Когда доделаю - выложу!

P.S. Хотел выложить всю прогу, но че-т не получается приаттачить файл, хотя и размер 18 кб. Могу на мыло кинуть, если надо!

Aristarh Dark · #6 14.11.2007, 13:18

Цитата:

P.S. Хотел выложить всю прогу, но че-т не получается приаттачить файл, хотя и размер 18 кб. Могу на мыло кинуть, если надо!

Скорее всего это у тебя rar архив, а их аттачить запрещено. Сделай zip

~ SaM ~ · #7 14.11.2007, 19:24

Aristarh Dark! Ты прав!У меня именно rar! Я почему-то считал, что если в списке есть zip, то и рар тоже можно кидать! НО, я ошибся!

А почему рары нельззя заливать?

Admin · #8 14.11.2007, 21:39

Цитата:

Сообщение от ~ SaM ~

Aristarh Dark! Ты прав!У меня именно rar! Я почему-то считал, что если в списке есть zip, то и рар тоже можно кидать! НО, я ошибся!

А почему рары нельззя заливать?

Не то что нельзя, просто по некоторым причинам загрузка RAR архивов недоступна.

uekmyfp · #9 15.11.2007, 11:02

Спасибо Sam, все отлично! Но прога не работает у меня. Отправь мне по мылу, пли-и-из!

Gulnaz312@mail.ru Надеюсь, что разберусь в коде, а если нет то снова придеться обратиться к тебе!!

Yurk@ · #10 15.11.2007, 12:39

У меня всё работает.
Только у тебя в архиве нет второй формы About. Вот на неё он и ругается!
Я убрал всё ссылки на эту форму.
Вот исправленный архив:

~ SaM ~ · #11 15.11.2007, 19:29

to Yurk@
А смысл заливатьформу about???Там все равно написано: Лабара №6, выполнил студент .... и т.д. т.п.

uekmyfp · #12 19.11.2007, 12:46

Прога не работает! Я не могу ввести текст с клавы, почему? Поудаляла все ненужные кнопки, типа - Открыть, Сохранить! Вроде шифрует, но опять не правильно! Сдвиг на 1 букву не правильно! например если буква О с ключом П должна шифроваться как Э,а шиф-ся как Ю!

Winny · #13 19.11.2007, 14:09

To uekmyfp
Странно.... У меня всё работает. Посмотри, может у тебя у Memo значение ReadOnly в положении True, если да, то измени на False.

Yurk@ · #14 19.11.2007, 14:56

У меня тоже всё работает!

~ SaM ~ · #15 19.11.2007, 18:16

to uekmyfp.

Проверяй почту!Я тебе отправил на почту весь исходник + exe со всеми комментариями.

P.S. На форум не выложил, т.к. 300 кб занимает. Кому надо - пишите!

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты