Small modifications to the program "Import/Export BMP files" to make a program that encodes/decodes hidden information within an image.
// Yabasic 2.78, by Galileo, 02/2018
// Code adopted from IMAGE.yab (author: Hermang Hialino Mansilla Mattos, hh_mm@yahoo.com)
sub Encodegraphic(texto$, bmpfile$, dx, dy)
local fp, tmp, row, col, blue, green, red, lbtxt, ptxt, btexto$, b, cm, nblue
fp = open(bmpfile$,"rb")
if fp < 1 then
print "File ", bmpfile$, " Does not Exist"
return -1
end if
btexto$ = ConvertToBit$(texto$ + chr$(127))
lbtxt = len(btexto$)
seek #fp,18 : Width = peek(fp)+256*peek(fp)
seek #fp,22 : Height = peek(fp)+256*peek(fp)
seek #fp,28 : bpp = peek(fp)
if bpp = 24 THEN
seek #fp,54
for row = 1 to Height
FOR col = 1 to Width
blue = peek(fp)
green = peek(fp)
red = peek(fp)
if ptxt < lbtxt then
b = val(mid$(btexto$, ptxt + 1, 1))
cm = mod(blue, 2)
if b <> cm then
nblue = blue + 1
if nblue > 255 nblue = blue - 1
blue = nblue
end if
ptxt = ptxt + 1
end if
color red, green, blue
dot dx + col, dy + Height + 1 - row
NEXT col
rem adjust extra bytes
c = Width * 3
while(mod(c,4))
tmp = peek(fp)
c = c + 1
wend
next row
END IF
close fp
end sub
// Code adapted from SmallBASIC (author: Keijo Koskinen, keijoko@csolve.net)
// Ogirinal code: https://smallbasic.sourceforge.io/?q=node/40
sub SaveToBMP(bmpfile$, dx, dy, wid, hei)
local fp, row, col, xh, xl, bmkk, bmk, ero, mbtot, bml, bmll, bmh, bmhh, p$
fp = open(bmpfile$,"wb")
if fp < 1 then
print "File ", bmpfile$, " Does not create"
return -1
end if
poke #fp, dec("42") : poke #fp, dec("4D") // BM
poke #fp, 54 : poke #fp, 3 : poke #fp, 0 : poke #fp, 0 // Tamaño del archivo
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Reservado
poke #fp, 54 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Inicio de los datos de la imagen
poke #fp, 40 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Tamaño de la cabecera del bitmap
xh = int(wid / 256)
xl = wid - xh * 256
poke #fp, xl : poke #fp, xh : poke #fp, 0 : poke #fp, 0 // Anchura
xh = int(hei / 256)
xl = hei - xh * 256
poke #fp, xl : poke #fp, xh : poke #fp, 0 : poke #fp, 0 // Altura
poke #fp, 1 : poke #fp, 0 // Número de planos
poke #fp, 24 : poke #fp, 0 // Tamaño de cada punto
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Compresión
bmkk = wid * 3 // real line length
bmk = int(bmkk / 4 + .5) // but it has to be 4-bit
bmk = bmk * 4 // total length (expanded by 0 :s )
ero = bmk - bmkk // how many 0:s on the end of each line
bmtot = (bmk * hei) // +54
bml = Int(bmtot / 256)
bmll = bmtot - (bml * 256)
If bml > 256 Then
bmh = Int(bml / 256)
bml = bml - (bmh * 256)
If bmh > 256 Then
bmhh = Int(bmh / 256)
bmh = bmh - (bmh * 256)
End If
End If
poke #fp, bmll : poke #fp, bml : poke #fp, bmh : poke #fp, bmhh // Tamaño de la imagen
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Resolución horizontal
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Resolución vertical
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Tamaño de la tabla de color
poke #fp, 0 : poke #fp, 0 : poke #fp, 0 : poke #fp, 0 // Contador de colores importantes
for col = hei to 1 step -1
for row = 1 to wid
xl = dy + row
xh = dx + col
p$ = right$(getbit$(xl, xh, xl, xh), 6)
poke #fp, dec(right$(p$, 2)) // blue
poke #fp, dec(mid$(p$, 3, 2)) // green
poke #fp, dec(left$(p$, 2)) // red
next
If ero > 0 Then // if 32bit (4-byte) boundary
for xl = 1 To ero // does not match
poke #fp, 0 // rows have to be filled with zeros
next xl // to macth boundary
End If
next
close fp
end sub
sub Decodegraphic(bmpfile$, dx, dy)
local fp, row, col, tmp, blue, green, red, btexto$
fp = open(bmpfile$,"rb")
if fp < 1 then
print "File ", bmpfile$, " Does not Exist"
return -1
end if
seek #fp,18 : Width = peek(fp)+256*peek(fp)
seek #fp,22 : Height = peek(fp)+256*peek(fp)
seek #fp,28 : bpp = peek(fp)
if bpp = 24 THEN
seek #fp,54
for row = 1 to Height
FOR col = 1 to Width
blue = peek(fp)
green = peek(fp)
red = peek(fp)
btexto$ = btexto$ + str$(mod(blue, 2))
color red, green, blue
dot dx + col, dy + Height + 1 - row
NEXT col
rem adjust extra bytes
c = Width * 3
while(mod(c,4))
tmp = peek(fp)
c = c + 1
wend
next row
print ConvertToTxt$(btexto$)
end if
close fp
end sub
sub ConvertToBit$(texto$)
local btexto$, n
for n = 1 to len(texto$)
btexto$ = btexto$ + right$("000000" + bin$(asc(mid$(texto$, n, 1))), 8)
next n
return btexto$
end sub
sub ConvertToTxt$(texto$)
local n, c, r$
for n = 1 to len(texto$) step 8
c = dec(mid$(texto$, n, 8), 2)
if c = 127 break
r$ = r$ + chr$(c)
next n
return r$
end sub
open window 800, 600
backcolor 0, 0, 0
clear window
Encodegraphic("This is a test of the steganographic encryption/decryption simple code.", "Flower.bmp", 100, 100 )
SaveToBMP("prueba.bmp", 100, 100, 112, 112)
clear window
Decodegraphic("prueba.bmp")
See the original image and the codified image.