Главная Случайная страница


Полезное:

Как сделать разговор полезным и приятным Как сделать объемную звезду своими руками Как сделать то, что делать не хочется? Как сделать погремушку Как сделать так чтобы женщины сами знакомились с вами Как сделать идею коммерческой Как сделать хорошую растяжку ног? Как сделать наш разум здоровым? Как сделать, чтобы люди обманывали меньше Вопрос 4. Как сделать так, чтобы вас уважали и ценили? Как сделать лучше себе и другим людям Как сделать свидание интересным?


Категории:

АрхитектураАстрономияБиологияГеографияГеологияИнформатикаИскусствоИсторияКулинарияКультураМаркетингМатематикаМедицинаМенеджментОхрана трудаПравоПроизводствоПсихологияРелигияСоциологияСпортТехникаФизикаФилософияХимияЭкологияЭкономикаЭлектроника






Список используемых источников





1. Bitmap – класс [Электронный ресурс]. – Режим доступа: https://msdn.microsoft.com, свободный. – Загл. с экрана. – Яз. англ.

2. Изоморфизм графов [Электронный ресурс]. – Режим доступа: http://mathcenter.spb.ru, свободный. – Загл. с экрана. – Яз. рус.

3. Высшая Школа Экономики [Электронный ресурс]. – Режим доступа: http://www.hse.ru, свободный. – Загл. с экрана. – Яз. рус.

4. Белоусов И.В. Матрицы и определители; учебное пособие по линейной алгебре [Текст]/ И.В. Белоусов. – Кишенев: 2006. – 101c.

5. Беллман Р. Введение в теорию матриц [Текст]/ Р. Беллман, пер с англ В. Я. Катковник, Р. А. Полуэктов, М. С. Эпельман. – М.: Наука 1976. – 386с.

6. Грибунин В.Г. Цифровая стеганография [Текст]/В.Г.Грибунин, И.Н. Оков, И.В.Туринцев – М.: СОЛОН-ПРЕСС, 2009 – 272с.

7. Краткий материал по алгоритмам генерации псевдослучайных последовательностей чисел [Электронный ресурс]. – Режим доступа: cmcmsu.no-ip.info/1course/random.generators.algs.html, свободный. – Загл. с экрана. – Яз. рус.


 

ПРИЛОЖЕНИЕ А

Блок-схема алгоритма работы программного приложения


ПРИЛОЖЕНИЕ Б

Листинг программы

unit matrix;

interface

uses

Math, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TBytesArr = array of array of byte;

TByteArr = array of integer;

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Image1: TImage;

Button4: TButton;

Memo1: TMemo;

StaticText1: TStaticText;

StaticText2: TStaticText;

Edit1: TEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure FormResize(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Strings:TStringlist;

OD:TOpenDialog;

SD:TSaveDialog;

MX:TBytesArr;

TBA: TByteArr;

BmpHeight, BmpWidth: integer;

Key: int64;

Form1: TForm1;

MxDim: integer;

bmp:TBitmap;

i: integer;

tryed: int64;

s: string;

codeE: string;

implementation

 

{$R *.dfm}

function IntToBin(Value: int64): string;

var {Перевод Int64 В строку бит для закодирования по методу LSB}

i: integer;

number: int64;

begin

number:= Value;

for i:=63 downto 0 do

begin

if ((number mod 2)>0)

then

result:='1'+result

else

result:='0'+result;

number:=number div 2;

end;

end;

 

function BinToInt(Value: string): int64;

var {Обратно из IntToBin}

i: integer;

binstr: string;

begin

result:=0;

binstr:= Value;

for i:=63 downto 0 do

begin

if (binstr[i+1] = '1')

then

result:=result+Round(Power(2,63-i));

end;

end;

 

function PRN(KeySec:int64; ArrDim: integer): integer;

var {Генератор псевдослучайной последовательности чисел}

a,c: integer;

begin

a:=abs(round(KeySec*sin(pi/16*(ArrDim+1)*power(-1,ArrDim))));

c:= abs(round(KeySec*cos(pi/5*(ArrDim+1)*power(-1,ArrDim))));

Result:= abs((a*KeySec + c) mod (ArrDim+1));

end;

 

function FMX(KeySec: int64; ArrDim: integer): TByteArr;

var {Создание матрицы перестановок}

K,n,cnt,i,j:integer;

Flags: array of boolean;

begin

SetLength(Flags, ArrDim);

SetLength(Result, ArrDim);

for i:=0 to ArrDim-1 do

Flags[i]:=true;

n:=ArrDim-1;

for i:=0 to ArrDim-1 do

begin

k:=PRN(KeySec,n);

n:=n-1;

cnt:=-1;

for j:=0 to ArrDim-1 do

begin

if Flags[j] then

inc(cnt);

if cnt = k then

begin

Result[i]:=j;

Break;

end;

end;

Flags[j]:= False;

end;

end;

 

 

procedure MatrixToBmp(Matrix: TBytesArr);

var {Заполнение пикселей BMP}

i,j: integer;

begin

for i:=0 to Length(Matrix)-1 do

begin

for j:=0 to Length(Matrix)-1 do

bmp.Canvas.Pixels[j,i]:=RGB(Matrix[i,j],Matrix[i,j],Matrix[i,j]);

end;

end;

 

procedure ExtractRGB(Name: TBitmap; Matrix:TBytesArr);

var {Извлечение инфо из пикселей, усреднение, занесение в массив}

i,j: integer;

R,G,B: byte;

Color: TColor;

begin

for i:=0 to Name.Height-1 do

begin

for j:=0 to Name.Width-1 do

begin

Color:=Name.Canvas.Pixels[j,i];

R:= GetRValue(Color);

G:= GetGValue(Color);

B:= GetBValue(Color);

Matrix[i,j]:=(R+G+B) div 3; //Усреднение RGB значений

end;

end;

end;

 

 

procedure BmpToSqrMX(Matrix: TBytesArr; Flag:Boolean);

var {Добивка матрицы до квадратной}

i,j: integer;

begin

if Flag = true then

begin

for i:=0 to MxDim-1 do

begin

for j:=BmpWidth to MxDim-1 do

MX[i,j]:=Random(256); //Шумы

end;

end

else

begin

for i:=BmpHeight to MxDim-1 do

begin

for j:=0 to MxDim-1 do

MX[i,j]:=Random(256); //Шумы

end;

end;

end;

 

procedure Mixing(Matrix: TBytesArr; Biject: TByteArr; Flag: boolean);

var

TempMX: TBytesArr;

i,j: integer;

begin

SetLength(TempMX, Length(Matrix), Length(Matrix));

if Flag then {Закодировать}

begin

for i:=0 to length(Matrix)-1 do

for j:=0 to length(Matrix)-1 do

TempMX[i,j]:= Matrix[Biject[i],j];

for j:=0 to length(Matrix)-1 do

for i:=0 to length(Matrix)-1 do

Matrix[i,Biject[j]]:= TempMX[i,j];

end

else {Раскодировать}

begin

for j:=0 to length(Matrix)-1 do

for i:=0 to length(Matrix)-1 do

TempMX[i,j]:= Matrix[i,Biject[j]];

for i:=0 to length(Matrix)-1 do

for j:=0 to length(Matrix)-1 do

Matrix[Biject[i],j]:= TempMX[i,j];

end;

end;

 

procedure ENC(Name: TBitmap);

var {Заполнение первых 8 пикселей инфо по методу LSB}

i: integer;

R: byte;

codeE: string;

Color: TColor;

begin

codeE:= '01000101';

for i:=0 to 7 do

begin

Color:=Name.Canvas.Pixels[i,0];

R:= GetRValue(Color);

R:= R AND BYTE(254);

if codeE[i+1] = '1' then

inc(R);

bmp.Canvas.Pixels[i,0]:=RGB(R,R,R);

end;

end;

 

function ENC_check(Name: TBitmap): boolean;

var {Извлечение инфо из первых 8 пикселей проверка на зашифрование}

i: integer;

R,G,B: byte;

codeE,str: string;

Color: TColor;

begin

codeE:= '01000101';

for i:=0 to 7 do

begin

Color:=Name.Canvas.Pixels[i,0];

R:= GetRValue(Color);

G:= GetGValue(Color);

B:= GetBValue(Color);

if (R = G) and (G = B) and (R = B) then

begin

R:= R AND BYTE(1);

if R = 1 then

str:=Str+'1'

else

str:=Str+'0';

end

else

result:=false;

end;

if str = codeE then

result:=true;

end;

 

 

procedure LSB_Ins(Name: TBytesArr; key: Int64);

var {Процедура внесения изменений в BMP для зашифрования ключа методом LSB}

i,container:integer;

count_to, count_down: integer;

R: byte;

length_dim,height_dim: integer;

key_bin: string;

begin

count_to:=1;

count_down:=64;

key_bin:= IntToBin(key);

container:=Length(Name)*Length(Name) div 63;

for i:=0 to length(key_bin)-1 do

begin

length_dim:=(8+container*i) mod Length(Name);

height_dim:=(8+container*i) div Length(Name);

R:= MX[length_dim,height_dim];

R:= R AND BYTE(254);

if (i mod 2) = 1 then

begin

if key_bin[count_to] = '1' then

begin

inc(R);

end;

MX[length_dim,height_dim]:=R;

inc(count_to);

end

else

begin

if key_bin[count_down] = '1' then

begin

inc(R);

end;

MX[length_dim,height_dim]:=R;

dec(count_down);

end;

end;

end;

 

 

function LSB_Ext (Name: TBytesArr): Int64;

var {Извлечение ключа из изображения}

i,container: integer;

count_to, count_down: integer;

R: byte;

length_dim,height_dim: integer;

key_bin: string;

begin

count_to:=1;

count_down:=64;

key_bin:='0000000000000000000000000000000000000000000000000000000000000000';

container:=Length(Name)*Length(Name) div 63;

for i:=0 to length(key_bin)-1 do

begin

length_dim:=(8+container*i) mod Length(Name);

height_dim:=(8+container*i) div Length(Name);

R:= MX[length_dim,height_dim];

R:= R AND BYTE(1);

if (i mod 2) = 1 then

begin

if R = 1 then

begin

key_bin[count_to]:='1';

end;

inc(count_to);

end

else

begin

if R = 1 then

begin

key_bin[count_down]:= '1';

end;

dec(count_down);

end;

end;

result:=BinToInt(key_bin);

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

if TryStrToInt64(Edit1.Text, tryed) then

begin

if StaticText1.Caption <> StaticText2.Caption then

begin

if fileexists(StaticText1.Caption) then

begin

Button1.Caption:= 'Encoding...';

Button1.Enabled:= False;

Try

begin

Key:= StrToInt64(Edit1.Text);

Edit1.Enabled:= False;

end;

Except

ShowMessage('Wrong Key Sequence, try another!');

end;

BmpHeight:=bmp.Height;

BmpWidth:=bmp.Width;

Setlength(MX, BmpHeight, BmpWidth);

ExtractRGB(bmp, MX); //Извлечение составляющих цветов

Memo1.Lines.Add('Picture extracted to data array '+TimetoStr(time));

bmp.destroy; //Уничтожение файла БМП

MxDim:= max(BmpHeight,BmpWidth);

Setlength(MX, MxDim, MxDim);

if BmpHeight <> BmpWidth then

begin

if BmpHeight = MxDim then

BmpToSqrMX(MX, true) //Дополнение До квадратной матрицы

else //Добавление шума

BmpToSqrMX(MX, false);

end;

Memo1.Lines.Add('Noise added '+TimetoStr(time));

bmp:=TBitmap.Create; //Сосздание БМП

bmp.LoadFromFile(StaticText1.Caption);

bmp.Height:=MxDim;

bmp.Width:= MxDim;

Memo1.Lines.Add('Creating a permutations array '+TimetoStr(time));

TBA:=FMX(Key,MxDim); //Создание кортежа перестановок

Memo1.Lines.Add('Encoding picture starts '+TimetoStr(time));

Mixing(MX,TBA,true); //Перемешивание матрицы пикселей

LSB_Ins(MX, Key); //LSB шифрование ключа в изображение в неявном виде

MatrixToBmp(MX); //Сохранение значения пикселей

Image1.Height:= Mxdim;

Image1.Width:= Mxdim;

{Наложение маски E на первые 8 бит изображения

(Для обнаружения шифрованного изображения)}

ENC(bmp);

Image1.Picture.Bitmap:=bmp;

Memo1.Lines.Add('Picture encoded '+TimetoStr(time));

Button1.Caption:='Encoded';

end

else

begin

StaticText2.Caption:='File doesn''t exists';

ShowMessage('The same files are setted');

Button1.Caption:= 'Failure';

end

end

else

begin

ShowMessage('The same files are setted');

StaticText2.Caption:='Select another file';

Button1.Caption:= 'Failure';

end;

Button3.Enabled:=True;

Button4.Enabled:=True;

Button4.Caption:='Decode';

end

else

begin

ShowMessage('Wrong key sequence try another.');

end;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin

OD:=TOpenDialog.Create(nil);

OD.Execute;

StaticText1.Caption:=OD.FileName;

if OD.FileName <> '' then

begin

StaticText1.Visible:=true;

Image1.Picture.LoadFromFile(StaticText1.Caption);

bmp:=TBitmap.Create;

bmp.LoadFromFile(StaticText1.Caption);

Image1.Height:= Image1.Picture.Height;

Image1.Width:= Image1.Picture.Width;

Form1.FormResize(nil);

if ENC_check(bmp) then

begin

Memo1.lines.Add('Encoded picture, decode this?');

Button1.Enabled:= false;

Button4.Enabled:= true;

end

else

begin

Button1.Caption:= 'Encode';

Button1.Enabled:= true;

Edit1.Visible:= true;

Edit1.Enabled:= true;

end;

end

else

ShowMessage('Choose bmp file to encode');

OD.Destroy;

 

end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

SD:=TSaveDialog.Create(nil);

SD.Execute;

StaticText2.Caption:=SD.FileName;

if SD.FileName <> '' then

begin

bmp.SaveToFile(StaticText2.Caption+'.bmp');

Memo1.Lines.Add('File saved to: '+StaticText2.Caption+'.bmp');

end

else

ShowMessage('Enter filename to save');

StaticText2.Visible:=true;

SD.Destroy;

end;

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.Height:=600;

Form1.Width:=800;

Memo1.top:= form1.Height-110;

Memo1.left:= 10;

Memo1.Height:= 60;

Memo1.Width:= Form1.Width - 45;

Edit1.Text:= 'Enter Key Sequence.';

Edit1.Visible:=False;

Edit1.Enabled:=False;

StaticText1.Visible:=false;

StaticText2.Visible:=false;

Button1.Enabled:=False;

Button4.Enabled:=False;

Button3.Enabled:=False;

Randomize; //Инициализация ГСЧ

end;

 

procedure TForm1.Button4Click(Sender: TObject);

begin

if Button1.Caption = 'Encoded' then

begin

Memo1.Lines.Add('Decoding starts '+TimetoStr(time));

Button4.Caption:= 'Decoding...';

Mixing(MX,TBA,false); //Декодирование

MatrixToBmp(MX); //Сохранение значения пикселей

Memo1.Lines.Add('Decoding picture complete '+TimetoStr(time));

Image1.Picture.Bitmap:=bmp;

end

else

begin

MxDim:= max(bmp.Height,bmp.Width);

SetLength(MX, MxDim, MxDim);

ExtractRGB(bmp, MX);

Key:=LSB_Ext(MX);

MxDim:= max(bmp.Height,bmp.Width);

TBA:=FMX(Key, MxDim);

Mixing(MX,TBA,false);

MatrixToBmp(MX);

Image1.Picture.Bitmap:=bmp;

end;

Button4.Caption:= 'Decoded';

Button4.Enabled:= False;

Button1.Caption:= 'Encode';

Button1.Enabled:= True;

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

Image1.Left:= Form1.ClientWidth div 2 - Image1.Height div 2;

Memo1.top:= form1.ClientHeight-65;

Memo1.left:= 10;

Memo1.Height:= 60;

Memo1.Width:= Form1.Clientwidth - 20;

Button1.Left:= Form1.Width - 105;

Button2.Left:= Form1.Width - 185;

Button3.Left:= Form1.Width - 185;

Button4.Left:= Form1.Width - 105;

end;

end.


ПРИЛОЖЕНИЕ В

Date: 2016-07-22; view: 331; Нарушение авторских прав; Помощь в написании работы --> СЮДА...



mydocx.ru - 2015-2024 year. (0.009 sec.) Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав - Пожаловаться на публикацию