Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Кодирование и декодлирование текстовой информации методом Гронсфельда

Автор: MultiBlock 4.10.2006 20:12

Народ, помогите, пожалуйста, с программой! Нужно соединить 2 части (шифратор и дешифратор) + нужно чтобы текст забивался через программу, либо читался из файла, а результат записывался тоже в файл, но в другой. И цифровой ключ должен вводиться тоже через программу! Помогите!
P.S. Спасибо всем кто откликнется!

Код

{
Шифровальщик
Программа читает файл s и записывает результат в s1
}

function getnum(c: char): integer;
var
  n: integer;
begin
  case c of
    '0': n := 0;
    '1': n := 1;
    '2': n := 2;
    '3': n := 3;
    '4': n := 4;
    '5': n := 5;
    '6': n := 6;
    '7': n := 7;
    '8': n := 8;
    '9': n := 9;
  else
    n := -1;
  end;
  getnum := n;
end;

const
  N1 = 10; { максимальное количество строк в файле }
  N2 = 2; { количество алфавитов }
var
  f,f1: text;
  s,n,s1: string;
  i,j,k,l,m: integer;
  c: integer; { счётчик пизиции в строке кода }
  w : array [1..N1] of string; { строки }
  w1 : array [1..N1] of string; { строки }
  abc : array [1..N2] of string; { алфавиты }
begin
  abc[1] := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  abc[2] := 'abcdefghijklmnopqrstuvwxyz';
  writeln(''); writeln(' *** Шифровка методом Гронсфельда ***');
{
  write('Имя файла: '); readln(s); write('Цифровой ключ (4 или меньше цифры ): '); readln(n);
}
  s := 'C:\Work4\1.dat';
  s1 := 'C:\Work4\2.dat';
  n := '2718';
  assign(f,s); assign(f1,s1);
  reset(f); rewrite(f1);
  i := 1;
  { читаем файл }
  while not EOF(f) and (i<=N1) do begin
    readln(f,w[i]); w1[i]:=w[i];
    inc(i);
  end;
  { кодируем }
    { 1-й цикл - по строкам из файла }
    { 2-й цикл - по элементам в строке из файла }
    { 3-й цикл - по алфавитам }
    { 4-й цикл - по элементам алфавита }
  c := 1;
  for i := 1 to N1 do if ord(w[i][0])<>0 then
  for j := 1 to (ord(w[i][0])+1) do
  for k := 1 to N2 do
  for l := 1 to (ord(abc[k][0])+1) do begin
    if abc[k][l]=w[i][j] then begin
      m := l+getnum(n[c]); inc(c); if c>ord(n[0]) then c := 1;
      if m>ord(abc[k][0]) then m := m-ord(abc[k][0]);
      w1[i][j] := abc[k][m];
    end;
  end;
  writeln('');
  for i:=1 to N1 do begin
    writeln(w[i]);
    writeln(w1[i]);
  end;
  for i := 1 to N1 do begin
    for j := 1 to ord(w1[i][0]) do write(f1,w1[i][j]);
    writeln(f1,'');
  end;
  writeln('Нажмите Enter');
  read(s);
end.


Код

{
Дешифратор
Программа читает файл s и записывает результат в s1
}

function getnum(c: char): integer;
var
  n: integer;
begin
  case c of
    '0': n := 0;
    '1': n := 1;
    '2': n := 2;
    '3': n := 3;
    '4': n := 4;
    '5': n := 5;
    '6': n := 6;
    '7': n := 7;
    '8': n := 8;
    '9': n := 9;
  else
    n := -1;
  end;
  getnum := n;
end;

const
  N1 = 10; { максимальное количество строк в файле }
  N2 = 2; { количество алфавитов }
var
  f,f1: text;
  s,n,s1: string;
  i,j,k,l,m: integer;
  c: integer; { счётчик пизиции в строке кода }
  w : array [1..N1] of string; { строки }
  w1 : array [1..N1] of string; { строки }
  abc : array [1..N2] of string; { алфавиты }
begin
  abc[1] := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  abc[2] := 'abcdefghijklmnopqrstuvwxyz';
  writeln(''); writeln(' *** Шифровка методом Гронсфельда ***');
{
  write('Имя файла: '); readln(s); write('Цифровой ключ (4 или меньше цифры ): '); readln(n);
}
  s := 'C:\Work4\2.dat';
  s1 := 'C:\Work4\3.dat';
  n := '2718';
  assign(f,s); assign(f1,s1);
  reset(f); rewrite(f1);
  i := 1;
  { читаем файл }
  while not EOF(f) and (i<=N1) do begin
    readln(f,w[i]); w1[i]:=w[i];
    inc(i);
  end;
  { кодируем }
    { 1-й цикл - по строкам из файла }
    { 2-й цикл - по элементам в строке из файла }
    { 3-й цикл - по алфавитам }
    { 4-й цикл - по элементам алфавита }
  c := 1;
  for i := 1 to N1 do if ord(w[i][0])<>0 then
  for j := 1 to (ord(w[i][0])+1) do
  for k := 1 to N2 do
  for l := 1 to (ord(abc[k][0])+1) do begin
    if abc[k][l]=w[i][j] then begin
      m := l-getnum(n[c]); inc(c);
if c>ord(n[0]) then c := 1;
      if m<1 then m := m+ord(abc[k][0]);
      w1[i][j] := abc[k][m];
    end;
  end;
  writeln('');
  for i:=1 to N1 do begin
    writeln(w[i]);
    writeln(w1[i]);
  end;
  for i := 1 to N1 do begin
    for j := 1 to ord(w[i][0]) do write(f1,w1[i][j]);
    writeln(f1,'');
  end;
  writeln('Нажмите Enter');
  read(s);
end.

Автор: volvo 4.10.2006 20:26

Здесь есть реализация процедур шифровки/дешифровки методом Гронсфельда

http://volvo71.narod.ru/faq_folder/code_text.htm#code_gronsfeld


Добавь только чтение из файла/запись в файл, и все...

Автор: MultiBlock 4.10.2006 20:39

Я видел... дело в том что я только начал осваивать паскаль... до этого год учил Си... нужна так сказать поддержка и помощь... конечно это будет нагло с моей стороны, но хочется попросить нельзяли добавить это самое чтение и запись из/в файл. Буду очень признателен...

Автор: volvo 4.10.2006 21:00

Файл GRONSFLD.PAS

function GronsfeldEncipher(toCode, K: string): string;
var i, T, _T: integer;
begin
  for i := 1 to length(toCode) do begin
    _T := ord(toCode[ i ]);

    T := (Ord(toCode[ i ])

      +
      (Ord(K[(pred(i) mod length(K)) + 1]) - Ord('0'))

         );

    if T >= 256 then dec(T, 256);
    toCode[ i ] := Chr(T);
  end;
  GronsfeldEncipher := toCode;
end;

function GronsfeldDecipher(toDecode, K: string): string;
var i, T: integer;
begin
  for i := 1 to length(toDecode) do begin
    T := (Ord(toDecode[i])

      -
      (Ord(K[(pred(i) mod length(K)) + 1]) - Ord('0'))

         );
    if T < 0 then Inc(T, 256);
    toDecode[ i ] := Chr(T);
  end;
  GronsfeldDecipher := toDecode;
end;

var
  s: string;

  f_in, f_out: text;


begin
  if (paramcount < 3) or (

    (paramstr(1) <> '/e') and (paramstr(1) <> '/d')

  ) then exit;

  assign(f_in, paramstr(2));
  reset(f_in);
  assign(f_out, paramstr(3));
  rewrite(f_out);

  while not eof(f_in) do begin

    readln(f_in, s);
    if paramstr(1) = '/e' then
      s := GronsfeldEncipher(s, '2178')
    else
      s := GronsfeldDecipher(s, '2178');

    writeln(f_out, s);
  end;

  close(f_out);
  close(f_in);
end.


Запускать с 3-мя параметрами.
Первый:
/e или /d (соответственно для кодирования и ДЕкодирования)
Второй:
имя входного файла (ИЗ которого будет читаться информация для операции, заданной первым ключом)
Третий:
имя выходного файла (в него запишется информация, за- или рас-кодированная, в зависимости от первого ключа)...

Пример использования:
Цитата(console)
...>GRONSFLD /e 700.txt 700.out

шифрует текст, содержащийся в файле 700.txt, и записывает результат в файл 700.out (Внимание!! Если файл 700.out уже существует - он будет перезаписан!!!)

Цитата(console)
...>GRONSFLD /d 700.out 700.txt

дешифрует текст, содержащийся в файле 700.out, и записывает результат в файл 700.txt (аналогично, если файл 700.txt уже существует - он тоже будет перезаписан!!!)

Пример файла, на котором тестировалась программа:
Прикрепленный файл  700.txt ( 664 байт ) Кол-во скачиваний: 577

Автор: MultiBlock 6.10.2006 18:46

Не работает код blink.gif просто вылетает сразу после запуска и все. Обидно блин...

Автор: volvo 6.10.2006 18:49

MultiBlock, я бы попросил добавлять в следующий раз "У МЕНЯ не работает", договорились? Если я его выложил, значит все сработало. Могу прикрепить EXE, если нужно. Версия компилятора какая? (ЭТО, кстати, нужно указывать СРАЗУ!)

Также ЖЕЛАТЕЛЬНО привести командную строку, которой запускалась программа, иначе рассматриваться всерьез такие заявления не могут...

Автор: MultiBlock 6.10.2006 19:15

Может я что-то не правильно делаю, поэтому и не работает, но если можно, то от EXE я не откажусь.

Автор: MultiBlock 17.10.2006 1:57

Опять обращаюсь к Вам за помощью. Вот объединил две программы, но теперь ругается на конец программы
(...end;
read(s);
end. ): error 85 ";" expected. Понятно что пропустил знак точка с запятой, но вопрос: какая в конце программы точка с запятой??? Там должен быть and. а он говорит надо ; Ни чего не могу понять... blink.gif Вот код программы:

Код

program Coding_and_decoding_of_the_text_information_by_method_Gronsfelds;
uses crt,dos;

{Procedures and function}

function getnum(c: char): integer;

var
  n: integer;

{Show title}

procedure title;
begin
window(1,1,1,80);
textbackground(2);
clrscr;
gotoxy(27,1);
textbackground(5);
textcolor(133); write('CODETIMEG');
end;

{Main change}

const
  N1 = 5; { The maximum quantity of lines in a file }
  N2 = 3; { Quantity of alphabets }
var
  f,f1: text;
  s,ne,s1: string;
  i,j,k,l,m: integer;
  ce: integer; { The counter of a position in a line of a code }
  w : array [1..N1] of string; { Lines }
  w1 : array [1..N1] of string; { Lines }
  abc : array [1..N2] of string; { Alphabets }
  sign : string;

label menugame,coding,decoding,help;

{Main part}

begin
clrscr;

{Menu programm}

menugame:
while 1>0 do
begin
  title;
  gotoxy(30,18);
  textcolor(1);
  write('Press C for coding');
  gotoxy(30,20);
  textcolor(1);
  write('Press D for decoding');
  gotoxy(30,22);
  textcolor(1);
  write('Press H for help');
  gotoxy(30,24);
  textcolor(1);
  write('Press E for exit');
  case readkey of
   #99 : goto coding;
   #100 : goto decoding;
   #104 : goto help;
   #101 : exit;
  end;
end;

{Coding}

coding:
begin
  case c of
    '0': n := 0;
    '1': n := 1;
    '2': n := 2;
    '3': n := 3;
    '4': n := 4;
    '5': n := 5;
    '6': n := 6;
    '7': n := 7;
    '8': n := 8;
    '9': n := 9;
  else
    n := -1;
  end;
  getnum := n;
end;

begin
  abc[1] := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  abc[2] := 'abcdefghijklmnopqrstuvwxyz';
  abc[3] := '0123456789';
  writeln(' *** An encryption method Gronsfeld ***');
  write('Enter a full way to a file from which it is readable: '); readln(s);
  write('Enter a full way to a file in which we write: '); readln(s1);
  write('Enter a digital key (4 figures or less): '); readln(n);
  assign(f,s); assign(f1,s1);
  reset(f); rewrite(f1);
  i := 1;

  { Reads a file }

  while not EOF(f) and (i<=N1) do begin
    readln(f,w[i]); w1[i]:=w[i];
    inc(i);
  end;

  { We code }
    { 1-st cycle - in the lines from a file }
    { 2-nd cycle - on elements in line from a file }
    { 3-rd cycle - under alphabets }
    { 4-th cycle - on elements of the alphabet }

  ce := 1;
  for i := 1 to N1 do if ord(w[i][0])<>0 then
  for j := 1 to (ord(w[i][0])+1) do
  for k := 1 to N2 do
  for l := 1 to (ord(abc[k][0])+1) do begin
    if abc[k][l]=w[i][j] then begin
      m := l+getnum(ne[ce]); inc(ce); if ce>ord(ne[0]) then ce := 1;
      if m>ord(abc[k][0]) then m := m-ord(abc[k][0]);
      w1[i][j] := abc[k][m];
    end;
  end;
  for i:=1 to N1 do begin
    writeln(w[i]);
    writeln(w1[i]);
  end;
  for i := 1 to N1 do begin
    for j := 1 to ord(w1[i][0]) do write(f1,w1[i][j]);
   writeln(f1,s1,'');
end;
begin
  title;
  gotoxy(30,18);
  textcolor(1);
  write('Press C for coding');
  gotoxy(30,20);
  textcolor(1);
  write('Press D for decoding');
  gotoxy(30,22);
  textcolor(1);
  write('Press H for help');
  gotoxy(30,24);
  textcolor(1);
  write('Press E for exit');
  case readkey of
   #99 : goto coding;
   #100 : goto decoding;
   #104 : goto help;
   #101 : exit;
  end;
end;
read(s);
end;

{Decoding}

decoding:
begin
  case c of
    '0': n := 0;
    '1': n := 1;
    '2': n := 2;
    '3': n := 3;
    '4': n := 4;
    '5': n := 5;
    '6': n := 6;
    '7': n := 7;
    '8': n := 8;
    '9': n := 9;
  else
    n := -1;
  end;
  getnum := n;
end;

begin
  abc[1] := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  abc[2] := 'abcdefghijklmnopqrstuvwxyz';
  abc[3] := '0123456789';
  writeln(' *** An encryption method Gronsfeld ***');
  write('Enter a full way to a file from which it is readable: '); readln(s);
  write('Enter a full way to a file in which we write: '); readln(s1);
  write('Enter a digital key (4 figures or less): '); readln(n);
  assign(f,s); assign(f1,s1);
  reset(f); rewrite(f1);
  i := 1;

  { Reads a file }

  while not EOF(f) and (i<=N1) do begin
    readln(f,w[i]); w1[i]:=w[i];
    inc(i);
  end;

  { We code }
    { 1-st cycle - in the lines from a file }
    { 2-nd cycle - on elements in line from a file }
    { 3-rd cycle - under alphabets }
    { 4-th cycle - on elements of the alphabet }

  ce := 1;
  for i := 1 to N1 do if ord(w[i][0])<>0 then
  for j := 1 to (ord(w[i][0])+1) do
  for k := 1 to N2 do
  for l := 1 to (ord(abc[k][0])+1) do begin
    if abc[k][l]=w[i][j] then begin
      m := l-getnum(ne[ce]); inc(ce); if ce>ord(ne[0]) then ce := 1;
      if m<1 then m := m+ord(abc[k][0]);
      w1[i][j] := abc[k][m];
    end;
  end;
  for i:=1 to N1 do begin
    writeln(w[i]);
    writeln(w1[i]);
  end;
  for i := 1 to N1 do begin
    for j := 1 to ord(w[i][0]) do write(f1,w1[i][j]);
    writeln(f1,s1,'');
   end;
begin
  gotoxy(30,18);
  textcolor(1);
  write('Press C for coding');
  gotoxy(30,20);
  textcolor(1);
  write('Press D for decoding');
  gotoxy(30,22);
  textcolor(1);
  write('Press H for help');
  gotoxy(30,24);
  textcolor(1);
  write('Press E for exit');
  case readkey of
   #99 : goto coding;
   #100 : goto decoding;
   #104 : goto help;
   #101 : exit;
  end;
end;
read(s);
end;

{Help}

help:
begin
  write('This is help');
end;
begin
  gotoxy(30,18);
  textcolor(1);
  write('Press C for coding');
  gotoxy(30,20);
  textcolor(1);
  write('Press D for decoding');
  gotoxy(30,22);
  textcolor(1);
  write('Press H for help');
  gotoxy(30,24);
  textcolor(1);
  write('Press E for exit');
  case readkey of
   #99 : goto coding;
   #100 : goto decoding;
   #104 : goto help;
   #101 : exit;
  end;
end.

Автор: volvo 17.10.2006 5:36

У тебя скорее всего не хватает End-ов в программе, поэтому компилятор и просит добавить еще... Если было открыто 10 Begin-ов (ну, или Case-ов), то закрыть ты должен все 10, а у тебя этого не наблюдается...

А разбираться в программе, где длина идентификатора зашкаливает за 32, и даже за 64 символа (а больше 32 - уже потенциално опасно), в которой используются метки, и дешевые трюки (типа вычисления длины строки по Ord(s[0]) вместо Length(s)) что делает эту программу несовместимой с большинством компиляторов, и в которой НЕ заканчивая функцию автор ДУМАЕТ что он делает процедуру того же уровня, а на самом деле получает ВЛОЖЕННУЮ, которая не имеет ТЕЛА - извини, я не буду...

Автор: lygger 25.04.2007 20:11

volvo выложи пожалуйста ЕХЕ своей программы. буду очень признателен.

Автор: volvo 25.04.2007 21:39

Вот EXE:
Прикрепленный файл  gronsfld.rar ( 3.67 килобайт ) Кол-во скачиваний: 438


Как пользоваться - см. пост №4 ...

Автор: lygger 2.05.2007 21:41

спасибо огромное!

Автор: Mihanik 12.05.2007 0:25

Цитата(volvo @ 25.04.2007 18:39) *


Как пользоваться - см. пост №4 ...


ув. Volvo! мог бы ты выложить на форум (или в личку) алгоритм работы твоей программы по методу Гронсфельда. Не все ясно! =)

Автор: Mihanik 13.05.2007 18:00

Неужели так трудно нарисовать алгоритм?


Автор: volvo 13.05.2007 18:06

Под алгоритмом имеется в виду ЧТО? Блок-схема? Неужели так трудно воспользоваться специально предназначенными для этого программами? Найти ее можно в разделе "Ссылки"...

Автор: Mihanik 13.05.2007 18:35

Цитата(volvo @ 13.05.2007 15:06) *

Под алгоритмом имеется в виду ЧТО? Блок-схема? Неужели так трудно воспользоваться специально предназначенными для этого программами? Найти ее можно в разделе "Ссылки"...

ну да блок схема. Испльзовал BS первую половину программы рисует норм, потом спустя час выдает "out of memory" что странно т.к. компьютер достаточно новый, да и виртуалной памяти много!