Text aus Bild auslesen

[TobiTomate]

Halli Hallo!

Wir befassen uns in der Schule derzeit mit Bitmanipulation und ich hab gerade keine Idee, wie ich mein Problem lösen soll.
Aufgabe ist es, eine .txt Datei in ein Memo zu laden, den Inhalt in Binärcode umzuwandeln, diesen in einem Bild (.bmp) "verstecken" und dann wieder auslesen zu können. Ich komm einfach nicht darauf, wie ich den Text wieder auslesen kann.

Wäre nett, wenn ich mit helfen könnt.

Gruß Tobi

Achso, hier noch mein Quellcode, hätte den beinahe vergessen

Delphi-Quellcode:

var
  Form1: TForm1;
  eingabeT, ausgabeT : string; //Eingabetext, Ausgabetext

implementation

{$R *.dfm}

function CharToBin(AChar : char): string;
var
  I: Integer;
begin
  SetLength(result, 8);
  for I := 1 to 8 do
  begin
    if (Byte(AChar) shr (8-i)) and 1 = 0 then
      result[i] := '0'
    else
      result[i] := '1';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenTextFileDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenTextFileDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject); //Leerzeichen entfernen
begin
Memo1.Text:=StringReplace(Memo1.Text,' ','',[rfReplaceAll]);
end;

procedure TForm1.Button3Click(Sender: TObject); //Eingabetext umwandeln
var I, eingabeL : integer; //eingabeL = Länge des Eingabetextes
begin
Memo2.Clear;
eingabeT:=Memo1.Text;
eingabeL:=Length(Memo1.Text);
ausgabeT:='';
for I := 1 to eingabeL do
  begin
    ausgabeT:= ausgabeT + CharToBin(eingabeT[I]);
  end;
ausgabeT:= ausgabeT + '00000100'; //Abbruchbedingung anhängen
while length(ausgabeT) mod 3 <> 0 do //Prüfen, ob durch 3 teilbar
ausgabeT:= ausgabeT + '0';
Memo2.Lines.Add(ausgabeT);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if SaveTextFileDialog1.Execute then
Memo2.Lines.SaveToFile(SaveTextFileDialog1.FileName+'.txt');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button7Click(Sender: TObject); //Text im Bild verstecken
var Kx,Ky : integer; // Kx/Ky = Koordinate x/y
    farbe : longint;
    R,G,B : byte;
begin
  for Ky := 0 to Image1.Picture.Height - 1 do
    begin
      for Kx := 0 to Image1.Picture.Width - 1 do
        begin  
          if ausgabeT <> '' then
          begin
            farbe:= colortorgb(Image1.Canvas.Pixels[Kx,Ky]);
            R:= GetRValue(farbe);
            G:= GetGValue(farbe);
            B:= GetBValue(farbe);
            R:= R shr 1 shl 1;
            R:= R + StrToInt(ausgabeT[1]);
            G:= G shr 1 shl 1;
            G:= G + StrToInt(ausgabeT[2]);
            B:= B shr 1 shl 1;
            B:= B + StrToInt(ausgabeT[3]);
            Image1.Canvas.Pixels[Kx,Ky]:=RGB(R,G,B);
            Delete(ausgabeT,1,3);
          end
          else
            exit;
        end;
    end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
if SavePictureDialog1.Execute then
Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
end;

end.

Meine Variablennamen sind auch nicht gerade der Brüller, aber so weiß ich wenigstens, wofür die sind.

[BUG]

Was genau macht denn dein Quelltext? Wenn du das weißt, solltest du dir überlegen, wie du das andersherum machen kannst.

Aktuell machst du:

1. Text in Bitfolge umwandeln
2. Bitfolge in Bild speichern

Die dementsprechend musst du nun:

1. Bitfolge aus dem Bild extrahieren
2. Bitfolge in Text umwandeln

Das alles sollte besser funktionieren, wenn du mit Bitmasken arbeitest und nicht nur mit arithmetischen Operationen und Schiebeoperationen. Hier gibt es ein Tutorial.

PS: Es gibt übrigens einige Themen zu Steganographie, da kannst du dich auch inspirieren lassen.


EDIT: Fast vergessen: Herzlich Willkommen in der DP

[TobiTomate]

Vielen Dank für deine schnelle Antwort und deine nette Begrüßung.

Der Tipp mit den Bitsmasken ist zwar durchaus hilfreich und ich werde mich auch in naher Zukunft mit ihnen beschäftigen, aber aufgrund von Zeitmängeln werde ich weiterhin meine bisherige Vorgehensweise verwenden und so wie du es mir dargestellt hast, hab ichs noch gar nicht betrachtet.

Ich werde mich demnächst nochmal melden und dich über meine Fortschritte in Kenntnis setzten.

Tobi

PS: Der Fachbegriff ist also Steganographie, danke auch dafür.

[Elexarie]

Ich hänge gerade an einem ähnlichen Problem:

Folgender Quellcode:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, ExtCtrls, unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    Image1: TImage;
    Button3: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button4: TButton;
    SavePictureDialog1: TSavePictureDialog;
    Button5: TButton;
    procedure Button2Click(Sender: TObject);
    function chartobin(buchstabe: char): string;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.chartobin(buchstabe: char): string;
var
  zahl: integer;
begin
  zahl := ord(buchstabe); // ordinaler Wert/ Ascii-wert
  repeat
    result := inttostr(zahl mod 2) + result;
    zahl := zahl div 2; // ermittlung des Binär-codes
  until zahl = 0;
  while (length(result) <= 7) do // Auffüllen mit 0 um 8 stellen zu füllen
    result := '0' + result;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x, laenge: integer;
  eingabe, ausgabe, abbruchb: string;
begin
  eingabe := '';
  ausgabe := '';
  abbruchb := '01000000'; // abbruchbedingung wählen!!!!
  eingabe := Memo1.Text;
  x := 1;
  laenge := length(eingabe);
  showmessage(inttostr(laenge));
  repeat
    ausgabe := ausgabe + chartobin(eingabe[x]);
    inc(x);
  until (x = laenge);
  ausgabe := ausgabe + abbruchb; // anhängen der abbruchbedingung (oben gewählt)
  while ((length(ausgabe) mod 3) <> 0) do
    ausgabe := ausgabe + '0';
  Memo2.Clear;
  Memo2.Text := ausgabe;
end;

procedure TForm1.Button3Click(Sender: TObject); // Bild laden
begin
  if OpenPictureDialog1.execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  Text: string;
  ix, iy, xende, yende, R, G, B: integer;
  farbe: TColor;
begin
  if Memo2.Text = '' then
    showmessage('Text umwandeln!')
  else
  begin
    xende := Image1.Picture.Width - 1;
    yende := Image1.Picture.Height - 1;
    Text := Memo2.Text;
    for iy := 0 to yende do
      for ix := 0 to xende do
      begin
        if Text <> '' then
        begin
          farbe := colortorgb(Image1.Canvas.Pixels[ix, iy]);
          // auslesen der Farbwerte
          R := getRvalue(farbe);
          G := getGvalue(farbe);
          B := getBvalue(farbe);
          R := R shr 1 shl 1; // letztes bit auf null setzen
          R := R + strtoint(Text[1]); // letztes bit mit erstem wert aus bincode (text) besetzen
          G := G shr 1 shl 1;
          G := G + strtoint(Text[2]);
          B := B shr 1 shl 1;
          B := B + strtoint(Text[3]);
          delete(Text, 1, 3);
        end
        else
        begin
          if SavePictureDialog1.execute then
            Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
          showmessage('Der Text wurde versteckt und gespeichert!');
          exit; // rausspringen aus der for-verschachtelung -> bintext ist beendet
        end;
      end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  form2.ShowModal;
end;

end.

Delphi-Quellcode:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, ExtCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button3: TButton;
    Memo1: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    function bytetochar (zeichen:string):string;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

uses unit1;
{$R *.dfm}

function Tform2.bytetochar(zeichen: string):string;
var
  wert: integer;
begin
  wert := 0;
  wert := ((strtoint(zeichen[1]) * 128) + (strtoint(zeichen[2]) * 64) +
      (strtoint(zeichen[3]) * 32) + (strtoint(zeichen[4]) * 16) +
      (strtoint(zeichen[5]) * 8) + (strtoint(zeichen[6]) * 4) +
      (strtoint(zeichen[7]) * 2) + (strtoint(zeichen[8]) * 1));
  result := chr(wert);
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  if OpenPictureDialog1.execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  xende, yende, ix, iy, R, G, B: integer;
  farbe: TColor;
  binary, ausgabe, zeichen, abbruchb: string;
begin
  abbruchb:='01000000'; //<- Übernehmen als schlüssel aus unit 1
  xende := Image1.Picture.Width - 1;
  yende := Image1.Picture.Height - 1;
  for iy := 0 to yende do
    for ix := 0 to xende do
    begin
      farbe := colortorgb(Image1.Canvas.Pixels[ix, iy]);
      R := getRvalue(farbe);
      G := getGvalue(farbe);
      B := getBValue(farbe);
      binary := binary + inttostr(R and 1);
      binary := binary + inttostr(G and 1);
      binary := binary + inttostr(B and 1);
      if length(binary) > 7 then
      begin
        zeichen := copy(binary, 1, 8);       //übernahme des erstellten binärcodes
        if zeichen = abbruchb then
        begin
          Memo1.Lines.Add(ausgabe);        //ausgabe der zeichenkette
          exit;                            //herausspringen aus verkettung -> text beendet bild aber noch nicht??
        end;
        ausgabe := ausgabe + bytetochar(zeichen);   //erstellung der zeichenkette über die function
        delete(binary, 1, 8);
        //leeren der hilfvariable binary
      end;
    end;
end;

end.

Ich bekomme beim Ende eine Endlosschleife. Ich bin mir recht sicher, dass es mit der Abbruchbedingung zusammenhängt.
Bitte schaut es euch an.

[TobiTomate]

Moin Moin!

Ich habs zusammen mit einer Mitschülerin hinbekommen.

Hier der komplette Quellcode(fast ganz unten ist die Prozedure zum Auslesen):

Delphi-Quellcode:

var
  Form1: TForm1;
  eingabeT, binT, ausgabeT : string; //Eingabetext, Binärtext, Ausgabetext

implementation

{$R *.dfm}

function CharToBin(Buchstabe : char): string; //Buchstabe -> Binärcode
var
  I: Integer;
begin
  SetLength(result, 8);
  for I := 1 to 8 do
  begin
    if (Byte(Buchstabe) shr (8-i)) and 1 = 0 then
      result[i] := '0'
    else
      result[i] := '1';
  end;
end;

function BinToChar(Ziffer : string): string; //Binärcode -> Buchstabe
var Buchstabe : integer;
begin
  Buchstabe:= (StrToInt(Ziffer[1]) * 128) + (StrToInt(Ziffer[2]) * 64) +
              (StrToInt(Ziffer[3]) * 32)  + (StrToInt(Ziffer[4]) * 16) +
              (StrToInt(Ziffer[5]) * 8)   + (StrToInt(Ziffer[6]) * 4)  +
              (StrToInt(Ziffer[7]) * 2)   + (StrToInt(Ziffer[8]) * 1); //Addition aller Potenzen
  result:=chr(Buchstabe);
end;

function DezToBin(Zahl : Integer): string; //Dezimalzahl -> Binärcode
var
  I: Integer;
begin
  SetLength(result, 8);
  for I := 1 to 8 do
  begin
    if (Byte(Zahl) shr (8-i)) and 1 = 0 then
      result[i] := '0'
    else
      result[i] := '1';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject); //.txt Datei öffnen
begin
if OpenTextFileDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenTextFileDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject); //Leerzeichen entfernen
begin
Memo1.Text:=StringReplace(Memo1.Text,' ','',[rfReplaceAll]);
end;

procedure TForm1.Button3Click(Sender: TObject); //Eingabetext umwandeln
var I, eingabeL : integer; //eingabeL = Länge des Eingabetextes
begin
Memo2.Clear;
eingabeT:=Memo1.Text;
eingabeL:=Length(Memo1.Text);
binT:='';
for I := 1 to eingabeL do
  begin
    binT:= binT + CharToBin(eingabeT[I]);
  end;
binT:= binT + '00000100'; //Abbruchbedingung anhängen
while length(binT) mod 3 <> 0 do //Prüfen, ob durch 3 teilbar
binT:= binT + '0';
Memo2.Lines.Add(binT);
end;

procedure TForm1.Button4Click(Sender: TObject); //Binärtext speichern
begin
if SaveTextFileDialog1.Execute then
Memo2.Lines.SaveToFile(SaveTextFileDialog1.FileName+'.txt');
end;

procedure TForm1.Button5Click(Sender: TObject); //Programm schließen
begin
close;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button7Click(Sender: TObject); //Text im Bild verstecken
var Kx,Ky : integer; // Kx/Ky = Koordinate x/y
    farbe : longint;
    R,G,B : byte;
begin
  for Ky := 0 to Image1.Picture.Height - 1 do
    begin
      for Kx := 0 to Image1.Picture.Width - 1 do
        begin  
          if binT <> '' then
          begin
            farbe:= colortorgb(Image1.Canvas.Pixels[Kx,Ky]); //Farbwerte des Pixels auslesen
            R:= GetRValue(farbe); //Rotwert auslesen
            G:= GetGValue(farbe); //Grünwert auslesen
            B:= GetBValue(farbe); //Blauwert auslesen
            R:= R shr 1 shl 1;          //letztes Bit auf 0 setzten
            R:= R + StrToInt(binT[1]);  //erstes Bit des Binärcodes anhängen
            G:= G shr 1 shl 1;
            G:= G + StrToInt(binT[2]);  //zweites Bit des Binärcodes anhängen
            B:= B shr 1 shl 1;
            B:= B + StrToInt(binT[3]);  //drittes Bit des Binärcodes anhängen
            Image1.Canvas.Pixels[Kx,Ky]:=RGB(R,G,B); //neue Werte in Pixel schreiben und Text verstecken
            Delete(binT,1,3);
          end
          else
            exit;
        end;
    end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
if SavePictureDialog1.Execute then
Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
end;

procedure TForm1.Button9Click(Sender: TObject);
var Kx,Ky : integer; // Kx/Ky = Koordinate x/y
    farbe : longint;
    R,G,B : byte;
    RBin,GBin,BBin,Buchst,binär : string;
begin
  for Ky := 0 to Image1.Picture.Height - 1 do
    begin
      for Kx := 0 to Image1.Picture.Width - 1 do
        begin
          farbe := colortorgb(Image1.Canvas.Pixels[Kx, Ky]); //Farbwerte des Pixels auslesen
            R:=getRvalue(farbe); //Rotwert auslesen
            G:=getGvalue(farbe); //Grünwert auslesen
            B:=getBvalue(farbe); //Blauwert auslesen
            RBin:=DezToBin(R); //Rotwert wird in von Dezimal zu Binär umgewandelt
            GBin:=DezToBin(G); //Grünwert wird in von Dezimal zu Binär umgewandelt
            BBin:=DezToBin(B); //Blauwert wird in von Dezimal zu Binär umgewandelt
            binär:=binär+RBin[8]; //letztes Zeichen des Codes hinzufügen
            binär:=binär+GBin[8];
            binär:=binär+BBin[8];
          if length(binär) > 7 then //sobald Zeichenkette länger als 7 Zeichen ist .... 
      begin                       
        Buchst := copy(binär, 1, 8); //wird diese übernommen                    <-------
        if Buchst = '00000100' then
              begin
                Memo3.Lines.Add(ausgabeT); //Ausgabe der Zeichenkette
                exit;
              end;
      ausgabeT := ausgabeT + BinToChar(Buchst); //Erstellung der Zeichenkette
      delete(binär,1,8);            //Leeren der Hilfvariable binär
      end;
        end;
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
end;

end.

[BUG]

Zitat von TobiTomate:

Ich habs zusammen mit einer Mitschülerin hinbekommen.

Glückwunsch

Zitat von Elexarie:

Ich bekomme beim Ende eine Endlosschleife. Ich bin mir recht sicher, dass es mit der Abbruchbedingung zusammenhängt.
Bitte schaut es euch an.

Ehrlich gesagt sehe ich keine potenzielle Endlosschleife in deinem Code. Wann/Wo tritt genau denn der Fehler auf und was passiert dann?