Дипломному проекту на тему: «Разработка методов встраивания информации в пространственную область изображения»

Скачать 0.97 Mb.

Название	Дипломному проекту на тему: «Разработка методов встраивания информации в пространственную область изображения»
страница	10/10
Дата публикации	31.05.2014
Размер	0.97 Mb.
Тип	Диплом

literature-edu.ru > Информатика > Диплом

1 2 3 4 5 6 7 8 9 10

Приложение 2

Листинг модуля “StegoFunc” программы на Delphi 7.0
{*************************************************************** }

{ Модуль StegoFunc }

{ Copyright (c) 2010 Сафиуллин Ф.Н. }

{ }

{ Разработчик: Сафиуллин Ф.Н. }

{ Модифицирован: 24 января 2010 г. }

{ }

{*************************************************************** }
unit StegoFunc;
interface

uses

Windows, Classes, Graphics, Math, Messages, Dialogs, SysUtils;// модули Delphi
type

TStringArray = array of string;

TIntegerArray = Array[1..12] of integer;
procedure GenerateIndXIndY(var IndX: integer; var IndY: Integer;

ImgHeight: Integer; ImgWidth: Integer; KeyMatrix: TIntegerArray;

var IndMatrix: TStringArray; Index: Integer; var Error: Boolean);

procedure WriteLSB(var Number:byte;Index:Integer;Value:char);

procedure ReadLSB(Number:byte;Index:Integer;var Value:String);

function FormingKey(Password: String; var Marker: String): TIntegerArray;

function NewInd(IndX: Integer; IndY: Integer;

var IndMatrix: TStringArray): boolean;

function IntToBin(Value: Integer): String;

function BinToInt(Value: String): Integer;
implementation
//************************************************************

// Процедура определения точек Х и У на основании ключа

procedure GenerateIndXIndY(var IndX: Integer; var IndY: Integer;

ImgHeight: Integer; ImgWidth: Integer; KeyMatrix: TIntegerArray;

var IndMatrix: TStringArray; Index: Integer; var Error: Boolean);

Var

j,Indx2,Indy2,summX,summY:integer;

begin
Indx2 := 0;

Indy2 := 0;

summX := 0;

summY := 1;
// Вычисляем координаты x и y

repeat

Indx := (Index div ImgHeight) + 1;

Indy := (Index mod ImgHeight) + 1;
for j := 1 to 6 do

begin

Indx := ((Indx + (Indy + KeyMatrix[2*j-1])) mod (ImgWidth)) + 1;

Indy := ((Indy + (Indx + KeyMatrix[2*j])) mod (ImgHeight)) + 1;

end;
// Исключаем условие зацикливания

if (Indx2 = Indx) and (Indy2 = Indy) then

begin

summX := summX + 1;

Indx := summX;

Indy := summY;

if summX >= ImgWidth then

begin

summX := 0;

summY := summY + 1;

if summY >= ImgHeight then

begin

MessageDlg('Не удалось встроить информацию в изображение!',

mtError, [mbOk] , 0);

Error := True;

Exit;

end;

end;

end;

Indx2 := Indx;

Indy2 := Indy;
// Запоминаем биты в которые встраивали информацию,

// чтобы их не перезаписать

until NewInd(Indx,Indy,IndMatrix);
end;
//************************************************************

// Процедура встраивает бит в оттенок цвета

procedure WriteLSB(var Number:byte;Index:Integer;Value:char);

var

str: string;

begin

str := IntToBin(Number);

str[Index] := Value;

Number := BinToInt(str);

end;
//************************************************************

// Процедура извлечения бит из оттенка цвета

procedure ReadLSB(Number:byte;Index:Integer;var Value:String);

var

str: string;

begin

str := IntToBin(Number);

Value := Value + str[Index];

end;
//************************************************************

// Функция формирует ключ для последующего вычисления координат x и y

// на основании введенного пользователем пароля

function FormingKey(Password: String; var Marker: String): TIntegerArray;

var

Key,i:Integer;

KeyMatrix: TIntegerArray;

begin
// Преобразование Пароля к ключу

Key := 0;
for i:=1 to Length(Password) do

begin

Key:=Key + Ord(Password[i]);

end;
// Формирование основного ключа для вычисления координат x и y

KeyMatrix[1] := Key;

for i := 1 to 12 do

begin

if i = 1 then

KeyMatrix[i] := Key

else

KeyMatrix[i] := StrToInt(Copy(IntToStr(Sqr(KeyMatrix[i-1])),1,3));
if KeyMatrix[i] > 255 then

KeyMatrix[i] := StrToInt(Copy(IntToStr(KeyMatrix[i]),1,2));

end;
// Определение конечного маркера

Marker := '';

Marker := Marker + IntToBin(KeyMatrix[1]);

Marker := Marker + IntToBin(KeyMatrix[12]);

Marker := Marker + IntToBin(KeyMatrix[4]);

Marker := Marker + IntToBin(KeyMatrix[8]);
Result:= KeyMatrix;

end;
//************************************************************

// Функция проверяет использовалась ли точка с данными координатами

// для встраивания информации

function NewInd(IndX:Integer;IndY:Integer;var IndMatrix:TStringArray): boolean;

var

i, LengthIndMatrix: Integer;

ind: String;

begin
// цикл по массиву в поисках уже использованных значений

ind := IntToStr(IndX) + '_' + IntToStr(IndY);

LengthIndMatrix := Length(IndMatrix);

for i:=0 to LengthIndMatrix-1 do

begin

if IndMatrix[i] = ind then

begin

Result := false;

Exit;

end;

end;
// запись использованных значений в массив

SetLength(indMatrix,LengthIndMatrix+1);
IndMatrix[LengthIndMatrix] := Ind;

Result := true;

end;
//************************************************************

// Функция преобразует десятичное число в двоичное

function IntToBin(Value: Integer): String;

var

i: Integer;

begin

Result:='';

for i:=7 downto 0 do begin

if Value and (1 shl i)<>0 then begin

Result:=Result+'1';

end

else

begin

Result:=Result+'0';

end;

end;

end;
//************************************************************

// Функция преобразует двоичное число в десятичное

function BinToInt(Value: String): Integer;

var

i: Integer;

s: String;

begin

Result:=0;

for i:=1 to 8 do

begin

s := Copy(Value,i,1);

if Copy(Value,i,1)='1' then

Result:=Result+Round(Power(2,8-i));

end;

end;

end.

Приложение 3

Листинг модуля “Give” программы на Delphi 7.0
{*************************************************************** }

{ Модуль Give }

{ Copyright (c) 2010 Сафиуллин Ф.Н. }

{ }

{ Разработчик: Сафиуллин Ф.Н. }

{ Модифицирован: 29 января 2010 г. }

{ }

{*************************************************************** }
unit Give;
interface
uses

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

Dialogs, StdCtrls, ExtDlgs, ExtCtrls, Mask, ComCtrls, StrUtils,// модули Delphi

StegoFunc; // модуль основных функция и процедур стеганографии
type

TForm1 = class(TForm)

Button_OpenImg: TButton;

Button_Read: TButton;

OpenPictureDialog_Img: TOpenPictureDialog;

Memo_Txt: TMemo;

Password: TEdit;

Label_Password: TLabel;

Label4: TLabel;

Label5: TLabel;

CheckBox_Marker: TCheckBox;

Edit_R: TEdit;

Label7: TLabel;

Label8: TLabel;

Edit_G: TEdit;

Label9: TLabel;

Edit_B: TEdit;

Label10: TLabel;

Edit_InfoCont: TEdit;

Bevel1: TBevel;

Image_Write: TImage;

Label1: TLabel;

Label_IngoCont: TLabel;

procedure Button_OpenImgClick(Sender: TObject);

procedure Button_ReadClick(Sender: TObject);

procedure Edit_KeyPress(Sender: TObject; var Key: Char);

procedure Edit_Change(Sender: TObject);

procedure Edit_InfoContKeyPress(Sender: TObject; var Key: Char);

private

{ Private declarations }

public

end;
var

Form1: TForm1;
implementation
{$R *.dfm}
//************************************************************

// Процедура - обработчик нажатия кнопки "Открыть изображение"

procedure TForm1.Button_OpenImgClick(Sender: TObject);

var

FileName : String;

begin

If OpenPictureDialog_Img.Execute then

begin
// Открываем изображение для извлечения из него информации

FileName := OpenPictureDialog_Img.FileName;
// Выводим изображение на форму

image_Write.Picture.Bitmap.Create;

image_Write.Picture.Bitmap.LoadFromFile(FileName);

end

else

exit;

end;
//************************************************************

// Процедура - обработчик нажатия кнопки "Извлечь встроенную информацию"

procedure TForm1.Button_ReadClick(Sender: TObject);

var

Indx, Indy, i, j, ImgHeight, ImgWidth, Size, InfoCont: Integer;

B, G, R, B_byte, G_byte , R_byte, Val: byte;

List, Mv, Mvb, Marker: String;

KeyMatrix: TIntegerArray;

IndMatrix: TStringArray;

error, MarkerCheck: boolean;

Bmp: TBitmap;

begin
// Изображение из формы в переменную

Bmp := image_Write.Picture.Bitmap;
// Проверка выбрано ли изображение

if Bmp.Empty then

begin

MessageDlg('Не выбрано изображение!', mtWarning, [mbOk] , 0);

exit;

end;
// Проверка указано ли количество информации

if Not CheckBox_Marker.Checked and (Edit_InfoCont.Text = '') then

begin

MessageDlg('Не указан объем информации!', mtWarning, [mbOk] , 0);

exit;

end;
// Определяем переменные

InfoCont := StrToInt(Edit_InfoCont.Text);

MarkerCheck := CheckBox_Marker.Checked;

Marker := '';

ImgHeight := bmp.Height;

ImgWidth := bmp.Width;

error := false;

B_byte := 0;

G_byte := 0;

R_byte := 0;
// Формирование основного ключа для вычисления координат x и y

KeyMatrix := FormingKey(Password.Text,Marker);
// Если используется маркер окончания информации

if MarkerCheck then

Size := ImgHeight * ImgWidth

else

Size := InfoCont*8;
// Производим извлечение информации

for i:=1 to Size do

begin
// Проверим, нужно ли генерировать новую точку для встраивания

if (i = 1) or ((B_byte = StrToInt(Edit_B.Text))

and (G_byte = StrToInt(Edit_G.Text))

and (R_byte = StrToInt(Edit_R.Text))) then

begin

// Определяем координаты X и Y для первой точки

GenerateIndXIndY(IndX,IndY,ImgHeight,ImgWidth,KeyMatrix,IndMatrix,i,error);
if error then exit;
B_byte := 0;

G_byte := 0;

R_byte := 0;

end;
// Читаем цветовые значение RGB точки

R := Byte(Bmp.Canvas.Pixels[(Indx-1), (Indy-1)] shr 0);

G := Byte(Bmp.Canvas.Pixels[(Indx-1), (Indy-1)] shr 8);

B := Byte(Bmp.Canvas.Pixels[(Indx-1), (Indy-1)] shr 16);
// Читаем бит информации из цветовой области точки

If B_byte < StrToInt(Edit_B.Text) then

begin

ReadLSB(B,8-B_byte,Mvb);

Inc(B_byte);

end

else If G_byte < StrToInt(Edit_G.Text) then

begin

ReadLSB(G,8-G_byte,Mvb);

Inc(G_byte);

end

else If R_byte < StrToInt(Edit_R.Text) then

begin

ReadLSB(R,8-R_byte,Mvb);

Inc(R_byte);

end;
// Проверка метки, если найдена завершаем цикл

if MarkerCheck and (AnsiRightStr(Mvb, 32) = Marker) then break;
end;
// Производим преобразование последовательности бит в сообщение

List := '';

i := 1;
// Если используется маркер окончания информации

if MarkerCheck then

Size := Length(Mvb)-32

else

Size := Length(Mvb);
while i <= Size do

begin

Mv := copy(Mvb,i,8);

Val := 0;

for j:=8 downto 1 do

begin

Val := Val + StrToInt(Mv[j])*Round(Power(2,8-j));

end;
List := List + Chr(Val);
i:=i+8;

end;
// Выводим сообщение на форму

Memo_Txt.Text := List;
end;
//************************************************************

// Процедура - событие при вводе количества бит в области

procedure TForm1.Edit_KeyPress(Sender: TObject; var Key: Char);

begin

// Ограничение по вводу числа от 0 до 8

if Not (Key in ['0'..'8', #8])then Key:=#0;

end;
//************************************************************

// Процедура - событие при окончаниии ввода количества бит в области

procedure TForm1.Edit_Change(Sender: TObject);

begin

// Если поля не заполнены им присваевается ноль

if Edit_R.Text = '' then Edit_R.Text := '0';

if Edit_G.Text = '' then Edit_G.Text := '0';

if Edit_B.Text = '' then Edit_B.Text := '0';

end;
//************************************************************

// Процедура - событие при окончаниии ввода объема информации

procedure TForm1.Edit_InfoContKeyPress(Sender: TObject; var Key: Char);

begin

// Ограничение по вводу числа от 0 до 9

if Not (Key in ['0'..'9', #9])then Key:=#0;

end;

end.

1 2 3 4 5 6 7 8 9 10

Похожие:

	Дипломному проекту на тему: «Разработка методов встраивания информации... Санкт-Петербургский государственный электротехнический университет “лэти” им. В. И. Ульянова (Ленина)” (СПбгэту)		Анализ стойкости метода коха-жао стеганографического встраивания... Аннотация: Рассмотрен метод стеганографического встраивания информации Коха-Жао. В статье проведен анализ стойкости данного метода...
	Пояснительная записка к дипломному проекту на тему индивидуальный жилой дом в г. Тюмени Исходные данные к проекту -задание на проектирование,рабочие чертежи марки ас,ГП. Материалы инженерно-геологических изысканий		Пояснительная записка к дипломному проекту на тему: «Разработка автоматизированной... Тема дипломного проекта (работы) Разработка автоматизированной системы печати ценников на витрины автосалона на базе ms access
	Пояснительная записка к дипломному проекту на тему: «Разработка автоматизированной... Тема дипломного проекта (работы) Разработка автоматизированной системы инвентаризации комплектующих для сборки компьютеров на базе...		Инструкция пользователя. 23 Разработка методов информационного поиска на основе методов интеллектуального анализа данных. 8
	Пояснительная записка к дипломному проекту включает в себя: страниц... Тема дипломного проекта «Проект программно-методического комплекса автоматизации обработки данных и решения задач с использованием...		Пояснительная записка к дипломному проекту включает в себя: 104108... Тема дипломного проекта «Проект программно-методического комплекса автоматизации обработки данных и решения задач с использованием...
	Реферат Пояснительная записка к дипломному проекту включает в себя:... Тема дипломного проекта «Проект программно-методического комплекса для оптимизации распределения заданий по формированию твердых...		Пояснительная записка к курсовому проекту на тему микропроцессорная...

Литература