Модераторы: Akina

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Стеганография, Внедрение текста в картинку. 
:(
    Опции темы
Mephisto
  Дата 11.9.2003, 16:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Волкъ
***


Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: 2
Всего: 34



Цитата

Путем Pset(x,y),RGB smile.gif
А потом просто сохранить картинку smile.gif

Всё это хорошо, только через Pset(x,y),RGB рисунок не изменяется, т.е. при попытке сохранения изменений не будет sad.gif

А Cardinal'у за Sample буду очень благодарен smile.gif
PM   Вверх
cardinal
Дата 13.9.2003, 15:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99



Ну ладно приступим.
Для начало тебе нужна 24-разрядная bmp картинка размером 30x30 без сжатия. Там можно залить все, например, красный цветом. Теперь суешь вот этот кусок кода в модуль:
Код
Option Explicit

Type PALETTE
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
'   rgbReserved As Byte
End Type

Type BMPFILEHEADER
   Type As Integer
   Size As Long
   Reserved1 As Integer
   Reserved2 As Integer
   OffBits As Long
End Type

Type BMPINFOHEADER
   Size As Long
   Width As Long
   Height As Long
   Planes As Integer
   BitCount As Integer
   Compression As Long
   SizeImage As Long
   XPelsPerMeter As Long
   YPelsPerMeter As Long
   ClrUsed As Long
   ClrImportant As Long
End Type

Это всякие структуры, которые нужны, чтобы определить, что это за файл и с чем его едят.
Теперь копируешь этот код в форму:
Код
Option Explicit

Private Sub Command1_Click()

Dim fHeader As BMPFILEHEADER    ' заголовок файла
Dim iHeader As BMPINFOHEADER   ' информационный заголовок файла
'Dim Pal(256) As PALETTE              ' палитра
Dim BmpWidth As Long                  ' ширина bmp в байтах
Dim BmpHeight As Long                 ' высота bmp в точках
Dim WritePos As Long                    ' указатель для записи
Dim StringToHide As String             ' строка, которую будем прятать
Dim Jump As Long                         ' прыжок с конца строки в начало следующей
Dim Blue As Byte                           ' синий канал
Dim Green As Byte                        ' зеленый канал
Dim Red As Byte                           ' красный канал
Dim Mask(8) As Byte                    ' маска
Dim CodeLength As Long               ' строка, которую будем прятать
Dim FirstByte As Byte                    ' первый байт файла
Dim SecondByte As Byte               ' второй байт файла
Dim i As Long                                ' счетчик рядов
Dim j As Long                                ' cчетчик битов измененных в текущей строке
Dim k As Long                               ' cчетчик всех измененных битов
Dim m As Byte                              ' сдвиг маски влево

StringToHide = "cardinal"

Mask(0) = &H1       ' 00000001
Mask(1) = &H2       ' 00000010
Mask(2) = &H4       ' 00000100
Mask(3) = &H8       ' 00001000
Mask(4) = &H10     ' 00010000
Mask(5) = &H20     ' 00100000
Mask(6) = &H40     ' 01000000
Mask(7) = &H80     ' 10000000

m = 7                     ' начальное значение маски 0x80

Open App.Path & "/" & "secret.bmp" For Binary As #1

Get #1, 1, FirstByte
Get #1, 2, SecondByte

If (FirstByte <> 66) Or (SecondByte <> 77) Then
   MsgBox "Неправильный формат файла!", vbCritical, "Ошибка!"
   Close #1
   Exit Sub
End If

Get #1, 1, fHeader    ' заголовок файла
Get #1, 15, iHeader  ' информационный заголовок файла
'Get #1, 55, Pal         ' палитра
   
If iHeader.Compression <> 0 Then
   MsgBox "Ваш рисунок сжат!", vbCritical, "Ошибка!"
   Close #1
   Exit Sub
End If

If iHeader.BitCount <> 24 Then
   MsgBox "У Вас не 24-разрядный рисунок!", vbCritical, "Ошибка!"
   Close #1
   Exit Sub
End If

If iHeader.Height * iHeader.Width < Len(StringToHide) * 8 Then  ' прячем именно в картинку
   MsgBox "Вам не хватит места, чтобы спрятать весь текст!", vbCritical, "Ошибка!"
   Close #1
   Exit Sub
End If

BmpWidth = iHeader.SizeImage / iHeader.Height        ' ширина bmp картинки в байтах
BmpHeight = iHeader.Height                                      ' высота bmp картинки в точках
Jump = iHeader.Width * 3 + BmpWidth
WritePos = fHeader.OffBits + iHeader.SizeImage - BmpWidth + 1   ' начало первой строки

Dim hj As Long
CodeLength = Len(StringToHide) * 8                          ' длина кодa

Do While (i < iHeader.Height) And (k < CodeLength)
   Do While (j < iHeader.Width) And (k < CodeLength)
'        Get #1, WritePos, Blue                                     ' читаем синий канал
'        Get #1, WritePos + 1, Green                            ' читаем зеленый канал
       Get #1, WritePos + 2, Red                                ' читаем красный канал
   
       If Mask(m) And Asc(Left(StringToHide, 1)) Then            ' прячем в Red
           Red = Red Or &H1
       Else
           Red = Red And &HFE
       End If
   
'        Put #1, WritePos, Blue                                    ' записываем синий канал
'        Put #1, WritePos + 1, Green                           ' записываем зеленый канал
       Put #1, WritePos + 2, Red                               ' записываем красный канал
     
       If m = &H0 Then
           m = &H8
           StringToHide = Split(StringToHide, Left(StringToHide, 1), 2)(1)
       End If
   
       WritePos = WritePos + 3   ' идем к следующему цвету
       m = m - 1                        ' сдвиг маски влево
       k = k + 1                          ' cчетчик всех измененных битов
       j = j + 1                           ' cчетчик битов измененных в текущей строке
   Loop
   j = 0                                     ' сброс счетчика битов измененных в строке
   i = i + 1                                ' счетчик рядов
   WritePos = WritePos - Jump  ' идем в следующую строку
Loop
Close #1

End Sub

Ну а теперь можешь начинать думать над тем, как все это работает. Сделал я все по принципу, который описан на сайте, ссылку на который я написал выше. Прятал я все только в красный канал цвета, таким образом изменение цвета минимально и на глаз хоть с лупой, хоть без - ничего не увидишь. Но если с пипеткой в хорошем редакторе поизучаешь значения пикселей, то увидишь, что из чисто красного цвета получилось, что-то типа RGB(255,0,0), RGB(254,0,0), RGB(254,0,0), RGB(255,0,0) и т.д. То есть последний битик - это и есть тот битик, из которого ты лепишь Ascii-код буквы.
Вообщем самым хорошим заданием для тебя теперь является следующее:
Возьми картинку, в которую ты что-то записал и расшифруй содержание. То, что прочитаешь напиши в TextBox. Как только ты сделаешь правильную "читалку", то считай ты въехал в смысл стеганографии и организации bmp файлов.
Успехов!


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Black_Star
Дата 14.9.2003, 21:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 192
Регистрация: 9.9.2003
Где: Minsk

Репутация: 4
Всего: 4



Цитата
Black_Star, я не всегда с тобой спорю . Но с другой стороны если не спорить вообще, то значит не иметь собственного мнения. Только "спор" (то есть разные мнения на одну тему) дает возможность выбора лучшего .


Полностью с тобой согласен, друг smile.gif !
Просто иногда я в что-то так свято верю, что другие идеи меня просто бесят smile.gifsmile.gifsmile.gif

Цитата
Всё это хорошо, только через Pset(x,y),RGB рисунок не изменяется, т.е. при попытке сохранения изменений не будет 


Хе! А ты неправильно сохраняешь! Небось Savepicture Picture1.picture, "c:\..."
А надо:
1) Чтобы объект, на кот. картинка, имел AutoRedraw=true
2) Savepicture Picture1.Image,"C:\..."

и всё будет сохраняться... smile.gif
PM ICQ   Вверх
Mephisto
  Дата 15.9.2003, 16:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Волкъ
***


Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: 2
Всего: 34



Огромное спаибо Cardinal'у за Sample. Всё доходчиво расписано. thumbs-up.gif

А с этим:
Цитата

Savepicture Picture1.Image,"C:\..."


Сознаюсь withstupid.gif
Сам на Delphi`йском форуме людей поправлял.
PM   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »


 




[ Время генерации скрипта: 0.0452 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.