Cryptality-Verileri Resimde Gizlemek

sWaGg€r

06.07.2008 17:59:44

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ExtDlgs,Math;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Image1: TImage;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Image2: TImage;
BitBtn1: TBitBtn;
Memo1: TMemo;
Button4: TButton;
OpenPictureDialog1: TOpenPictureDialog;
OpenDialog1: TOpenDialog;
SavePictureDialog1: TSavePictureDialog;
Label5: TLabel;
Memo2: TMemo;
Image3: TImage;
Label1: TLabel;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
function bitecevir(sayi : byte):string;
function baytacevir(deger : string):byte;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ResimDizi : Array of Byte;
BiteCevirDizi : Array of Byte;
KarakterDizi : Array of Byte;
bitdizi : Array of Char;
ResimVar : Boolean;
implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
x,y,k : Integer;
P : PByteArray;
i , j: Integer;
Metin , sonuc: String;
sayi,bolum : Integer;
sayac : Integer;
begin
if Memo1.Lines.Text = " Then
begin
showmessage('Lütfen Şifrelenecek Metni Giriniz....');
Exit;
end;
j := 0;

//Metnin her bir karakteri 8'er bite ayrılarak diziye atanıyor.
Metin := Memo1.Lines.Text;
sayac := Length(Metin)*8;
if sayac > (Image1.width*Image1.Height) - 4 Then
begin
ShowMessage('Girdiğiniz Metin Resme Sığmayacak Kadar Büyük.Lütfen Metin Boyutunu Küçültün' + #13 +
' veya' + #13 +
' Daha Büyük Bir Resim Seçin');
Exit;
end;

setlength(bitdizi,sayac);
for i := 0 to sayac - 1 do
bitdizi := #0;

for k := 1 to Length(Metin) do
begin
sonuc := bitecevir(Ord(Metin[k]));
for i := 1 to Length(Sonuc) do
begin
bitdizi[j] := sonuc;
j := j + 1;
end;
sonuc := ";
end;
//Şifrelenecek resmin piksel gritonları diziye atanıyor.
i := 0;
//setlength(ResimDizi,Image1.Width*Image1.Height);
for y := 0 to Image1.Height -1 do
begin
P := Image1.Picture.Bitmap.ScanLine[y];
for x := 0 to Image1.Width -1 do
begin
ResimDizi := p
;
i := i + 1;
end;
end;
Image1.Refresh;

//Bitdizideki değerler ile Resimdizideki elemanlar arasında gerekli işlemler yapılıyor.
//LSB bitlerinde değişiklikler yapılıyor.
for i := 0 to sayac - 1 do
begin
if Bitdizi = '1' Then Resimdizi := Resimdizi OR 1;
if Bitdizi = '0' Then Resimdizi := ResimDizi AND 254;
end;

//gizlenecek olan metnin karakter sayısı resmin son 4 pikseline yerleştiriliyor.
//böylece 32 bit uzunluğu kadar karakterlik metinler kullanılabilir.
sonuc := ";
sayi := Length(Memo1.Lines.Text);
for i := 0 to 31 do //her seferinde MyDizi[2] nin içeriği sıfırlanmazsa yanlış sonuç üretiyor...
KarakterDizi := 0;

for i := 0 to 31 do
begin
KarakterDizi := sayi mod 2;
bolum := sayi div 2;
if bolum = 1 Then
begin
KarakterDizi[i+1] := 1;
break;
end;
sayi := bolum;
end;

for i := 31 downto 0 do
sonuc := sonuc + IntToStr(KarakterDizi);

j := 1;
for i := 4 downto 1 do
begin
ResimDizi[Length(ResimDizi)-i] := baytacevir(Copy(sonuc,j,8));
j := j + 8;
end;

//Şifrelenmiş resim oluşturuluyor...

i := 0;
for y := 0 to Image2.Height -1 do
begin
P := Image2.Picture.Bitmap.ScanLine[y];
for x := 0 to Image2.Width -1 do
begin
P
:= ResimDizi;
i := i + 1;
end;
end;
Image2.Refresh;
Image2.Visible := True;
BitBtn3.Visible := True;

end;

function TForm1.bitecevir(sayi: byte): string;
var
bolum , i : byte;
sonuc : string;
begin
sonuc := ";

for i := 0 to 7 do //her seferinde MyDizi[2] nin içeriği sıfırlanmazsa yanlış sonuç üretiyor...
BiteCevirDizi := 0;

for i := 0 to 7 do
begin
BiteCevirDizi := sayi mod 2;
bolum := sayi div 2;
if bolum = 1 Then
begin
BiteCevirDizi[i+1] := 1;
break;
end;
sayi := bolum;
end;
for i := 7 downto 0 do
sonuc := sonuc + IntToStr(BiteCevirDizi);
Result := sonuc;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(KarakterDizi,32);
setlength(BiteCevirDizi,8);
ResimVar := False;
end;

function TForm1.baytacevir(deger: string): byte;
var
i , sayi , toplam : byte;
begin
toplam := 0;
sayi := 128;
for i := 1 to 8 do
begin
toplam := toplam + strtoint(deger)*sayi;
sayi := sayi div 2;
end;
Result := Toplam;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
x , y : Integer;
P : pByteArray;
begin

for y := 0 to Image2.Height -1 do
begin
P := Image2.Picture.Bitmap.ScanLine[y];
for x := 0 to Image2.Width -1 do
p
:= 255 - p
;
end;
Image2.Refresh;
Image2.Visible := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo2.Clear;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute Then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
Image2.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
BitBtn2.Top := Image1.Top + Image1.Height + 10;
BitBtn1.Top := BitBtn2.Top;
BitBtn3.Top := BitBtn2.Top;
Image2.Visible := False;
BitBtn3.Visible := False;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
if SavePictureDialog1.Execute Then
Image2.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName +'.bmp');
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
Memo1.Clear;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
if OpenDialog1.Execute Then
begin
Memo1.Clear;
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
close;
end;

procedure TForm1.BitBtn10Click(Sender: TObject);
begin
Memo2.Clear;
end;

procedure TForm1.BitBtn8Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute Then
begin
Image3.Picture.LoadFromFile(OpenPictureDialog1.FileName);
BitBtn8.Top := Image3.Top + Image3.Height + 10;
BitBtn9.Top := BitBtn8.Top;
ResimVar := True;
end;

end;

procedure TForm1.BitBtn9Click(Sender: TObject);
var
x,y ,k,i : Integer;
P : PByteArray;
say : Integer;
sonuc , TamMetin: String;
toplam : Extended;
sayac : Extended;
begin
//Sayac değeri belirleniyor.(Karakter sayısı x Resmin son 4 pixelinden.

Memo2.Clear;
if not ResimVar Then Exit;
sonuc := ";
toplam := 0;
P := Image3.Picture.Bitmap.ScanLine[Image3.Height -1];

for i := 4 downto 1 do
sonuc := sonuc + bitecevir(P[Image3.Width-i]);

for i := 1 to 32 do
if sonuc = '1' Then toplam := toplam + IntPower(2,32-i);

sayac := toplam*8;

k := 0;
TamMetin := ";
for y := 0 to Image3.Height -1 do
begin
P := Image3.Picture.Bitmap.ScanLine[y];
for x := 0 to Image3.Width -1 do
begin
if k = sayac Then
begin
i := 1;
sonuc := ";
say := Length(TamMetin) div 8;
for k := 1 to say do
begin
sonuc := sonuc + chr(baytacevir(copy(TamMetin,i,8)));
i := i + 8;
end;
Memo2.Clear;
Memo2.Lines.Add(sonuc);
Exit;
end;
sonuc := ";
sonuc := bitecevir (P
);
TamMetin := TamMetin + sonuc[8];
k := k + 1;
end;
end;
end;