Полезное:
Как сделать разговор полезным и приятным
Как сделать объемную звезду своими руками
Как сделать то, что делать не хочется?
Как сделать погремушку
Как сделать так чтобы женщины сами знакомились с вами
Как сделать идею коммерческой
Как сделать хорошую растяжку ног?
Как сделать наш разум здоровым?
Как сделать, чтобы люди обманывали меньше
Вопрос 4. Как сделать так, чтобы вас уважали и ценили?
Как сделать лучше себе и другим людям
Как сделать свидание интересным?
Категории:
АрхитектураАстрономияБиологияГеографияГеологияИнформатикаИскусствоИсторияКулинарияКультураМаркетингМатематикаМедицинаМенеджментОхрана трудаПравоПроизводствоПсихологияРелигияСоциологияСпортТехникаФизикаФилософияХимияЭкологияЭкономикаЭлектроника
|
Список используемых источников ⇐ ПредыдущаяСтр 9 из 9 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. ПРИЛОЖЕНИЕ В
|