PGH - Steganographie Quellcode

unit uMainFrm;

interface
(* ==================================================================== *)
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, uAboutBox, uStegHide;

type
  TMainFrm = class(TForm)
    MainMenu: TMainMenu;
    Datei1: TMenuItem;
    OpenMenuE: TMenuItem;
    SaveMenuE: TMenuItem;
    N1: TMenuItem;
    EndMenuE: TMenuItem;
    AboutMenuE: TMenuItem;
    Funktionen1: TMenuItem;
    DechiffrierenMenuE: TMenuItem;
    ChiffrierentMenuE: TMenuItem;
    Image: TImage;
    DataBitLbl: TLabel;
    DataBitCBox: TComboBox;
    MaxTextLbl1: TLabel;
    BmpOpenDialog: TOpenDialog;
    TextLengthLbl1: TLabel;
    TextLengthLbl2: TLabel;
    MaxTextLbl2: TLabel;
    N2: TMenuItem;
    BildanzeigenMenuE: TMenuItem;
    BmpSaveDialog: TSaveDialog;
    GeheimTextMemo: TMemo;
    TextladenMenuE: TMenuItem;
    TextspeichernMenuE: TMenuItem;
    TxtOpenDialog: TOpenDialog;
    TxtSaveDialog: TSaveDialog;
    ClearTextBtn: TMenuItem;
    procedure LadeBmp(Sender : TObject);       // lädt des bmp bei Auswahl von Datei/Laden
    procedure LadeTextDatei(Sender : TObject);
    procedure EndMenuEClick(Sender: TObject);
    procedure AboutMenuEClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ChiffrierentMenuEClick(Sender: TObject);
    procedure DataBitCBoxChange(Sender: TObject);
    procedure DechiffrierenMenuEClick(Sender: TObject);
    procedure TextChange(Sender: TObject);
    procedure BildanzeigenMenuEClick(Sender: TObject);
    procedure SpeicherBmp(Sender: TObject);
    procedure SpeicherTxt(Sender: TObject);
    procedure ClearTextBtnClick(Sender: TObject);
  private
    { Private-Deklarationen }
    steghide : TStegHide;
    bmp_geladen, bmp_geaendert, txt_geladen : boolean;
    bmp_DateiName : string;
    txt_DateiName : string;

    function EndsWith (text,teststring : string):boolean;
    procedure MaskeAktualisieren;
    function TextLaenge : integer;

  public
    { Public-Deklarationen }
  end;

var
  MainFrm: TMainFrm;

implementation
(* ==================================================================== *)
{$R *.DFM}
/////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
// Private
/////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
function TMainFrm.EndsWith;
(* -------------------------------------------------------------------- *)
var
   textlength, testlength : integer;
   vergleichstring : string;
begin
     Result := false;
     testlength := length(teststring);
     textlength := length (text);
     if textlength > testlength then
     begin
          vergleichstring := copy (text,(textlength+1)-testlength,testlength);
          if vergleichstring = teststring then
          result := true
     end;
end;

procedure TMainFrm.MaskeAktualisieren;
(* -------------------------------------------------------------------- *)
begin
     if BildanzeigenMenuE.Checked then Image.Picture.Bitmap := steghide.getBmp;
     Invalidate;
end;
/////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
// Form-routines
/////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
procedure TMainFrm.LadeBmp;
begin
     if BmpOpenDialog.Execute then
     begin
	  bmp_DateiName:= BmpOpenDialog.FileName;

          if not steghide.LoadBmp(bmp_DateiName) then
          begin
               ShowMessage('Bitmap ' + bmp_Dateiname + ' konnte nicht geladen werden!');
               exit;
          end;

          MainFrm.Caption := 'PGH - ' + bmp_DateiName;
          MaxTextLbl2.Caption := IntToStr(steghide.GetMaxTextLength);
          bmp_geladen := true;

          MaskeAktualisieren;
     end;
end;

procedure TMainFrm.LadeTextDatei;
(* -------------------------------------------------------------------- *)
var datei : Textfile;
    tmpstring : string;
begin
     if txt_DateiName <> '' then TxtOpenDialog.FileName := txt_DateiName;
     if TxtOpenDialog.Execute then
     begin
          txt_DateiName := TxtOpenDialog.FileName;
	  assignfile(datei, txt_DateiName);
	  {$i-} Reset(datei); {$i+}
          if IOResult <> 0 then exit;
	  if GeheimTextMemo.Lines.Count > 0 then
		if MessageDlg('Soll der bestehende Text gelöscht werden?',
				mtConfirmation, [mbYes, mbNo], 0)= mrYes
		then GeheimTextMemo.Clear;
	  while not EOF(datei) do
	  begin 
		readln(datei, tmpstring);
		GeheimTextMemo.Lines.Append(tmpstring);
	  end;
          closefile(datei);
          txt_geladen := true;
     end;
end;

procedure TMainFrm.EndMenuEClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     Close;
end;

procedure TMainFrm.AboutMenuEClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     AboutBox.Show;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     StegHide := TStegHide.Create;
     StegHide.SetText(GeheimTextMemo.Lines);
     //LoadConfig;
     //DatenAktualisieren;
     //StegHide.Init;

     bmp_DateiName := '';
     txt_DateiName := '';
     bmp_geladen := false;
     bmp_geaendert := false;
     txt_geladen := false;
     DataBitCBox.ItemIndex := 0;
     TextLengthLbl2.Caption := IntToStr(Textlaenge);
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
(* -------------------------------------------------------------------- *)
begin
     if bmp_geaendert then
        case MessageDlg('Soll das geänderte Bild gespeichert werden?', mtConfirmation,
             [mbYes, mbNo, mbCancel], 0) of
                     id_Yes: SpeicherBmp(Self);
                     id_Cancel: begin Action := caNone; exit; end;

        end;
     StegHide.Free;
end;

procedure TMainFrm.ChiffrierentMenuEClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     if (GeheimTextMemo.Lines.Count > 0) and bmp_geladen then
     begin
          steghide.SetText(GeheimTextMemo.Lines);
          if not steghide.Chiffrieren then ShowMessage('Text wurde nicht korrekt chiffriert!');
          bmp_geaendert := true;

          MaskeAktualisieren;
     end
     else ShowMessage('Bitte Bitmap laden und einen Text eingeben!');
end;

procedure TMainFrm.DataBitCBoxChange(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     steghide.SetDatenBit(DataBitCBox.ItemIndex);
end;

procedure TMainFrm.DechiffrierenMenuEClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     if bmp_geladen then
     begin
          GeheimTextMemo.Clear;
          steghide.Dechiffrieren;
     end
     else ShowMessage('Bitte Bitmap zum dechiffrieren laden!');
end;

procedure TMainFrm.TextChange(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     TextLengthLbl2.Caption := IntToStr(Textlaenge);
end;

procedure TMainFrm.BildanzeigenMenuEClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     if BildanzeigenMenuE.Checked then
     begin
          BildanzeigenMenuE.Checked := false;
          Image.Hide;
     end
     else
     begin
          BildanzeigenMenuE.Checked := true;
          Image.Visible := true;
          MaskeAktualisieren;
     end;
end;

procedure TMainFrm.SpeicherBmp(Sender: TObject);
(* -------------------------------------------------------------------- *)
var tempbmp : TBitmap;
begin
     if not bmp_geladen then begin ShowMessage('Bitte ein Bitmap laden!'); exit; end;
     if BmpSaveDialog.Execute then
     begin
          if fileexists(BmpSaveDialog.FileName) then
             if MessageDlg('Soll die Datei '+ BmpSaveDialog.FileName + ' wirklich überschrieben werden?', mtConfirmation,
                                 [mbYes, mbNo], 0)= mrNo
             then SpeicherBmp(Self);

          if not endswith(BmpSaveDialog.FileName, '.bmp')
          then BmpSaveDialog.FileName:= BmpSaveDialog.FileName + '.bmp';

          steghide.WriteBmp(BmpSaveDialog.FileName);
          bmp_geaendert := false;
     end;
end;

procedure TMainFrm.SpeicherTxt(Sender: TObject);
(* -------------------------------------------------------------------- *)
var datei : textfile;
    i : integer;
begin
     if GeheimTextMemo.Lines.Count = 0 then begin ShowMessage('Bitte einen Text eingeben!'); exit; end;
     if TxtSaveDialog.Execute then
     begin
          if fileexists(TxtSaveDialog.FileName) then
             if MessageDlg('Soll die Datei '+ TxtSaveDialog.FileName + ' wirklich überschrieben werden?', mtConfirmation,
                                 [mbYes, mbNo], 0)= mrNo
             then SpeicherTxt(Self);

          if not endswith(TxtSaveDialog.FileName, '.txt')
          then TxtSaveDialog.FileName:= TxtSaveDialog.FileName + '.txt';

          AssignFile(datei, TxtSaveDialog.FileName);
          {$i-} Rewrite(datei); {$i+}
          if IOResult <> 0 then begin ShowMessage('Text nicht gespeichert!'); exit; end;
          for i:= 0 to GeheimTextMemo.Lines.Count-1 do
              writeln(datei, GeheimTextMemo.Lines[i]);
          closefile(datei);
     end;
end;

function TMainFrm.TextLaenge;
(* -------------------------------------------------------------------- *)
var i : integer;
begin
     Result := 0;
     for i := 0 to GeheimTextMemo.Lines.Count-1 do
         inc(Result,length(GeheimTextMemo.Lines[i]));
end;

procedure TMainFrm.ClearTextBtnClick(Sender: TObject);
(* -------------------------------------------------------------------- *)
begin
     if MessageDlg('Soll der Text wirklich gelöscht werden?', mtConfirmation,
        [mbYes, mbNo], 0)= mrYes
     then GeheimTextMemo.Clear;
end;

end.

unit uStegHide;
/////////////////////////////////////////////////////////////////////////
// Klasse zum Erzeugen eines steganographischen Bildes
// Programmierer: Norman Niemer
// Datum: 30.05.00
/////////////////////////////////////////////////////////////////////////
interface

uses graphics {TBitmap}, sysutils {PByteArray}, classes {TStrings};

const BitArr: array[0..7] of byte = (1, 2, 4 , 8 , 16, 32, 64, 128);
      EndOfText = 30;
      EndOfLine = 29;

type
//////////////////////
// TStegHide
//////////////////////
  TStegHide = class

          constructor Create;
          destructor Destroy;

          private
                 bmp:TBitmap;
		 Geheimtext : TStrings;
                 bmp_geladen : boolean;                                      // gibt an, ob ein bmp geladen ist
                 datenbit : byte;                                            // gibt das Bit an, wo die Daten versteckt werden

                 function BitStatus(SetWord, BitNum : Word) : Boolean;       // true, wenn Bit gesetzt
                 procedure ToggleBit( BitNum : byte; var Setbyte : byte);    // tauscht die einzelnen Bits

          public
                function Chiffrieren : boolean;
                function Dechiffrieren : boolean;
                function GetBmp : TBitmap;                                 
                function GetMaxTextLength : integer;                            // gibt Maximalanzahl der vesteckbaren Zeichen zurück
		function GetText : TStrings;
		function LoadBmp( dn : string) : boolean;
                procedure SetDatenBit( dbit : byte );
                procedure SetBitmap( tmpbmp : TBitmap );
		procedure SetText( txt : TStrings );
		function WriteBmp( dn : string) : boolean;
  end; // TStegHide
/////////////////////////////////////////////////////////////////////////
// function chiffrieren
// Aufgabe: versteckt die information im bmp
// vorher: bmp ist geladen
// nachher: information ist versteckt
//
// function dechiffrieren
// Aufgabe: findet versteckte information
// vorher: bmp ist geladen
// nachher: information
//
// function Getmaxtextlenght
// Aufgabe: gibt die maximale Textlänge, die in dem
//          geladenen Bmp versteckt werden kann zurück
// vorher: bmp ist geladen
// Nachher:
//
// funcion loadbmp
// Aufgabe: lädt das bmp
// vorher: bmp_geladen := false
// nachher: bmp_geladen := true
//
// procedure SetDatenBit
// Aufgabe: setzt das Bit, auf welchen die Informationen vesteckt werden
//
// function writeBmp
// Aufgabe: speichert das veränderte bmp
// vorher: bmp ist nicht gespeichert
// nachher: bmp ist gespeichert
/////////////////////////////////////////////////////////////////////////
implementation
//////////////////////////////////////////////////
// General
//////////////////////////////////////////////////
constructor TStegHide.Create;
begin
     inherited Create;
     bmp := TBitmap.Create;
     Geheimtext := TStrings.Create;
     bmp_geladen := false;
     datenbit := 0;
end;

destructor TStegHide.Destroy;
begin
     bmp.Free;
end;
///////////////////////////////////////////////////
// Private
///////////////////////////////////////////////////
function TStegHide.BitStatus(SetWord, BitNum : Word) : Boolean;
begin
   if (SetWord and BitNum) = BitNum then
      Result := true else Result := false;
end;

procedure TStegHide.ToggleBit;
begin
     Setbyte := Setbyte Xor BitNum;
end;
///////////////////////////////////////////////////
// Public
///////////////////////////////////////////////////
function TStegHide.Chiffrieren;
var x, y, for_char, for_string, for_text : integer;
    ascii : byte;
    pixels : PByteArray;
    last_line : boolean;

procedure GetNewLine;
begin
     pixels := bmp.ScanLine[x];
     inc(x);
     if x >= bmp.height then last_line := true;
     y := 0;
end;

begin
     Result := false;
     if not bmp_geladen then exit;

     x := 0; last_line := false;
     GetNewLine;

     if Geheimtext.Count = 0 then exit;

     for for_text := 0 to geheimtext.Count-1 do
     begin
          for for_string := 1 to length(Geheimtext[for_text]) do
          begin
               ascii := ord(geheimtext[for_text][for_string]);
               for for_char := 0 to 7 do
               begin
                 if not ((BitStatus(ascii, BitArr[for_char])) =
                         (BitStatus(pixels[y], BitArr[datenbit])))
                 then ToggleBit(BitArr[datenbit], pixels[y]);

                 inc(y);
                 if y >= bmp.width then
                    if last_line then exit else GetNewLine;
               end;
          end;

          ascii := EndOfLine;                 // signalisiert das Ende einer Zeile
          for for_char := 0 to 7 do
          begin
               if not ((BitStatus(ascii, BitArr[for_char])) =
                        (BitStatus(pixels[y], BitArr[datenbit])))
               then ToggleBit(BitArr[datenbit], pixels[y]);
               inc(y);
               if y >= bmp.width then
                    if last_line then exit else GetNewLine;
           end;
     end;

     ascii := EndOfText;                      // signalisiert das Ende des Textes
     for for_char := 0 to 7 do
     begin
                 if not ((BitStatus(ascii, BitArr[for_char])) =
                        (BitStatus(pixels[y], BitArr[datenbit])))
                 then ToggleBit(BitArr[datenbit], pixels[y]);
                 inc(y);
                 if y >= bmp.width then
                    if last_line then exit else GetNewLine;
     end;

     Result := true;
end;

function TStegHide.Dechiffrieren;
var geheimzeile : string;
    ascii : byte;
    for_char, x, y : integer;
    pixels : PByteArray;
    i : integer;                                                         //debug
begin
     for_char := 0; ascii := 0; Geheimtext.Clear; Result := false;
     i := 0;

     for x:= 0 to bmp.Height-1 do
     begin
          pixels := bmp.ScanLine[x];
          for y:= 0 to bmp.Width-1 do
          begin
               if not ((BitStatus(ascii, BitArr[for_char])) =
                        (BitStatus(pixels[y], BitArr[datenbit])))
               then ToggleBit(BitArr[for_char], ascii);

               inc(for_char);
               if for_char = 8 then
               begin
                    if ascii = EndOfText then begin Result := true; exit; end;    // Ende des Textes wurde erreicht
                    if ascii = EndOfLine                                          // Ende einer Zeile
		    then begin Geheimtext.Append(geheimzeile); geheimzeile := ''; end
		    else geheimzeile := geheimzeile + Chr(ascii);
                    for_char := 0;
                    ascii := 0;
               end;
          end;
     end;
end;

function TStegHide.GetBmp;
begin
     Result := bmp;
end;

function TStegHide.GetMaxTextLength;
begin
     Result := ( bmp.width * bmp.height ) div 8;
end;

function TStegHide.GetText;
begin
     Result := TStrings.Create;
     Result := Geheimtext;
end;

function TStegHide.LoadBmp;
begin
     Result := false;
     try
	bmp.LoadFromFile(dn);
     except exit;
     end;
     Result := true;
     bmp_geladen := true;
end;

procedure TStegHide.SetBitmap;
begin
     bmp := tmpbmp;
     if not bmp_geladen then bmp_geladen := true;
end;

procedure TStegHide.SetDatenBit;
begin
     datenbit := dbit;
end;

procedure TStegHide.SetText;
begin
     Geheimtext := txt;
end;

function TStegHide.WriteBmp;
begin
     Result := false;
     try
        bmp.SaveToFile(dn);
     except exit;
     end;
     Result := true;
end;

end.