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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.10.2011, 15:50   #1
ALUKARD2011
Пользователь
 
Регистрация: 17.05.2011
Сообщений: 10
По умолчанию Реализация шифра Плейфера в Delphi

Есть исходник программы. Прога работает но шифрует только отдельные слова. Фразы шифрует и расшифровывает неправильно. Объясните в чем ошибка?
ALUKARD2011 вне форума Ответить с цитированием
Старый 14.10.2011, 15:54   #2
ALUKARD2011
Пользователь
 
Регистрация: 17.05.2011
Сообщений: 10
По умолчанию

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, XPMan;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
XPManifest1: TXPManifest;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Memo: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
rot:string ;
implementation

{$R *.dfm}


//-------------------------Шифрование Плэйфера----------------------------------
function Playfair_Crypt(s,key:string):string ;
const
//-----------------Размер ключевой матрицы:-------------------------------------
MaxX = 8;//строки
MaxY = 4;//столбцы
//Наш алфавит. Размер должен быть MaxY*MaxX.
//Поэтому в нашем случае убраны буква "ё"
URusA = 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';

var i,j,t,x1,x2,y1,y2 :integer;
M : array[1..MaxY,1..MaxX]of Char; //ключевая матрица
temp :string;

//---Функция поиска символа "с" в ключевой матрице.-----------------------------
//Возвращает строку "y" и столбец "x".
Procedure SimbolPos(c:char;var x,y:integer);
var i,j:integer;
begin
x:=0;
y:=0;
for i := 1 to MaxY do
for j := 1 to MaxX do
if c=M[i,j] then
begin
x:=j;
y:=i;
exit;
end;
end;

label M1;
begin
//---------переводим ключ и исходный текст в нижний регистр.--------------------
key:=AnsiUpperCase(key);
s:=AnsiUpperCase(s);
//----удаляем из строки все символы, не входящие в наш алфавит.-----------------
temp:='';
for i := 1 to length(s) do if pos(s[i],URusA)<>0 then temp:=temp+s[i];
s:=temp;
//----Создание ключевой матрицы, с использованием ключевого слова "key".--------
temp:='';
for i:=1 to length(key) do
if pos(key[i],temp)=0 then temp:=temp+key[i];
for i:=1 to length(URusA) do
if pos(URusA[i],temp)=0 then temp:=temp+URusA[i];
t:=0;
for i:=1 to 4 do
for j:=1 to 8 do
begin
inc(t);
M[i,j]:=temp[t];
form1.StringGrid1.Cells[j,i]:=temp[t];
end;
ALUKARD2011 вне форума Ответить с цитированием
Старый 14.10.2011, 15:56   #3
ALUKARD2011
Пользователь
 
Регистрация: 17.05.2011
Сообщений: 10
По умолчанию

//----просмотр строки по парам символов и вставка разделяющего символа----------
//"Ь" в случае когда в паре попались одинаковые символы.
M1:
for i:=1 to length(s)div 2 do
begin
if s[2*i-1]=s[2*i] then
begin
insert('Ф',s,2*i);
goto M1;
end;
end;
//-------Добавляем символ в конец строки, если её длина нечётная.---------------
if length(s) MOD 2 = 1 then if s[length(s)]<>'Ф' then s:=s+'Ф'
else s:=s+'Я';
temp:='';
for i:=1 to length(s)div 2 do
begin
SimbolPos(s[2*i-1],x1,y1);
SimbolPos(s[2*i],x2,y2);
//-------------------------------Правило 1--------------------------------------
if y1 = y2 then
begin
inc(x1); inc(x2);
if x1 > MaxX then x1:=x1-MaxX;
if x2 > MaxX then x2:=x2-MaxX;
temp:=temp+M[y1,x1]+M[y2,x2];
end;
//-------------------------------Правило 2--------------------------------------
if x1 = x2 then
begin
inc(y1); inc(y2);
if y1 > MaxY then y1:=y1-MaxY;
if y2 > MaxY then y2:=y2-MaxY;
temp:=temp+M[y1,x1]+M[y2,x2];
end;
//-------------------------------Правило 3--------------------------------------
if (x1<>x2) and (y1<>y2) then temp:=temp+M[y1,x2]+M[y2,x1];
end;
Playfair_Crypt:=temp;
rot:=temp;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Memo.Text := Playfair_Crypt(Edit1.Text,Edit2.Tex t);

end;

//---------------------Дешифрование Плэйфера------------------------------------
function Playfair_DeCrypt(s,key:string):stri ng;
const
//Размер ключевой матрицы:
MaxX = 8;//строки
MaxY = 4;//столбцы
//Наш алфавит. Размер должен быть MaxY*MaxX.
//Поэтому в нашем случае убраны букву "ё".
URusA = 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';

var i,j,t,x1,x2,y1,y2 :integer;
M : array[1..MaxY,1..MaxX]of char; //ключевая матрица
temp :string;

//---------Функция поиска символа "с" в ключевой матрице.-----------------------
//Возвращает строку "y" и столбец "x".
Procedure SimbolPos(c:char;var x,y:integer);
var i,j:integer;
begin
x:=0;
y:=0;
for i := 1 to MaxY do
for j := 1 to MaxX do
if c=M[i,j] then
begin
x:=j;
y:=i;
exit;
end;
end;
label M1;
begin
//---------переводим ключ и исходный текст в нижний регистр.--------------------
key:=AnsiUpperCase(key);
s:=AnsiUpperCase(s);
//-------удаляем из строки все символы, не входящие в наш алфавит.--------------
temp:='';
for i := 1 to length(s) do
begin
if pos(s[i],URusA)<>0 then temp:=temp+s[i];
end;
s:=temp;
//---Создание ключевой матрицы, с использованием ключевого слова "key".---------
temp:='';
for i:=1 to length(key) do
if pos(key[i],temp)=0 then temp:=temp+key[i];
for i:=1 to length(URusA) do
if pos(URusA[i],temp)=0 then temp:=temp+URusA[i];
t:=0;
for i:=1 to 4 do
for j:=1 to 8 do
begin
inc(t);
M[i,j]:=temp[t];
end;

temp:='';
for i:=1 to length(s)div 2 do
begin
SimbolPos(s[2*i-1],x1,y1);
SimbolPos(s[2*i],x2,y2);
//--------------Правило 1-------------------------------------------------------
if y1 = y2 then
begin
dec(x1); dec(x2);
if x1 <= 0 then x1:=x1+MaxX;
if x2 <= 0 then x2:=x2+MaxX;
temp:=temp+M[y1,x1]+M[y2,x2];
end;
//-------------Правило 2--------------------------------------------------------
if x1 = x2 then
begin
dec(y1); dec(y2);
if y1 <= 0 then y1:=y1+MaxY;
if y2 <= 0 then y2:=y2+MaxY;
temp:=temp+M[y1,x1]+M[y2,x2];
end;
//-------------Правило 3--------------------------------------------------------
if (x1<>x2) and (y1<>y2) then temp:=temp+M[y1,x2]+M[y2,x1];
end;
Playfair_DeCrypt:=temp;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
z:string;
begin
z:=Playfair_DeCrypt(Edit1.Text,Edit 2.Text);
Memo.Text := z;
end;
end.
ALUKARD2011 вне форума Ответить с цитированием
Старый 14.10.2011, 15:56   #4
ALUKARD2011
Пользователь
 
Регистрация: 17.05.2011
Сообщений: 10
По умолчанию

Вот такой исходник

Последний раз редактировалось ALUKARD2011; 14.10.2011 в 15:59.
ALUKARD2011 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Расшифровка "Шифра цезаря" anthophyta Помощь студентам 2 14.10.2011 11:19
Криптоанализ шифра Виженера kalbim Помощь студентам 3 17.05.2011 22:27
Шифр Плейфера Kadett Свободное общение 5 11.08.2010 14:22
Реализация многопоточностив Delphi BloodMaX Помощь студентам 3 20.03.2010 19:21
Реализация BlowFish на Delphi Unconnected Общие вопросы Delphi 2 19.02.2009 12:52