Разработка программы цифровой стеганографии

4:begin Pic. Picture. LoadFromFile (path+'images/upload/pic3.png'); t:=0; end;

end;

{$ELSE}

case t of

1: Pic. Picture. LoadFromFile (path+'images\upload\pic0.png');

2: Pic. Picture. LoadFromFile (path+'images\upload\pic1.png');

3: Pic. Picture. LoadFromFile (path+'images\upload\pic2.png');

4:begin Pic. Picture. LoadFromFile (path+'images\upload\pic3.png'); t:=0; end;

end;

{$ENDIF}

end;

procedure TForm1. PicMouseEnter;

begin

{Анимируем кнопку «Загрузить изображение»}

if picloaded=false then

begin

t:=0; // Инициализируем переменную t.

Animation. Interval:=0; // Задаем интервал 0 для быстрого срабатывания.

Animation. Enabled:=true; // Включаем таймер.

 // Задаем интервал 300 мс между переключением кадров анимации.

Animation. Interval:=300;

end;

end;

procedure TForm1. PicMouseLeave;

begin

{Отключаем анимацию кнопки «Загрузить изображение».}

if picloaded=false then

begin

Animation. Enabled:=false; // Отключаем таймер.

{$IFDEF Unix}

Pic. Picture. LoadFromFile (path+'images/upload/nonactive.png'); // возвращаем исходную картинку

{$ELSE}

Pic. Picture. LoadFromFile (path+'\images\upload\nonactive.png'); // возвращаем исходную картинку

{$ENDIF}

end;

end;

procedure TForm1. QuitClick;

begin

 // Закрываем программу.

halt;

end;

procedure TForm1. QuitMouseEnter;

begin

{$IFDEF Unix}

Quit. Picture. LoadFromFile (path+'images/buttons/exitbtn-active.png');

{$ELSE}

Quit. Picture. LoadFromFile (path+'images\buttons\exitbtn-active.png');

{$ENDIF}

end;

procedure TForm1. QuitMouseLeave;

begin

{$IFDEF Unix}

Quit. Picture. LoadFromFile (path+'images/buttons/exitbtn.png');

{$ELSE}

Quit. Picture. LoadFromFile (path+'images\buttons\exitbtn.png');

{$ENDIF}

end;

 // Процедура проверки размера контейнера и загружаемого файла.

function TForm1.check:boolean;

begin

FileSizeInBytes. Visible:=true;

FileSizeInBytes. Caption:=dcfsib+' '+IntToStr(hidingfilesize)+' Байт';

 // Проверяем, что размер файла соотвествует размеру контейнера.

if ((Container. Width * Container. Height * 2) div 8)>=hidingfilesize then

begin

Result:=true;

FileSizeInBytes. Font. Color:=$00A1FF90;

end

else

begin

Result:=false;

FileSizeInBytes. Font. Color:=clRed;

end;

end;



procedure TForm1. SelectFileClick;

var s: TSearchRec;

begin

 // Открываем записываемыей файл и вычисляем его размер

if HidingFileOpen. Execute then

begin

fileloaded:=true;

if FindFirst (HidingFileOpen. FileName, faAnyFile, s)=0 then

hidingfilesize:=s. Size;

FindClose(s);

check;

end

else

fileloaded:=false;

end;

end. // Конец.

Unit2.pas

(Модуль хэширования и шифрования, соответственно содержит 2 процедуры:

1) Зашифровать файл паролем пользователя с помощью алгоритма AES-256

PS: Вообще этот шаг я воплощаю в жизнь только с «превентивной» целью. Т.е обезопасить

данные в случае обнаружения.

2) Хэшировать пароль. Хэш будет md5. В качестве реализации использую

системный модуль лазаруса содержащий готовую фунцию.}

unit Unit2;

{$mode objfpc} {$H+}

interface

uses

Classes, Process, SysUtils, md5 {системный-модуль lazarus, работает ли он в Windows?};

type

TCreepy =

class

public

function HashIt (pass:string):string;

function Encrypt (apppath, pass, imagecont:string):string;

function Decrypt (apppath, pass, imagecont:string):string;

end;

var //Creepy:TCreepy;

hProcess: TProcess;

implementation

 // Функция хэширования пароля

function TCreepy. HashIt (pass:string):string;

begin

Result:= MD5Print (MD5String(pass));

end;

 // Функция шифрования файла

 // на вход дается полный путь до файла и пароль, который ввел пользователь

 // на выходе полный путь до закриптованного файла

function TCreepy. Encrypt (apppath, pass, imagecont:string):string;

begin

 // Создаем объект TProcess и

 // присваиваем его переменной AProcess.

hProcess:= TProcess. Create(nil);

 // Сообщим AProcess сомандную строку для запуска

{$IFDEF Unix}

hProcess. CommandLine:= 'openssl aes-256-cbc - pass pass:'+pass+' - in '+imagecont+' - out '+imagecont+'.enc';

{$ELSE}

 //windows

hProcess. CommandLine:= apppath+'openssl aes-256-cbc - pass pass:'+pass+' - in '+imagecont+' - out '+imagecont+'.enc';

{$ENDIF}

 // Необходимо описать опции программы для запуска

 // Эта опция не позволит нашей программе выполнятся до тех пор, пока

 // запущенная программа не закончится

hProcess. Options:= hProcess. Options + [poWaitOnExit];

 // Теперь AProcess знает командную строку

 // и мы ее запускаем

hProcess. Execute;

 // Пока ppc386 не прекратит работу, мы досюда не дойдем

hProcess. Free;

Result:=imagecont+'.enc'; // возвращаем путь до зашифрованного файла

end;

 // Функция дешифрования

function TCreepy. Decrypt (apppath, pass, imagecont:string):string;

var sourcefile:string;

begin

 // Избавляемся от расширения.enc

sourcefile:=StringReplace (imagecont, '.enc', «, [rfReplaceAll, rfIgnoreCase]);

 // Создаем объект TProcess и

 // присваиваем его переменной AProcess.

hProcess:= TProcess. Create(nil);

 // Сообщим AProcess сомандную строку для запуска

{$IFDEF Unix}

hProcess. CommandLine:= 'openssl aes-256-cbc - pass pass:'+pass+' - d'+' - in '+imagecont+' - out '+sourcefile;

{$ELSE}

 //windows

hProcess. CommandLine:= apppath+'openssl aes-256-cbc - pass pass:'+pass+' - d'+' - in '+imagecont+' - out '+sourcefile;

{$ENDIF}

{Необходимо описать опции программы для запуска

Эта опция не позволит нашей программе выполнятся до тех пор, пока

запущенная программа не закончится}

hProcess. Options:= hProcess. Options + [poWaitOnExit];

 // Теперь AProcess знает командную строку и мы ее запускаем

hProcess. Execute;

 // Пока ppc386 не прекратит работу, мы досюда не дойдем

hProcess. Free;

Result:=sourcefile; // возвращаем путь до зашифрованного файла

end;

end.

Unit3.pas

{программный модуль содержит класс, отвечающий за чтение / запись содержимого контейнера}

unit Unit3;

{$mode objfpc} {$H+}

interface

uses

SysUtils, Classes, Graphics, Math, Unit2;

type

TStegano =

class

public

procedure WriteBufferToContainer (MS: TStream; StartPos, Count, Val: integer; var Bmp: TBitmap);

procedure ReadBufferFromContainer (Bmp: TBitmap; StartPos, Count, Val: integer; var MS: TStream);

end;

var Creepy:TCreepy; // класс для шифрования / дешифрования / хеширования из Unit2

Stegano:TStegano; // класс содержащий процедуры записи данных из потока в контейнер

implementation

procedure TStegano. WriteBufferToContainer (MS: TStream; StartPos, Count, Val: integer; var Bmp: TBitmap);

var

Ind, Indx, Indy, Indz, Ind1, FreeSpace, Divider, NewVal: integer;

CurVal, MByte, R: byte;

begin

CurVal:=0; // Инициализируем локальную переменную.

If Val > 8 then

Exit;

If (Val mod 2 <> 0) and (Val <> 1) then

Exit;

If (MS. Size - MS. Position) < (Count - StartPos) then

Exit;

FreeSpace:= (Bmp. Width * Bmp. Height * Val) div 8;

StartPos:= StartPos * 8 div Val + 1;

If (Count - StartPos) > FreeSpace then

Exit;

MByte:= Round (Power(2, Val) - 1);

Indz:= Val;

MS. Read (CurVal, 1);

If Bmp. Width > Bmp. Height then

Divider:= Bmp. Height

else

Divider:= Bmp. Width;

for Ind1:= 0 to (Count * 8 div Val) do

begin

NewVal:= 0;

Ind:= 16;

Indx:= StartPos div Divider;

Indy:= StartPos mod Divider;

while (Ind >= 0) and (MS. Position <= StartPos + Count) do

begin

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

R:= R and (255 - MByte);

R:= R or (CurVal and MByte);

NewVal:= NewVal shl 8;

NewVal:= NewVal or R;

CurVal:= CurVal shr Val;

Inc (Indz, Val);

If Indz > 8 then

begin

Indz:= Val;

MS. Read (CurVal, 1);

end;

Dec (Ind, 8);

end;

Bmp. Canvas. Pixels [Indx, Indy]:= NewVal;

Inc(StartPos);

end;

end;

procedure TStegano. ReadBufferFromContainer (Bmp: TBitmap; StartPos, Count, Val: integer; var MS: TStream);

var

Ind, Indx, Indy, Indz, Ind1, Divider: integer;

CurVal, MByte, R: byte;

begin

CurVal:= 0;

If Val > 8 then

Exit;

If (Val mod 2 <> 0) and (Val <> 1) then

Exit;

If MS = nil then

MS:= TMemoryStream. Create;

MByte:= Round (Power(2, Val) - 1);

Indz:= Val;

If Bmp. Width > Bmp. Height then

Divider:= Bmp. Height

else

Divider:= Bmp. Width;

StartPos:= StartPos * 8 div Val + 1;

for Ind1:= 0 to (Count * 8 div Val) do

begin

Ind:= 16;

Indx:= StartPos div Divider;

Indy:= StartPos mod Divider;

while (Ind >= 0) and (MS. Position <= StartPos + Count) do

begin

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

R:= R and MByte;

CurVal:= CurVal or (R shl (Indz - Val));

Inc (Indz, Val);

If Indz > 8 then

begin

Indz:= Val;

MS. Write (CurVal, 1);

CurVal:= 0;

end;

Dec (Ind, 8);

end;

Inc(StartPos); end; end; end.

Размещено на Allbest.ru

...