RetroBASIC

Basicprogramming(.org) => Code and examples => Topic started by: Galileo on February 25, 2018, 01:08:58 PM

Title: Steganography
Post by: Galileo on February 25, 2018, 01:08:58 PM

Small modifications to the program "Import/Export BMP files" to make a program that encodes/decodes hidden information within an image.

Code: [Select]

// 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.

Title: Re: Steganography
Post by: Galileo on February 27, 2018, 06:52:29 PM

This code is simpler and more generalist. It works reasonably well with uncompressed image and sound files.

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Simple steganographic code

EOT$ = "<END>"
gap = 29700
test$ = "This is a test of the steganographic encryption/decryption simple code."

sub Encode(texto$, file$)
local fp, fc, filesize, lbtxt, ptxt, btexto$, n, b, cm, byte, ini

fp = open(file$,"rb")
if fp < 1 then
    print "File ", file$, " Does not Exist"
    return -1
end if

fc = open("cod-" + file$,"wb")
if fc < 1 then
    print "Creation fail of ", "cod-", file$, "."
    return -1
end if

btexto$ = ConvertToBit$(texto$ + EOT$)
lbtxt = len(btexto$)
   
seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"

ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, 100) then
if ptxt < lbtxt then
b = val(mid$(btexto$, ptxt + 1, 1))
cm = mod(byte, 2)
if b <> cm then
byte = byte + 1
if byte = 256 byte = 254
end if
ptxt = ptxt + 1
end if
end if
poke #fc, byte
next n
close #fp
close #fc

end sub

sub Decode(file$)
local fp, btexto$, filesize, ini, n, byte, eom$, leom

fp = open(file$,"rb")
if fp < 1 then
    print "File ", bmpfile$, " Does not Exist"
    return -1
end if

eom$ = ConvertToBit$(EOT$)
leom = len(eom$)

seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"
ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, 100) then
        btexto$ = btexto$ + str$(mod(byte, 2))
        if right$(btexto$, leom) = eom$ break
        end if
  next n
  print ConvertToTxt$(btexto$)
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 = EOT break
r$ = r$ + chr$(c)
next n
return r$
end sub

Encode(test$, "flower.bmp")
Decode("cod-flower.bmp")

Encode(test$, "retroactive.mp3")
Decode("cod-retroactive.mp3")


Title: Re: Steganography
Post by: Galileo on February 27, 2018, 07:30:00 PM

Tested o.k. with

audio: .MP3, .OGG, .WAV
image: .TIF, .TGA, .BMP
video: .MP4, .FLV

Note: modify value of GAP variable for test with other file formats.

Title: Re: Steganography
Post by: Galileo on February 28, 2018, 06:19:08 PM

This is the version to generate an executable program. Included is a compressed file with this code, the executable for Windows, and three files for testing.

Code: [Select]

#!/usr/bin/yabasic // for Linux

// Yabasic 2.78, by Galileo, 02/2018
// Simple steganographic code

docu Mode of use for encoding: stegano.exe <carrierfile> <messagefile>
docu Example: stegano.exe flower.bmp message.txt
docu Mode of use for decoding: stegano.exe <carrierfile>
docu Example: stegano.exe cod-flower.bmp

EOT$ = "<END>"
gap = 29700


sub Encode(file$, texto$)
local fp, fc, ft, filesize, lbtxt, ptxt, btexto$, n, b, cm, byte, ini, a$

fp = open(file$,"rb")
if fp < 1 then
    print "File ", file$, " Does not Exist"
    return -1
end if

fc = open("cod-" + file$,"wb")
if fc < 1 then
    print "Creation fail of ", "cod-", file$, "."
    return -1
end if

ft = open(texto$, "r")
if ft < 1 then
    print "File ", texto$, " Does no Exist"
    return -1
end if

texto$ = ""

while(not eof(ft))
  line input #ft a$
  texto$ = texto$ + a$ + chr$(10) + chr$(13)
wend

close #ft

btexto$ = ConvertToBit$(texto$ + EOT$)
lbtxt = len(btexto$)
   
seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"

ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, 100) then
if ptxt < lbtxt then
b = val(mid$(btexto$, ptxt + 1, 1))
cm = mod(byte, 2)
if b <> cm then
byte = byte + 1
if byte = 256 byte = 254
end if
ptxt = ptxt + 1
end if
end if
poke #fc, byte
next n
close #fp
close #fc

end sub

sub Decode(file$)
local fp, btexto$, filesize, ini, n, byte, eom$, leom

fp = open(file$,"rb")
if fp < 1 then
    print "File ", bmpfile$, " Does not Exist"
    return -1
end if

eom$ = ConvertToBit$(EOT$)
leom = len(eom$)

seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"
ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, 100) then
        btexto$ = btexto$ + str$(mod(byte, 2))
        if right$(btexto$, leom) = eom$ break
        end if
  next n
  print ConvertToTxt$(btexto$)
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 = EOT break
r$ = r$ + chr$(c)
next n
return r$
end sub

arg = peek("arguments")
if arg = 1 then
Decode(peek$("argument"))
elseif arg = 2 then
Encode(peek$("argument"), peek$("argument"))
else
print "Error in calling the program."
end if

if !peek("isbound") bind "stegano.exe"


Title: Re: Steganography
Post by: jj2007 on March 01, 2018, 12:05:31 AM

Nice! For a serious implementation, one should use a lossless compression format, though, like PNG. Nobody sends uncompressed BMP files as attachments...

Title: Re: Steganography
Post by: Galileo on March 01, 2018, 04:46:51 PM

My intention at first was to explore a simple algorithm for encoding information into audio, video and image files. Of course, this is only a design concept, which, however, is already useful. Now I'm working on refining the program a little more, because I find it very fun to do so.

Title: Re: Steganography
Post by: Galileo on March 01, 2018, 07:08:08 PM

Well, as I was saying, here are the modifications and improvements. I'd like to know if anyone has tried it under Linux and how it works.

Code: [Select]

#!/usr/bin/yabasic

// Yabasic 2.78, by Galileo, 02/2018
// Simple steganographic code, v. 1.5 03/2018

docu Mode of use for encoding: stegano.exe <carrierfile> <messagefile>
docu Example: stegano.exe flower.bmp message.txt
docu Mode of use for decoding: stegano.exe <carrierfile>
docu Example: stegano.exe cod-flower.bmp

if !peek("isbound") bind "stegano.exe"

EOT$ = "<END>"
IOT$ = "<INI>"

sub Encode(file$, texto$)
local fp, fc, ft, filesize, lbtxt, ptxt, btexto$, n, b, cm, byte, ini, a$

fp = open(file$,"rb")
if fp < 1 then
    print "File ", file$, " Does not Exist"
    return -1
end if

fc = open("cod-" + file$,"wb")
if fc < 1 then
    print "Creation fail of ", "cod-", file$, "."
    return -1
end if

ft = open(texto$, "r")
if ft < 1 then
    print "File ", texto$, " Does no Exist"
    return -1
end if

texto$ = ""

while(not eof(ft))
  line input #ft a$
  texto$ = texto$ + a$ + nl$
wend

close #ft

btexto$ = ConvertToBit$(IOT$ + texto$ + EOT$)
lbtxt = len(btexto$)
   
seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"

ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, stp) then
if ptxt < lbtxt then
b = val(mid$(btexto$, ptxt + 1, 1))
cm = mod(byte, 2)
if b <> cm then
byte = byte + 1
if byte = 256 byte = 254
end if
ptxt = ptxt + 1
end if
end if
poke #fc, byte
next n
close #fp
close #fc

end sub

sub Decode(file$)
local fp, btexto$, filesize, ini, n, byte, eom$, leom, iom$, liom, sw

fp = open(file$,"rb")
if fp < 1 then
    print "File ", bmpfile$, " Does not Exist"
    return -1
end if

iom$ = ConvertToBit$(IOT$)
liom = len(iom$)
eom$ = ConvertToBit$(EOT$)
leom = len(eom$)

seek #fp, 0, "end"
filesize = tell(#fp)
seek #fp, 0, "begin"
ini = gap

for n = 1 to filesize
byte = peek(#fp)
if n >= ini and mod(n, stp) then
        btexto$ = btexto$ + str$(mod(byte, 2))
        if not sw then // Checks if the message start mark exists
        if len(btexto$) = liom then
        if btexto$ <> iom$ then
print "There is no message."
        return -1
        else
        sw = true
        end if
        end if
        end if
        if right$(btexto$, leom) = eom$ break // Checks if the message end mark exists
        end if
  next n
  print ConvertToTxt$(btexto$)
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 = EOT break
r$ = r$ + chr$(c)
next n
return r$
end sub

nl$ = chr$(10)

//if peek$("os") = "windows" nl$ = chr$(13) + nl$

arg = peek("arguments")

if arg then
arg$ = peek$("argument")
else
print "Error: no parameter found."
end
end if

ext$ = upper$(right$(arg$, len(arg$) - rinstr(arg$, ".")))

switch ext$
case "TIF":
case "TGA":
case "BMP": gap = 55 : stp = 3 : break
case "OGG":
case "MP3": gap = 100 : stp = 100 : break
case "FLV": gap = 15000 : stp = 100 : break
case "MP4": gap = 29700 : stp = 100 : break
case "MPEG": gap = 1000000 : stp = 1000 : break
case "OGV": gap = 100000 : stp = 1000 : break
case "AVI": gap = 100000000 : stp = 100000000 : break
default: gap = 100000 : stp = 100 : break
end switch

if arg = 1 then
Decode(arg$)
elseif arg = 2 then
Encode(arg$, peek$("argument"))
else
print "Error: extra parameter found."
end if

Yabasic is not particularly fast, so care should be taken to avoid large files.