Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Помогите со стегоалгоритмом

Ampleyev © (2008-04-08 21:06:00)
Помогите! уже 10 раз с книги алгоритм перебил не пашет(
Прога должна прятать текст в картинку, но после шифровки картинка умирает
Кто может помогите! зарание СПАСИБО

type
ab=array [0..3] of byte;
wordp=^word;
longp=^dword;
bytep=^byte;
abp=^ab;

var
Form1: TForm1;
fnamep,fnamet,st,sttext:string;
fipic,fopic,ftext:file;
i,j,picsize,textsize,picoffs:integer;
xb,tb,ib:byte;
xw,yw:word;
plong:longp;
pword:wordp;
pab:abp;
pp:pointer;
pb:bytep;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
picsize:=0;
textsize:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin {открыть картинку}
OpenDialog1.FileName:=''; {очистим}
if OpenDialog1.Execute then
fnamep:=OpenDialog1.FileName else exit;
try
Image1.Picture.LoadFromFile(fnamep);
except
exit; {если не открывается - на выход}
end;
assignfile(fipic,fnamep); {задали исходный файл с картинкой}
reset(fipic,1);
{проверка:}
New(pab);
seek(fipic,18); {начиная с 18-го байта - размеры}
for i:=0 to 3 do blockread(fipic,pab^[i],1);
plong:=longp(integer(pab));
picsize:=plong^; {ширина}
for i:=0 to 3 do blockread(fipic,pab^[i],1);
plong:=longp(integer(pab));
picsize:=picsize*plong^; {ширина*длину в пикселах}
seek(fipic,28); {начиная с 28-го байта - бит на пиксел, потом компрессия по два байта}
for i:=0 to 3 do blockread(fipic,pab^[i],1);
pword:=wordp(integer(pab));
xw:=pword^; {бит на пиксел}
pword:=wordp(integer(pab)+2);
yw:=pword^; {компрессия}
if (xw<8) or (yw<>0) then
begin
st:='В файле '+ExtractFileName(fnamep)+' используется сжатие'+
#10+'изображения или в нем слишком мало цветов.'+#10+
'Подберите другой BMP-файл.';
Application.MessageBox(Pchar(st),'Ошибка',mb_OK);
picsize:=0;
closefile(fipic);
exit;
end;
{проверяем размер, если текст уже открыт:}
if textsize<>0 then
begin
if (picsize*xw)<(textsize*8) then
begin
st:='Файл '+ExtractFileName(fnamep)+' имеет недостаточный размер'+
#10+'Подберите другой BMP-файл.';
Application.MessageBox(Pchar(st),'Ошибка',mb_OK);
picsize:=0;
Button3.Enabled:=False; {кнопка шифрации недоступна}
closefile(fipic);
exit;
end else Button3.Enabled:=True; {кнопка шифрации доступна}
end;
Button4.Enabled:=True; {кнопка дешифрации доступна, когда открыта картинка}
seek(fipic,10); {начиная с 10-го байта - смещение}
for i:=0 to 3 do blockread(fipic,pab^[i],1);
plong:=longp(integer(pab));
picoffs:=plong^; {в picoffs - смещение массива пикселов от начала файла}
Dispose(pab);
closefile(fipic);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin {открыть текст}
OpenDialog1.FileName:=''; {очистим}
if OpenDialog1.Execute then
fnamet:=OpenDialog1.FileName else exit;
assignfile(ftext,fnamet); {задали исходный файл с текстом}
reset(ftext,1);
textsize:=filesize(ftext);
{проверяем размер, если картинка уже открыта:}
if picsize<>0 then
begin
if (picsize*xw)<(textsize*8) then
begin
st:='Файл '+ExtractFileName(fnamet)+' слишком велик для выбранного изображения.'+
#10+'Подберите другой BMP-файл.';
Application.MessageBox(Pchar(st),'Ошибка',mb_OK);
textsize:=0;
Button3.Enabled:=False; {кнопка шифрации недоступна}
closefile(ftext);
exit;
end else Button3.Enabled:=True; {кнопка шифрации доступна}
end;
getmem(pp,textsize);
blockread(ftext,pp^,textsize,j);{прочтем текст за один прием}
for i:=0 to textsize-1 do {и переведем в строку}
begin
pb:=bytep(integer(pp)+i);
sttext:=sttext+chr(pb^);
end;
freemem(pp,textsize);
Memo1.Text:=sttext; {выведем в Memo}
closefile(ftext);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin {зашифровать текст}
assignfile(fipic,fnamep); {исходный файл с картинкой}
reset(fipic,1);
ChDir(ExtractFileDir(fnamep));{на вский случай устанавливаем папку}
assignfile(fopic,'0'+ExtractFileName(fnamep)); {имя выходного файла}
rewrite(fopic,1);
seek(fipic,picoffs); {все до picoffs игнорируем}
st:=IntToStr(length(sttext));
while length(st)<10 do st:='0'+st; {числовое поле 10 знаков}
sttext:='steganographia'+st+sttext; {добавляем сигнатуру и размер записи,
всего 24 байт заголовок}
for i:=1 to length(sttext) do {основная процедура}
begin
tb:=ord(sttext[i]); {очередной байт текста}
for j:=0 to 7 do
begin
blockread(fipic,ib,1); {очередной байт изображения}
ib:=ib and $FE; {обнуляем младщий бит изображения}
xb:=tb shr j; {сдвигаем до нужного ьита}
xb:=xb and $01; {обнуляем все, кроме младшего бита}
ib:=ib or xb; {записываем младший бит}
blockwrite(fopic,ib,1);
end;
end;
{записываем остаток сразу куском:}
j:=filesize(fipic)-filepos(fipic);
getmem(pp,j+1);
blockread(fipic,pp^,j,i);
blockwrite(fopic,pp^,i,i);
freemem(pp,j+1);
closefile(fipic);
closefile(fopic);
st:='Текст зашифрован в файле '+'0'+ExtractFileName(fnamep);
Application.MessageBox(Pchar(st),'Все отлично',mb_OK);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin {расшифровать картинку}
Memo1.Lines.Clear; {очищаем Memo}
textsize:=0; {как будто текстового файла не было}
Button3.Enabled:=False; {кнопка шифрации недоступна}
assignfile(fipic,fnamep); {исходный файл с картинкой}
reset(fipic,1);
seek(fipic,picoffs); {все до picoffs игнорируем}
st:='';
for i:=1 to 24 do {чтение заголовка}
begin
tb:=0;
for j:=0 to 7 do
begin
blockread(fipic,ib,1); {очередной байт изображения}
ib:=ib and $01;{обнуляем все, кроме младшего бита}
ib:=ib shl j; {сдвигаем до нужного бита}
tb:=tb or ib; {записываем младший бит}
end;
st:=st+chr(tb); {очередной байт заголовка}
end;
if pos('steganographia',st)=0 then {если там нет информации}
begin
st:='В файле '+ExtractFileName(fnamep)+' отсутствует текст.';
Application.MessageBox(Pchar(st),'Ошибка',mb_OK);
exit;
end;
delete(st,1,14);
j:=StrToIntDef(st,0); {извлекаем длину}
if j=0 then
begin
st:='В файле '+ExtractFileName(fnamep)+' длина сообщения равна 0.';
Application.MessageBox(Pchar(st),'Ошибка',mb_OK);
exit;
end;
sttext:='';
for i:=1 to j do {чтение сообщения}
begin
tb:=0;
for j:=0 to 7 do
begin
blockread(fipic,ib,1); {очередной байт изображения}
ib:=ib and $01;{обнуляем все, кроме младшего бита}
ib:=ib shl j; {сдвигаем до нужного бита}
tb:=tb or ib; {записываем младший бит}
end;
sttext:=sttext+chr(tb); {очередной байт сообщения}
end;
Memo1.Text:=sttext; {выведем в Memo}
closefile(fipic);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin {очистить текст}
Memo1.Lines.Clear;
textsize:=0;
Button3.Enabled:=False; {кнопка шифрации недоступна}
end;

end.

sniknik (2008-04-08 22:20:00) [1]
спам

Сергей М, (2008-04-08 21:43:00) [2]

> Кто может помогите!

Чем же помочь тебе, убогий ?

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »