// Es wird
ein Bild
(TBitmap)
in
einem anderen
(Container)
versteckt.
// Dabei muss die Anzahl der Pixel des Containers mehr als dreimal so
// hoch sein wie die Pixelanzahl des Originals. Das Container-Bild
// darf anschließend nicht bearbeitet werden, da sonst die Informationen
// verloren gehen. Die Variable "kennung" dient dabei zum Erkennen, ob
// es sich bei einem Bild auch wirklich um einen Container handelt.
// Sie kann aber auch als simples Passwort genutzt werden, ohne dessen
// Kenntnis der Laie das Bild nicht aus dem Container holen kann.
// Getestet mit D4 unter XP
// Bitmap in Bitmap verstecken
procedure BMPinBMP(original, container: TBitmap);
var
arr: array of byte;
o, x, y, z, w, b3, lg, lk, so: integer;
p: PBytearray;
kennung: string;
begin
kennung := 'BiB';
b3 := original.width * 3;
o := b3 * original.height;
lk := length(kennung);
so := sizeof(integer);
w := so * 2 + lk;
if (o > container.width * pred(container.height))
or (container.width < w)
then showmessage('Container zu klein')
else begin
setlength(arr, o + w);
x := original.width;
y := original.height;
lg := high(arr);
for z := 0 to lk - 1 do
arr[z] := ord(kennung[z + 1]);
copymemory(@arr[lk], @x, so);
copymemory(@arr[lk + so], @y, so);
z := w;
original.pixelformat := pf24bit;
for y := 0 to original.height - 1 do begin
p := original.ScanLine[y];
for x := 0 to b3 - 1 do begin
arr[z] := p[x];
inc(z);
end;
end;
container.pixelformat := pf32bit;
p := container.ScanLine[0];
for x := 0 to w - 1 do
p[x * 4 + 3] := arr[x];
z := w;
b3 := container.width * 4;
for y := 1 to container.height - 1 do begin
x := 0;
p := container.ScanLine[y];
while x < b3 do begin
if z > lg then break;
p[x + 3] := arr[z];
inc(x, 4);
inc(z);
end;
if z > lg then break;
end;
arr := nil;
end;
end;
// Bitmap aus Bitmap herausholen
procedure BMPausBMP(container, neu: TBitmap);
var
arr: array of byte;
x, y, z, b3, lg, lk, so: integer;
p: PBytearray;
kennung, v: string;
procedure falsch;
begin
showmessage('Kein oder zerstörter Container');
end;
begin
kennung := 'BiB';
lk := length(kennung);
so := sizeof(integer);
if (container.width < lk + so * 2)
or (container.pixelformat <> pf32bit)
then begin
falsch;
exit;
end;
setlength(v, lk);
setlength(arr, 2 * so + lk);
p := container.ScanLine[0];
for z := 0 to lk + 2 * so - 1 do
arr[z] := p[z * 4 + 3];
copymemory(@v[1], @arr[0], lk);
if v <> kennung then begin
falsch;
exit;
end;
copymemory(@x, @arr[lk], so);
copymemory(@y, @arr[lk + so], so);
b3 := container.width * 4;
neu.pixelformat := pf24bit;
neu.width := x;
neu.height := y;
setlength(arr, x * 3 * y);
lg := high(arr);
z := 0;
for y := 1 to pred(container.height) do begin
x := 0;
p := container.ScanLine[y];
while x < b3 do begin
if z > lg then break;
arr[z] := p[x + 3];
inc(x, 4);
inc(z);
end;
if z > lg then break;
end;
b3 := neu.width * 3 - 1;
z := 0;
for y := 0 to pred(neu.height) do begin
p := neu.scanline[y];
for x := 0 to b3 do begin
p[x] := arr[z];
inc(z);
end;
end;
arr := nil;
end;
// Beispielaufruf
// Bild von Image1 verstecken
procedure TForm1.Button2Click(Sender: TObject);
var container: TBitmap;
begin
container := TBitmap.create;
container.loadfromfile('D:\monalisa.bmp');
BMPinBMP(Image1.Picture.Bitmap, container);
container.savetofile('D:\TestContainer.bmp');
container.free;
end;
// Bild aus Versteck holen
procedure TForm1.Button3Click(Sender: TObject);
var bmp, container: TBitmap;
begin
bmp := TBitmap.create;
container := TBitmap.create;
container.loadfromfile('D:\TestContainer.bmp');
BMPausBMP(container, bmp);
canvas.draw(15, 170, bmp); // z.B.
bmp.free;
container.free;
end;
|