BorlandTalk.com

Bob Dalton · Guest

Has anyone implemented steganography cryptography in Delphi? If so can you
point me to where I can find out the Delphi source code for how to do it (or
a VCL)?

After reading about this is would seem on the face of it a better way to
distribute an unlock code for my products. The code would be embedded in the
24 bit jpg image and the customer would download the image, place it in the
directory where the product is, and the product would decode the image to
read the key. Pitfalls?

I found some old Turbo Pascal code on how to do this for a BMP image and you
can see it below. I am hjoping that someone has done somthing similar in
Delphi.....

Regards;

Bob Dalton

----------------------------------------------------------------------------
-----------
{***************************************************************************
}
{* Name : EncBMP.Pas
*}
{* Uses : Can encode/decode a binnary into/from a 24-bit .BMP file
*}
{* Author : Punkroy (punkroy (AT) dr (DOT) com)
*}
{* Date : 5/11/1999
*}
{* Revisions :
*}
{* v1.00 - 9/30/1998 - ?¨? - Initial concept and design coded
*}
{* v2.00 - 5/11/1999 - ?¨? - Initial coding began
*}
{* v3.00 - 7/21/1999 - OI! - Version 3; uses key expantion method from
*}
{* the "Cypher" project.
*}
{* v3.1 - 10/20/1999 - OI! - Added updated Cypher engien (v2.6.2)
*}
{* v3.2 - 8/21/2001 - OI! - Updated with multi-algorithm suport
*}
{*
*}
{* Version 3.2 notes :
*}
{* The changes to the Cypher project for multipal algorithms made it
*}
{* nessary to update this project. Only one algorithm is avalibal for use
*}
{* in any build. Adding the ability to select makes it posibal to
*}
{* pridict or detect the presents of encrypted data in a file.
*}
{* I havn't touched this project in 3 years, and I'm still pleased at
*}
{* how well data gets hidden in a BMP. Lots of room in a true color
*}
{* bitmap - Smile

*}
{*
*}
{* Version 3.1 notes :
*}
{* Changes made were very basic. Made things a bit easier to share
*}
{* with the "Cypher" project.
*}
{*
*}
{* Version 1.00 was a test version that could only encode 6-bit text
*}
{* messages into a .BMP. All code has been re-written sence then (hence
*}
{* version 2.00).
*}
{*
*}
{* How data inside the BMP is encoded :
*}
{* Each byte (8-bits) of data that gets encoded into the BMP takes 2
*}
{* 24-bit RGB pixels (3 bytes).
*}
{*
*}
{* Red Green Blue
*}
{* 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
*}
{* R R R R R R R R G G G G G G G G B B B B B B B B
*}
{*
*}
{* ³ ³ ³ ³
*}
{* ÀÄÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÙ ³ ³
*}
{* ³ ³ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
*}
{* ³ ³ ³ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
*}
{* ³ ³ ³ ³
*}
{* ³ ³ ³ ³
*}
{*
*}
{* 4 5 6 7 (Upper nibble)
*}
{* 0 1 2 3 (Lower nibble)
*}
{*
*}
{* The upper nibble is saved in the first pixel followed by the lower
*}
{* nibble in the second pixel. This degrades color quality of a 24-bit
*}
{* BMP to 21-bits (from 16.8 million colors to 2 million). Sence the
*}
{* data encoded into the BMP is stored at the least significant bits, no
*}
{* real noticibal change can be seen in "real life" photos when the
*}
{* message is added.
*}
{*
*}
{* Encryption is used to prevent others using this program to extract
*}
{* encoded data without a key. The encryption used is ARC4, which is a
*}
{* well tested and very sucure stream cipher. To make more sucure use of
*}
{* this algorithm, a key expantion system is implimented. This involves
*}
{* adding random data to the begining of the key and then using a message
*}
{* degest algorithm to produce a lengthened key. The random data appened
*}
{* to the begining of the key is saved in the file and is diffrent for
*}
{* every file. The message digest algorithm used is MD5 (see MD5_UNIT.PAS
*}
{* for more information). The comination of these two expantion methods
*}
{* lessons the change of a key being abtained through an atack on the
*}
{* encryption becouse the message digest is one way and even if the key
*}
{* used for the ARC4 encryption is found, the orignal key can not be drived
*}
{* from the hashed key used for the ARC4 encryption.
*}
{* The key expantion methods used here are not all that great, but they
*}
{* will slow an atack down. As with most of my software, this program was
*}
{* written for educational purposes. This idia is to give an example of
*}
{* how one can impliment this concept.
*}
{*
*}
{* Things still not added :
*}
{* - Some I/O checking on disk read/writes is not present
*}
{* - Decode process is rather slow
*}
{*
*}
{***************************************************************************
}
uses
Crt ,
Dos ,
KeyUnit ,
SuportUnit ,
RandomDataUnit ,
CRC_Unit ,
Algorithms ,
HashUnit ,
StreamCipherUnit;

const
Version = '3.2';
SubVersion = '';

DefaultHash = 'SHA-1';
DefaultCipher = 'ISAAC';

IsUseEncryption = True;

{---------------------------------------------------------------------------
}
{ Disk
}
{---------------------------------------------------------------------------
}
const
MaxBufferSize = $FFF;
var
Buffer : array[ 0..MaxBufferSize ] of byte;
InBuffer : array[ 0..MaxBufferSize ] of byte;

{---------------------------------------------------------------------------
}
{ Header
}
{---------------------------------------------------------------------------
}
const
HeaderID = 'HID' + Version;

type
EncryptedFileInformation = record
ID : array[ 1..Length( HeaderID ) ] of char;
Name : string[ 12 ];
Size : longint;
end;

FileInformation = record
SaltValue : SaltValueType;
Info : EncryptedFileInformation;
end;

var
FileInfo : FileInformation;
Hash : PHashClass;
Cipher : PStreamCipherClass;

{===========================================================================
}
{ Function to encode binnary file into a
}
{===========================================================================
}
procedure Encode( const InputFileName , OutputFileName , BinFileName :
string );
type
FileNameType = record
Dir : DirStr;
Name : NameStr;
Ext : ExtStr;
end;

var
InputFile : file;
OutputFile : file;
BinFile : file;

x , y : word;

InputIndex : word;
InputCount : word;
PixelIndex : word;
PixelCount : word;

IsEOF : boolean;
NumRead : word;
NibbleHi : byte;
NibbleLo : byte;

FileName : FileNameType;

Key : string;
ConfermKey : string;
KeyArray : HashType;

begin
{ Assign files }
Assign( InputFile , InputFileName );
Assign( OutputFile , OutputFileName );
Assign( BinFile , BinFileName );

{ Open/create all working files }

{$I-} Reset( InputFile , 1 ); {$I+}
if IOResult <> 0 then
begin
WriteLn( 'Can not open : ' , InputFileName );
Halt( 1 );
end;

{$I-} Reset( BinFile , 1 ); {$I+}
if IOResult <> 0 then
begin
WriteLn( 'Can not open : ' , BinFileName );
Halt( 1 );
end;

{$I-} Rewrite( OutputFile , 1 ); {$I+}
if IOResult <> 0 then
begin
WriteLn( 'Can not create : ' , OutputFileName );
Halt( 1 );
end;

{ Prepare header }
with FileInfo.Info do
begin
with FileName do
FSplit( FExpand( BinFileName ) , Dir , Name , Ext );

ID := HeaderID;
Name := FileName.Name + FileName.Ext;
Size := FileSize( BinFile );

if Size = 0 then
begin
WriteLn( 'There is nothing in : ' , BinFileName , '; File
size = 0.' );
Halt( 1 );
end;
end;

{ Read .BMP header }
BlockRead( InputFile , Buffer , 54 );
BlockWrite( OutputFile , Buffer , 54 ); { <- Send header to output
file }

{ Check to see if BMP is 24-bit }
if Buffer[ 28 ] <> 24 then
begin
WriteLn( 'BMP file is not 24-bit!' );
Halt( 1 );
end;

{ Get size of image }
x := WORD( Buffer[ 18 ] ) + ( WORD( Buffer[ 19 ] ) shl 8 );

{ Aline X 32-bits }
while ( ( x mod 4 ) <> 0 ) do
Inc( x );

y := WORD( Buffer[ 22 ] ) + ( WORD( Buffer[ 23 ] shl 8 ) );

{ Check to be sure .BMP is large enough for encoding. Encoding }
{ requieres 2 pixels (6 bytes) for ever byte to encode. }
if ( LONGINT( x ) * LONGINT( y ) ) < ( FileInfo.Info.Size * 2 ) then
begin
WriteLn( 'Not enough pixels in file to encode data!' );
WriteLn( '.BMP file must contain 2 pixels for every byte of data
to encode.' );
Halt( 1 );
end;

IsEOF := False;
PixelCount := 0;
PixelIndex := 0;

{ Get key for encryption }
WriteLn( 'Enter key : ' );
Key := GetKey;

{ Get key again for conformation }
WriteLn( 'Conferm key : ' );
ConfermKey := GetKey;

{ Abort if keys don't match }
if ConfermKey <> Key then
begin
WriteLn( 'Keys do not match.' );
Halt( 1 );
end;

{ Kill 'ConfermKey' }
FillChar( ConfermKey , SizeOf( ConfermKey ) , 0 );

{ Expand key }
CreateExpandedKey( FileInfo.SaltValue , Key , KeyArray , Hash );

{ Start cipher }
Cipher^.PrepareKey( KeyArray^ , Hash^.OutputSize );

{ Kill key and key array }
FillChar( Key , SizeOf( Key ) , 0 );
FillChar( KeyArray , SizeOf( KeyArray ) , 0 );

{ Encrypt sencitive file information }
if IsUseEncryption then
begin
Move( FileInfo.Info , Buffer , SizeOf( FileInfo.Info ) );
Cipher^.CipherBlock( Buffer , SizeOf( FileInfo.Info ) );
Move( Buffer , FileInfo.Info , SizeOf( FileInfo.Info ) );
end;

{ Use 'FileInfo' as initial input to store into file }
Move( FileInfo , InBuffer , SizeOf( FileInfo ) );

{ Set initial count so header information is put into the file }
InputIndex := 0;
InputCount := SizeOf( FileInfo );

{ Encoding loop }
repeat
{ Need more pixels? }
if ( PixelCount <= ( 3 * 2 ) ) then
begin
{ Read one horizontal line }
BlockRead( InputFile , Buffer , ( x * 3 ) , NumRead );

PixelIndex := 0;
PixelCount := NumRead;
end;

{ Is more data to encode needed? }
if ( InputCount = 0 )
and not IsEOF then
begin
{ Get next block of data to encode }
BlockRead( BinFile , InBuffer , SizeOf( InBuffer ) ,
InputCount );

{ Encrypt data }
if IsUseEncryption then
Cipher^.CipherBlock( InBuffer , InputCount );

{ Start at index 0 }
InputIndex := 0;

{ If the end of the data to encode's file }
if EOF( BinFile ) then
begin
IsEOF := True;
Close( BinFile );
end;
end;

{ Is there data to encode? }
if InputCount = 0 then
PixelCount := 0 { <- If there is no data to encode }
else
while ( InputCount > 0 )
and ( PixelCount >= ( 3 * 2 ) ) do
begin
{ * Here is the break down and encoding process * }

{ Get the upper and lower nibble of data to be encoded }
NibbleHi := InBuffer[ InputIndex ] shr 4;
NibbleLo := InBuffer[ InputIndex ] and $F;

{ Encode the two nibbles into pixels as decribed in the }
{ header comments }

{ Pixel 0 }
{ Blue; 2 bits }
Buffer[ PixelIndex + 0 ] :=
( Buffer[ PixelIndex + 0 ] and not $3 )
or ( NibbleHi shr 2 );

{ Green; 1 bit }
Buffer[ PixelIndex + 1 ] :=
( Buffer[ PixelIndex + 1 ] and not $1 )
or ( ( NibbleHi shr 1 ) and $1 );

{ Red; 1 bit }
Buffer[ PixelIndex + 2 ] :=
( Buffer[ PixelIndex + 2 ] and not $1 )
or ( NibbleHi and 1 );

{ Pixel 1 }
{ Blue; 2 bits }
Buffer[ PixelIndex + 3 ] :=
( Buffer[ PixelIndex + 3 ] and not $3 )
or ( NibbleLo shr 2 );

{ Green; 1 bit }
Buffer[ PixelIndex + 4 ] :=
( Buffer[ PixelIndex + 4 ] and not $1 )
or ( ( NibbleLo shr 1 ) and $1 );

{ Red; 1 bit }
Buffer[ PixelIndex + 5 ] :=
( Buffer[ PixelIndex + 5 ] and not $1 )
or ( NibbleLo and 1 );

{ Modify pixel buffer index and counter }
Inc( PixelIndex , ( 3 * 2 ) );
Dec( PixelCount , ( 3 * 2 ) );

{ Modify input buffer index and counter }
Inc( InputIndex );
Dec( InputCount );
end;

{ Put horizontal line with or without encoded text into
tput }
{ file. Only do this when all pixels have been
}
{ NOTE: This point is usualy reached when more pixels are
needed }
{ but it is also reached when more data to encode into
}
{ pixels is
}
if PixelCount = 0 then
BlockWrite( OutputFile , Buffer , NumRead );

until ( NumRead = 0 )
or KeyPressed;

{ Erase sencitive data }
Cipher^.Finish;

Close( InputFile );
Close( OutputFile );
end;

{===========================================================================
}
{ Function to extract a binnary file from a .BMP (assuming .BMP has had
}
{ binnary file encoded into
}
{===========================================================================
}
procedure Decode( const InputFileName : string );
var
InputFile : file;

{ Gets a buffer of bytes from pixels }
procedure Extract( var Buffer : array of byte; BufferSize : word );
var
Index : word;
ByteArray : array[ 0..5 ] of byte;

NibbleHi : byte;
NibbleLo : byte;
begin
{ For all data to get }
for Index := 0 to ( BufferSize - 1 ) do
begin
{ Read two pixels }
BlockRead( InputFile , ByteArray , 6 );

{ Extract high and low nibbles }
NibbleHi := ( ( ByteArray[ 0 ] and $3 ) shl 2 )
or ( ( ByteArray[ 1 ] and $1 ) shl 1 )
or ( ByteArray[ 2 ] and $1 );

NibbleLo := ( ( ByteArray[ 3 ] and $3 ) shl 2 )
or ( ( ByteArray[ 4 ] and $1 ) shl 1 )
or ( ByteArray[ 5 ] and $1 );

{ Concatnate nibbles and store in buffer }
Buffer[ Index ] := ( NibbleHi shl 4 ) or NibbleLo;
end;
end;

var
OutputFileName : string;
OutputFile : file;

x , y : word;

NumToRead : word;
Count : word;

Key : string;
KeyArray : HashType;

ch : char;
begin
Assign( InputFile , InputFileName );
{$I-} Reset( InputFile , 1 ); {$I+}
if IOResult <> 0 then
begin
WriteLn( 'Unable to open : ' , InputFileName );
Halt( 1 );
end;

{ Read .BMP header }
BlockRead( InputFile , Buffer , 54 );

{ Get size of image }
x := WORD( Buffer[ 18 ] ) + ( WORD( Buffer[ 19 ] ) shl 8 );

{ Aline X 32-bits }
while ( ( x mod 4 ) <> 0 ) do
Inc( x );

y := WORD( Buffer[ 22 ] ) + ( WORD( Buffer[ 23 ] shl 8 ) );

{ Get file information }
Extract( Buffer , SizeOf( FileInfo ) );
Move( Buffer , FileInfo , SizeOf( FileInfo ) );

{ Get encryption key }
WriteLn( 'Enter key : ' );
Key := GetKey;

{ Expand key }
ExpandKey( FileInfo.SaltValue , Key , KeyArray , Hash );

{ Prepare key }
Cipher^.PrepareKey( KeyArray^ , Hash^.OutputSize );

{ Kill key }
FillChar( Key , SizeOf( Key ) , 0 );
FillChar( KeyArray , SizeOf( KeyArray ) , 0 );

{ Decrypt file information }
if IsUseEncryption then
begin
Move( FileInfo.Info , Buffer , SizeOf( FileInfo.Info ) );
Cipher^.CipherBlock( Buffer , SizeOf( FileInfo.Info ) );
Move( Buffer , FileInfo.Info , SizeOf( FileInfo.Info ) );
end;

with FileInfo.Info do
begin
{ Check file ID }
if ID <> HeaderID then
begin
WriteLn( 'Error. Header does not match.' );
WriteLn( 'Ether there is no encrypted information in this
file or' );
WriteLn( 'the key has been entered incorrectly.' );
Halt( 1 );
end;

{ Display and conferm file information }
WriteLn( 'File name : ' , Name );
WriteLn( 'File size : ' , Size );

{ Conferm file information }
WriteLn( 'Is this correct? (Y/N)' );
if UpCase( GetChar ) <> 'Y' then
begin
WriteLn( 'Aborted.' );
Halt( 1 );
end;
end;

{ Check for existance for output file }
OutputFileName := FExpand( FileInfo.Info.Name );
repeat
Assign( OutputFile , OutputFileName );
{$I-} Reset( OutputFile , 1 ); {$I+}

{ If file exists }
if IOResult = 0 then
begin
{ Overwrite prompt }
WriteLn( 'File already exists; Overwrite it? (Y/N)' );
ch := UpCase( ReadKey );

{ If not to over write, alow new name to be selected }
if ch = 'N' then
begin
{ Prompt for new name }
WriteLn( 'Enter new name for file <Empty line to abort>
: ' );
ReadLn( OutputFileName );

{ Abort on null entry }
if OutputFileName = '' then
begin
WriteLn( 'Aborted.' );
Halt( 1 );
end;

end;

end
else
ch := 'Y'; { <- Used to pass the 'repeat until' loop }

until ch = 'Y';

{ Create output file }
{$I-} Rewrite( OutputFile , 1 ); {$I+}
if IOResult <> 0 then
begin
WriteLn( 'Unable to create : ' , OutputFileName );
Halt( 1 );
end;

{ Begin extraction loop }
Count := FileInfo.Info.Size;
while Count > 0 do
begin
{ Select size to extract; Max buffer size or bytes remaining }
if Count > SizeOf( Buffer ) then
NumToRead := SizeOf( Buffer )
else
NumToRead := Count;

{ Get data from pixels }
Extract( Buffer , NumToRead );

{ Decrypt data }
if IsUseEncryption then
Cipher^.CipherBlock( Buffer , NumToRead );

{ Write data to output file }
BlockWrite( OutputFile , Buffer , NumToRead );
Dec( Count , NumToRead );
end;

{ Erase sencitive data }
Cipher^.Finish;

Close( InputFile );
Close( OutputFile );
end;

procedure Syntext;
begin
WriteLn( 'Syntext :
' );
WriteLn( ' ENCBMP -e <BMP File> <Out BMP file> <Binnary file>
' );
WriteLn( ' ENCBMP -u <Encoded BMP File>
' );
WriteLn( 'Encode (-e)
' );
WriteLn( ' BMP File - A 24-bit .BMP file
' );
WriteLn( ' Out BMP File - .BMP file that gets ''Binnary file'' encoded
into it ' );
WriteLn( ' Binnary file - A file to encode into ''BMP File''
' );
WriteLn( 'Unencode (-u)
' );
WriteLn( ' Encoded BMP File - .BMP file with encoded binnary file in it
' );
WriteLn;
WriteLn( 'For more information, see README.TXT included with this
archive ' );
WriteLn;
end;

{===========================================================================
}
{
}
{===========================================================================
}
var
Parm , Parm2 , Parm3 , Parm4 : string;
Index : byte;

IsEncode , IsDecode : boolean;
begin
WriteLn( 'Encode to BMP version ' , Version , SubVersion );
WriteLn( '(C) 1999/2001 by Punkroy = Sad

' );
WriteLn;

{ Locate algorithms }
Hash := FindHash( DefaultHash );
Cipher := FindStreamCipher( DefaultCipher );

{ Check for compile errors }
if Hash = Nil then
begin
WriteLn( 'COMPILE ERROR: Default hash algorithm not included.' );
Halt( 2 );
end;

if Cipher = Nil then
begin
WriteLn( 'COMPILE ERROR: Default encryption algorithm not
included.' );
Halt( 2 );
end;

if IsUseEncryption then
begin
WriteLn( 'Useing ' ,
Cipher^.Name , ' encryption with ' ,
Hash^.Name , ' Message-Digest for key expantion.' );

WriteLn( Hash^.OutputSize , '-bit key' );

WriteLn;
end;

{ No paramters }
if ParamCount = 0 then
begin
Syntext;
Halt( 1 );
end;

{ Initilize default settings }
IsEncode := False;
IsDecode := False;

{ Get parameters }
Parm := ParamStr( 1 );
if ( Parm[ 1 ] = '-' )
or ( Parm[ 1 ] = '/' ) then
begin
{ Loop for all parameters }
for Index := 2 to Length( Parm ) do
case UpCase( Parm[ Index ] ) of
'E' : IsEncode := True;
'U' : IsDecode := True;

'H' ,
'?' : begin
Syntext;
Halt;
end
else
WriteLn( 'Not an option : ' , Parm[ Index ] );
Halt( 1 );
end;
end;

{ Check for imposibility }
if IsEncode and IsDecode then
begin
WriteLn( 'You can not encode and decode at the same time!' );
Halt( 1 );
end;

if IsEncode then
begin
{ * Get file names * }

if ParamCount >= 2 then
Parm2 := ParamStr( 2 )
else
begin
WriteLn( 'Enter .BMP file name to encode file into : ' );
ReadLn( Parm2 );
end;

if ParamCount >= 3 then
Parm3 := ParamStr( 3 )
else
begin
WriteLn( 'Enter .BMP file name to output to : ' );
ReadLn( Parm3 );
end;

if ParamCount >= 4 then
Parm4 := ParamStr( 4 )
else
begin
WriteLn( 'Enter binnary file name to encode file into .BMP :
' );
ReadLn( Parm4 );
end;

{ Do it! }
Encode( Parm2 , Parm3 , Parm4 );
end
else
if IsDecode then
begin
{ Get file name }
if ParamCount >= 2 then
Parm2 := ParamStr( 2 )
else
begin
WriteLn( 'Enter name of .BMP with encoded binnary file : ' );
ReadLn( Parm2 );
end;

{ Do it! }
Decode( Parm2 );
end
else
begin
{ If nothing happened }
WriteLn( 'Nothing to do!' );
Halt( 1 );
end;
end.

Bob Dalton · Guest

After posting the message I found a Delphi project which involves "Digital
Watermarking" at:

http://www.partow.net/projects/watermarking/index.html

Not sure if this does what I asked about but passing it on for those who
might be interested and it comes with all source code...

Regards;

Bob Dalton

Arash Partow · Guest

Hello Bob,

I wrote the code, its basically a simple implementation
of the Wong algorithm, which is watermarking/stego based
on LSBs of pixels.

If you have any more questions feel free to e-mail me.

Arash Partow

__________________________________________________
Be one who knows what they don't know,
Instead of being one who knows not what they don't know,
Thinking they know everything about all things.
http://www.partow.net

"Bob Dalton" <bob.dalton (AT) removeme_digitallogistics (DOT) com> wrote