unit Codieren;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TfrmCodieren = class(TForm)
txtStringeingabe: TEdit;
Label1: TLabel;
btnCodieren: TButton;
txtCode: TEdit;
btnDecodieren: TButton;
txtDecodiert: TEdit;
procedure btnCodierenClick(Sender: TObject);
procedure btnDecodierenClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmCodieren: TfrmCodieren;
implementation
{$R *.DFM}
var Original, Versteck, Kette: String;
procedure Tauschen;
var i: Integer;
x,z, Code: String;
begin
Code := ''; // Code ist anfangs leer
(* jedes einzelne Zeichen erfassen *)
for i := 1 to length(Kette) do
begin
z := copy(Kette,i,1); // Zeichen lesen
(* Zeichen tauschen *)
x := z;
if z = 'A' then x := 'ü';
if z = 'ü' then x := 'A';
if z = 'B' then x := 'ö';
if z = 'ö' then x := 'B';
if z = 'C' then x := 'ä';
if z = 'ä' then x := 'C';
if z = 'D' then x := 'z';
if z = 'z' then x := 'D';
if z = 'E' then x := 'y';
if z = 'y' then x := 'E';
if z = 'F' then x := 'x';
if z = 'x' then x := 'F';
if z = 'G' then x := 'w';
if z = 'w' then x := 'G';
if z = 'H' then x := 'v';
if z = 'v' then x := 'H';
if z = 'I' then x := 'u';
if z = 'u' then x := 'I';
if z = 'J' then x := 't';
if z = 't' then x := 'J';
if z = 'K' then x := 's';
if z = 's' then x := 'K';
if z = 'L' then x := 'r';
if z = 'r' then x := 'L';
if z = 'M' then x := 'q';
if z = 'q' then x := 'M';
if z = 'N' then x := 'p';
if z = 'p' then x := 'N';
if z = 'O' then x := 'o';
if z = 'o' then x := 'O';
if z = 'P' then x := 'n';
if z = 'n' then x := 'P';
if z = 'Q' then x := 'm';
if z = 'm' then x := 'Q';
if z = 'R' then x := 'l';
if z = 'l' then x := 'R';
if z = 'S' then x := 'k';
if z = 'k' then x := 'S';
if z = 'T' then x := 'j';
if z = 'j' then x := 'T';
if z = 'U' then x := 'i';
if z = 'i' then x := 'U';
if z = 'V' then x := 'h';
if z = 'h' then x := 'V';
if z = 'W' then x := 'g';
if z = 'g' then x := 'W';
if z = 'X' then x := 'f';
if z = 'f' then x := 'X';
if z = 'Y' then x := 'e';
if z = 'e' then x := 'Y';
if z = 'Z' then x := 'd';
if z = 'd' then x := 'Z';
if z = 'Ä' then x := 'c';
if z = 'c' then x := 'Ä';
if z = 'Ö' then x := 'b';
if z = 'b' then x := 'Ö';
if z = 'Ü' then x := 'a';
if z = 'a' then x := 'Ü';
if z = '1' then x := '=';
if z = '=' then x := '1';
if z = '2' then x := '!';
if z = '!' then x := '2';
if z = '3' then x := '"';
if z = '"' then x := '3';
if z = '4' then x := '§';
if z = '§' then x := '4';
if z = '5' then x := '$';
if z = '$' then x := '5';
if z = '6' then x := '%';
if z = '%' then x := '6';
if z = '7' then x := '&';
if z = '&' then x := '7';
if z = '8' then x := '/';
if z = '/' then x := '8';
if z = '9' then x := '(';
if z = '(' then x := '9';
if z = '0' then x := ')';
if z = ')' then x := '0';
Code := Code + x;
end;
Kette := Code;
end;
procedure TfrmCodieren.btnCodierenClick(Sender: TObject);
begin
(* Text einlesen *)
Original := txtStringeingabe.Text;
(* überprüfen, ob etwas eingegeben ist *)
if length(Original) > 0
then
begin
Kette := Original;
(* codieren mithilfe der Procedure "Tauschen" *)
Tauschen;
(* Code ausgeben *)
txtCode.Text := Kette;
end;
end;
procedure TfrmCodieren.btnDecodierenClick(Sender: TObject);
begin
(* Text einlesen *)
Versteck := txtCode.Text;
(* überprüfen, ob etwas eingegeben ist *)
if length(Versteck) > 0
then
begin
Kette := Versteck;
(* decodieren mithilfe der Procedure "Tauschen" *)
Tauschen;
(* Code ausgeben *)
txtDecodiert.Text := Kette;
end;
end;
end.