Эксперт
Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003
Репутация: 13
Всего: 63
|
Будешь должен ;) Я сегодня добрый  Код модуля, делает | Цитата | скрытие информации в картинках.
|
Алгоритм заключается в "небольшой" поправке BMP файла (хотя по сути можно любой растровый файл корябить), так что некоторая последовательность байтов делилась на 255 с остатком, равным нужной инфе... а если не понял, что я сказал, то читай сырцы: | Код |
unit SaveInfoToImage;
{*******************************************************}
{ }
{ Run-time Library for Borland Delphi 7 }
{ Saving info to bitmap image }
{ }
{ Copyright (c) 2001-2005 by Veresov Dmitry }
{ }
{ ***** }
{ ** ** }
{ ** ** ************ }
{ ** ** ** ** ** }
{ ** ** ** ** ** }
{ ** ** ** ** ** }
{ ***** *** *** **** }
{ }
{*******************************************************}
interface
uses dm, Math, Classes, SysUtils, Windows, Graphics;
type
TRGB=record
b,g,r : byte;
end;
type
TArByte = array of byte;
Type
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;
PRGB = ^TRGB;
// BeginImage преобразовывается в Tbitmap с учётом информации Info с ячейкой размером Cell
Function SaveInfoToBmpFile(BeginImage : TGraphic; Info : TArByte; Cell : Integer) : Tbitmap;
// достаём информацию из Bitmap
Function LoadInfoFromBitmap(Bitmap : TBitmap) : TArByte;
// достаём строку из Bitmap
Function LoadStringFromInfo(Info : TArByte) : String;
// достаём информацию из строки
Function LoadInfoFromString(Str : String) : TArByte;
// сохраняет имя файла в информацию
Function SaveFileToInfo(FileName : String) : TArByte;
// достаём информацию имя файла
Function GetFileNameFromInfo(Info : TArByte) : String;
// максимально возможное количество информации, которое можо записать в Graphic с ячейкой размером Cell
Function MaxSizeInfoInGraphic(Graphic : TGraphic; Cell : Integer) : Integer;
// сохраняет информацию в файл
Procedure SaveInfoToFile(Info : TArByte; FileName : String);
// выдаёт размер Cell, наиболее оптимальный если сохранять в Graphic информацию о файле FileName
function GetMaxPixelsInSquare(FileName : String; Graphic : TGraphic) : integer;
function GetFileName(Filename : string):string;
function GetFileSizeByName(FileName: String): Integer;
implementation
function GetFileName(filename:string):string;
var
i, n : integer;
begin
Result:='';
If filename='' then exit;
n:=0;
for i:=length(filename)-1 downto 1 do
If filename[i]='\' then
begin
n:=i;
break;
end;
delete(filename,1,n);
If filename<>'' then
If filename[Length(filename)]='\' then
Delete(filename,Length(filename),1);
result:=filename;
end;
function GetFileSizeByName(FileName: String): Integer;
var
FindData: TWin32FindData;
hFind: THandle;
begin
Result := -1;
hFind := FindFirstFile(PChar(FileName), FindData);
if hFind <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(hFind);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
Result := FindData.nFileSizeLow;
end;
end;
procedure SetPixel(P : PRGB; var C : Integer);
procedure SetByte(var B : Byte);
begin
if c>0 then
begin
if b<$ff then
begin
b:=b+1;
dec(c);
end;
end;
if c<0 then
begin
if b>$0 then
begin
b:=b-1;
inc(c);
end;
end;
end;
begin
SetByte(p.r);
SetByte(p.g);
SetByte(p.b);
end;
Function SaveInfoToBmpFile(BeginImage : TGraphic; Info : TArByte; Cell : Integer) : Tbitmap;
var
XP : array of PARGB;
s, i, j, k, l, c ,n, Size : integer;
bsize : array[1..5] of byte;
begin
Result:=nil;
if Cell>23 then Exit;
if Cell<2 then Exit;
Result:=TBitmap.create;
if BeginImage is TIcon then
begin
Result.Width:=BeginImage.Width;
Result.Height:=BeginImage.Height;
Result.Canvas.Draw(0,0,BeginImage);
end else
Result.Assign(BeginImage);
Result.PixelFormat:=pf24bit;
SetLength(XP,Result.Height);
for i:=0 to Result.Height-1 do
XP[i]:=Result.ScanLine[i];
Size:=Length(Info);
bsize[1]:=Cell;
bsize[2]:=Size mod 256;
Size:=Size div 256;
bsize[3]:=Size mod 256;
Size:=Size div 256;
bsize[4]:=Size mod 256;
Size:=Size div 256;
bsize[5]:=Size mod 256;
Size:=Length(Info);
n:=0;
s:=XP[0,0].r+XP[0,0].g+XP[0,0].b;
c:=Cell-s mod 24;
if s+c>254*3 then
c:=c-24;
if s+c<0 then
c:=c+24;
Repeat
SetPixel(@XP[0,0],c);
Until c=0;
for i:=0 to (Result.Height-1) div Cell-1 do
for j:=0 to (Result.Width-1) div Cell-1 do
begin
c:=0;
inc(n);
if i*((Result.Height-1) div Cell-1)+j=5 then n:=0;
for k:=i*Cell to (i+1)*Cell-1 do
for l:=j*Cell to (j+1)*Cell-1 do
if k+l<>0 then
begin
inc(c,XP[k,l].r);
inc(c,XP[k,l].g);
inc(c,XP[k,l].b);
end;
s:=c;
if i*((Result.Height-1) div Cell-1)+j>4 then
begin
if n>Size then break;
c:=Info[n]-c mod 256;
if i+j=0 then
if s+c>(Cell*Cell-1)*255*3 then
c:=c-256;
if i+j<>0 then
if s+c>(Cell*Cell)*255*3 then
c:=c-256;
if s+c<0 then
c:=c+256;
end else
begin
c:=bsize[n]-c mod 256;
if i+j=0 then
if s+c>(Cell*Cell-1)*255*3 then
c:=c-256;
if i+j<>0 then
if s+c>(Cell*Cell)*255*3 then
c:=c-256;
if s+c<0 then
c:=c+256;
end;
Repeat
for k:=i*Cell to (i+1)*Cell-1 do
for l:=j*Cell to (j+1)*Cell-1 do
if k+l<>0 then
SetPixel(@XP[k,l],c);
Until c=0;
for k:=i*Cell to (i+1)*Cell-1 do
for l:=j*Cell to (j+1)*Cell-1 do
if k+l<>0 then
begin
inc(c,XP[k,l].r);
inc(c,XP[k,l].g);
inc(c,XP[k,l].b);
end;
end;
end;
Function LoadInfoFromBitmap(Bitmap : TBitmap) : TArByte;
var
i, j, c, k, l, n, Size, Cell : integer;
XP : array of PARGB;
bsize : array[1..5] of byte;
begin
Result:=nil;
SetLength(XP,Bitmap.Height);
for i:=0 to Bitmap.Height-1 do
XP[i]:=Bitmap.ScanLine[i];
n:=0;
bsize[1]:=(XP[0,0].r+XP[0,0].g+XP[0,0].b) mod 24;
Cell:=bsize[1];
Cell:=Max(bsize[1],0);
Cell:=Min(bsize[1],24);
for i:=0 to (Bitmap.Height-1) div Cell-1 do
for j:=0 to (Bitmap.width-1) div Cell-1 do
begin
c:=0;
inc(n);
for k:=i*Cell to (i+1)*Cell-1 do
for l:=j*Cell to (j+1)*Cell-1 do
if k+l<>0 then
begin
inc(c,XP[k,l].r);
inc(c,XP[k,l].g);
inc(c,XP[k,l].b);
end;
if i*((Bitmap.Height-1) div Cell-1)+j>4 then
begin
if n>Size then Exit;
Result[n-1]:=c mod 256;
end else
begin
bsize[n]:=c mod 256;
end;
if i*((Bitmap.Height-1) div Cell-1)+j=4 then
begin
Size:=bsize[2]+bsize[3]*256+bsize[4]*256*256+bsize[5]*256*256*256;
if Size>1024*1024 then Exit;
if Size<=0 then Exit;
SetLength(Result,Min(Size,((Bitmap.Height-1) div Cell-1)*((Bitmap.width-1) div Cell-1)));
n:=0;
end;
end;
end;
Function LoadStringFromInfo(Info : TArByte) : String;
var
i : integer;
begin
Result:='';
For i:=0 to Length(Info)-1 do
Result:=Result+Char(Info[i]);
end;
Function LoadInfoFromString(Str : String) : TArByte;
var
i : integer;
begin
SetLength(Result,Length(Str));
For i:=1 to Length(Str) do
Result[i-1]:=Byte(Str[i]);
end;
Function MaxSizeInfoInGraphic(Graphic : TGraphic; Cell : Integer) : Integer;
begin
Result:=((Graphic.Height-1) div Cell-1)*((Graphic.Width-1) div Cell-1)-5;
end;
Function SaveFileToInfo(FileName : String) : TArByte;
var
fs : TFileStream;
Size : Integer;
i : integer;
begin
Result:=nil;
if not fileexists(FileName) then exit;
Size:=GetFileSizeByName(FileName);
try
fs:=Tfilestream.Create( FileName, fmOpenRead );
except
exit;
end;
fs.seek(0,soBeginning);
SetLength(Result,Size+255);
fs.Read(Pointer(Result)^,Size);
FileName:=GetFileName(FileName);
for i:=Size to Size+254 do
Result[i]:=0;
for i:=Size to Size+Min(254,Length(FileName)) do
Result[i]:=Byte(FileName[i-Size+1]);
fs.free;
end;
Function GetFileNameFromInfo(Info : TArByte) : String;
var
i, Size : integer;
begin
Result:='';
Size:=Length(Info)-256;
for i:=1 to 255 do
if Info[i+Size]<>0 then Result:=Result+Char(Info[Size+i]) else break;
end;
Procedure SaveInfoToFile(Info : TArByte; FileName : String);
var
fs:Tfilestream;
begin
try
fs:=Tfilestream.Create(filename,fmOpenWrite or fmCreate);
except
exit;
end;
fs.Write(Pointer(Info)^,Length(Info)-255);
fs.free;
end;
function GetMaxPixelsInSquare(FileName : String; Graphic : TGraphic) : integer;
var
i, FileSize : integer;
begin
FileSize:=GetFileSizeByName(FileName)+255;
for i:=3 to 23 do
begin
Result:=i;
if MaxSizeInfoInGraphic(Graphic,i)<FileSize then
begin
Result:=i-1;
break;
end;
end;
if Result<2 then Result:=-1;
end;
end.
|
Вот так можно выудить файл (ЛЮБОЙ) из битмапки: | Код |
var
Bitmap : TBitmap;
info : TArByte;
S : String;
begin
Bitmap:=TBitmap.create;
Bitmap.LoadFromFile(FileName);
info := LoadInfoFromBitmap(Bitmap);
if info=nil then Exit;
S:=GetFileNameFromInfo(info);
SaveDialog1.FileName:=s;
if SaveDialog1.Execute then
begin
SaveInfoToImage.SaveInfoToFile(info,SaveDialog1.FileName);
end;
Bitmap.Free;
end;
|
А вот так запихнуть её в битмапку: | Код |
procedure TForm1.AddFileAndSave1Click(Sender: TObject);
var
Size : Integer;
info : TArByte;
Bitmap : TBitmap;
n : integer;
o : TOpenOptions;
s : string;
begin
if Image1.Picture.Graphic=nil then
begin
OpenImage1Click(Sender);
If Image1.Picture.Graphic=nil then exit;
end;
MaxFileSize:=MaxSizeInfoInGraphic(Image1.Picture.Graphic,2)-255;
if MaxFileSize<0 then exit;
o:=OpenDialog1.Options;
Include(o,ofEnableIncludeNotify);
Exclude(o,ofOldStyleDialog);
OpenDialog1.Options:=o;
OpenDialog1.Filter:='Все файлы (Размер<'+SizeInTextA(MaxFileSize)+')|*?*';
OpenDialog1.OnIncludeItem:=OpenDialog1IncludeItem;
if OpenDialog1.Execute then
begin
FileName:=OpenDialog1.FileName;
Size:=GetFileSizeByName(FileName);
Memo1.Text:=FileName;
Label5.Caption:='Имя файла = '+SizeInTextA(Size);
S:=GetFileName(PictureFileName);
s:=GetDirectory(s)+GetFileNameWithoutExt(S)+'.bmp';
SavePictureDialog1.FileName:=s;
if SavePictureDialog1.Execute then
begin
if GetExt(SavePictureDialog1.FileName)<>'BMP' then
SavePictureDialog1.FileName:=SavePictureDialog1.FileName+'.bmp';
info:=SaveFileToInfo(FileName);
n:=GetMaxPixelsInSquare(FileName,Image1.Picture.Graphic);
if n<0 then
begin
ShowMessage('Файл слишком большой!');
exit;
end;
Bitmap:=SaveInfoToBmpFile(Image1.Picture.Graphic,info,n);
if Bitmap=nil then exit;
Bitmap.SaveToFile(SavePictureDialog1.FileName);
Bitmap.Free;
end;
end;
end;
|
|
Стеганография 
Загрузка ...
