Steganography for VBA

[Rabbit]

Description
Steganography is the act of hiding a message in plain sight.

How Steganography Works
One popular implementation is to take an existing image file and manipulate the bits to hide a message without noticeably changing the image or increasing the size. It does this by taking each byte that represents a color in a pixel and changing only the last bit.

An uncompressed bitmap file uses three to four bytes to represent each pixel in the image. One for red, one for green, one for blue, and an optional one for alpha. To hide a single ascii character would take 8 bytes. Changing only the last bit of each color ensures that the change is so slight that the human eye would not notice the change in color from picture to picture.

Sample Implementation of Steganography
The following code implements the above example. It only works on uncompressed bitmap images.

Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim oldFile, newFile, oFS, iSize, strMessage, i, ch, strPath
strPath = InputBox("File Path of Bitmap File:")
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oldFile = oFS.OpenTextFile(strPath, ForReading)

If InputBox("1 for encode, 2 to decode") = 1 Then
	Set newFile = oFS.OpenTextFile(Replace(strPath, ".bmp", "-e.bmp"), ForWriting, True)
	iSize = (oFS.GetFile(strPath).Size \ 8) - 1

	Do
		strMessage = InputBox("Enter your message. The maximum number of characters is " & iSize & ".")
	Loop Until Len(strMessage) <= iSize
	
	newFile.Write(oldFile.Read(10))
	
	ch = oldFile.Read(1)
	newFile.Write(ch)
	iSize = Asc(ch)
	
	ch = oldFile.Read(1)
	newFile.Write(ch)
	iSize = iSize + Asc(ch) * 256
	
	ch = oldFile.Read(1)
	newFile.Write(ch)
	iSize = iSize + Asc(ch) * 65536
	
	ch = oldFile.Read(1)
	newFile.Write(ch)
	iSize = iSize + Asc(ch) * 16777216
	
	newFile.Write(oldFile.Read(iSize - 14))
	
	For i = 1 To Len(strMessage)
		ch = Asc(Mid(strMessage, i, 1))
		
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 128) \ 128)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 64) \ 64)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 32) \ 32)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 16) \ 16)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 8) \ 8)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 4) \ 4)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 2) \ 2)))
		newFile.Write(Chr((Asc(oldFile.Read(1)) And 254) Or ((ch And 1) \ 1)))
	Next
	
	For i = 1 To 8
		newFile.Write(Chr(Asc(oldFile.Read(1)) And 254))
	Next
	
	Do Until oldFile.AtEndOfStream
		newFile.Write(oldFile.Read(1024))
	Loop

	newFile.Close
	Set newFile = Nothing
	
	MsgBox "Message Encoded!"
Else
	i = 0
	ch = 0
	strMessage = ""

	oldFile.Read(10)
	iSize = Asc(oldFile.Read(1))
	iSize = iSize + Asc(oldFile.Read(1)) * 256
	iSize = iSize + Asc(oldFile.Read(1)) * 65536
	iSize = iSize + Asc(oldFile.Read(1)) * 16777216
	oldFile.Read(iSize - 14)
	
	Do Until oldFile.AtEndOfStream
		i = i + 1
		ch = ch Or ((Asc(oldFile.Read(1)) And 1) * (2 ^ (8 - i)))
		
		If i = 8 Then
			strMessage = strMessage & Chr(ch)
			If ch = 0 Then
				Exit Do
			Else
				ch = 0
				i = 0
			End If
		End If
	Loop
	
	MsgBox strMessage
End If

oldFile.Close
Set oldFile = Nothing
Set oFS = Nothing

[twinnyfo]

Thanks, Rabbit! I always wondered how they did that... Now we all can be super secret squirrels!

[Frinavale]

I remember reading about the history of Steganography.. .

I remember one of the first usages of it.

There was of a slave who had their head shaved. A message tattooed to their scalp and their hair was left to grow back in. Once the hair was back, the slave was was sent to deliver the message.