Hidden Text in Bitmap

Hier ist ein Beispiel, wie man sehr lange Texte in einem Bild verstecken kann, ohne dass sie sichtbar zu lesen sind. Der Code kann ihn setzen und auch wieder heraus decodieren.

Das Bild muss mindestens 24 Bit/Pixel besitzen und setzt generell ein Bitmap voraus, wobei sich auch Icons, Windows-Media-Dateien und auch Windows Enhaunced Dateien codieren lassen. 

uses ExtDlgs

private
    { Déclarations privées }
    procedure EncodeText(MyImage: TImage;MyMemo:Tmemo);
    procedure DecodeText(MyImage: TImage;MyMemo:Tmemo);
    
//

procedure TForm1.EncodeText(MyImage: TImage;MyMemo:Tmemo);

var
  x, y    : integer;
  col     : integer;
  cpt     : integer;
  R, G, B : byte;
  C       : byte;
  txt     : string;
  maxbyte : integer;
  OKformat: boolean;
begin
  txt := MyMemo.Text + #0;

  maxbyte := (MyImage.Picture.Width - 1) * (MyImage.Picture.Height - 1);
  if length(txt) > maxbyte then
    begin
      showmessage('Texte trop long');
      exit;
    end;
  OKformat := MyImage.Picture.Bitmap.PixelFormat = pf24bit;
  if not OKformat then
    begin
      showmessage('Sorry, nur 24 bit/Pixel');
      exit;
    end;
  cpt := 1;
  while cpt <= length(txt) do
    begin
      C := byte(txt[cpt]);
      x := (cpt - 1) mod MyImage.Picture.Width;
      y := (cpt - 1) div MyImage.Picture.Width;
      col := MyImage.canvas.Pixels[x, y];
      R := getRvalue(col);
      G := getGvalue(col);
      B := getBvalue(col);
      R := R and 248 or (C and 7);
      G := G and 248 or (C and 56) shr 3;
      B := B and 252 or (C and 192) shr 6;
      MyImage.Canvas.Pixels[x, y] := RGB(R, G, B);

      cpt := cpt + 1;
    end;
end;

procedure TForm1.DecodeText(MyImage: TImage;MyMemo:Tmemo);
var
  i, j    : integer;
  X, Y    : integer;
  cpt     : integer;
  R, G, B : byte;
  C       : byte;
  txt     : string;
  Ligne   : pbytearray;
  bX      : integer;
  OKformat: boolean;
begin
  MyMemo.Clear;
  txt := '';
  OKformat := MyImage.Picture.Bitmap.PixelFormat = pf24bit;
  if not OKformat then
    begin
      showmessage('Sorry, nur 24 bit/Pixel');
      exit;
    end;
  cpt := 1;
  for Y := 0 to MyImage.Height - 1 do
    begin
      Ligne := MyImage.Picture.Bitmap.ScanLine[Y];
      for X := 0 to MyImage.Width - 1 do
        begin
          bX := X * 3;
          B := ligne[bx];
          G := ligne[bx + 1];
          R := ligne[bx + 2];
          C := ((B and 3) shl 6) or ((G and 7) shl 3) or (R and 7);
          cpt := cpt + 1;
          if C = 0 then
            begin
              MyMemo.Text := txt;
              exit;
            end;
          txt := txt + chr(C);
        end;
    end;
end;

Beispiel Codieren :

procedure TForm1.Button1Click(Sender: TObject);
begin
  EncodeText(Image1, Memo1);
end;

Beispiel Decodieren :

procedure TForm1.Button1Click(Sender: TObject);
begin
  DecodeText(Image1, Memo1);
end;