unit uCrypt;

//////////////////////////////////////
///  Lina Cryption Unit            ///
///  ****************************  ///
///  (c) 2014 Dennis Göhlert a.o.  ///
//////////////////////////////////////

interface

uses
  { Standard-Units }
  SysUtils, Classes,
  { Andere Package-Units }
  uSysTools;

type
  { Fehlermeldungen }
  EInvalidKey = class(Exception);

type
  { Hilfsklassen }
  TCryptMode = (cmEncrypt,cmDecrypt);

type
  { Ereignisse }
  TCryptWorkEvent = procedure(Sender: TObject; const Mode: TCryptMode) of object;
  TCryptKeyChangeEvent = procedure(Sender: TObject) of object;
  TCryptKeyChangeQueryEvent = procedure(Sender: TObject; var CanChange: Boolean) of object;

type
  { Hauptklassen }
  TCrypt = class
  private
    { Private-Deklarationen }
    FKeyString: String;
    FKeyChar: Char;
    FKeyInteger: Integer;
    FLines: TStrings;
    FWorkEvent: TCryptWorkEvent;
    FKeyChangeEvent: TCryptKeyChangeEvent;
    FKeyChangeQueryEvent: TCryptKeyChangeQueryEvent;
    { Methoden }
    procedure SetKeyString(Value: String);
    procedure SetKeyChar(Value: Char);
    procedure SetKeyInteger(Value: Integer);
    { Eigenschaften }
    property KeyString: String read FKeyString write SetKeyString;
    property KeyChar: Char read FKeyChar write SetKeyChar;
    property KeyInteger: Integer read FKeyInteger write SetKeyInteger;
  public
    { Public-Deklarationen }
    constructor Create;
    destructor Destroy; override;
    property Lines: TStrings read FLines write FLines;
    procedure Decrypt; virtual;
    procedure Encrypt; virtual;
    { Ereignisse }
    property OnWork: TCryptWorkEvent read FWorkEvent write FWorkEvent;
    property OnKeyChange: TCryptKeyChangeEvent read FKeyChangeEvent write FKeyChangeEvent;
    property OnKeyChangeQuery: TCryptKeyChangeQueryEvent read FKeyChangeQueryEvent write FKeyChangeQueryEvent;
  end;

  { Spezifische Kryptologie-Verfahren }

  TXorCrypt = class(TCrypt)
  private
    { Private-Deklarationen }
    procedure SetKeyInteger(Value: Integer);
  public
    { Public-Deklarationen }
    procedure Decrypt;
    procedure Encrypt;
    { Eigenschaften }
    property KeyInteger;
  end;

  TVigenereCrypt = class(TCrypt)
  private
    { Private-Deklarationen }
    procedure SetKeyString(Value: String);
  public
    { Public-Deklarationen }
    procedure Decrypt;
    procedure Encrypt;
    { Eigenschaften }
    property KeyChar;
  end;

  TCaesarCrypt = class(TCrypt)
  private
    { Private-Deklarationen }
    procedure SetKeyChar(Value: Char);
  public
    { Public-Deklarationen }
    procedure Decrypt;
    procedure Encrypt;
    { Eigenschaften }
    property KeyString;
  end;

  //TDynaCrypt = class(TCrypt)
  //public
    { Public-Deklarationen }
    //procedure Decrypt;
    //procedure Encrypt;
    { Eigenschaften }
    //property KeyChar;
  //end;

implementation

{ ----------------------------------------------------------------------------
  TCrypt
  ---------------------------------------------------------------------------- }

constructor TCrypt.Create;
begin
  FLines := TStringList.Create;
end;

destructor TCrypt.Destroy;
begin
  FLines.Free;
  inherited;
end;

procedure TCrypt.SetKeyString(Value: String);
var
  CanChange: Boolean;
begin
  CanChange := True;
  if Assigned(OnKeyChange) then
  begin
    OnKeyChangeQuery(Self,CanChange);
  end;
  if CanChange = True then
  begin
    FKeyString := Value;
    if Assigned(OnKeyChange) then
    begin
      OnKeyChange(Self);
    end;
  end;
end;

procedure TCrypt.SetKeyChar(Value: Char);
var
  CanChange: Boolean;
begin
  CanChange := True;
  if Assigned(OnKeyChange) then
  begin
    OnKeyChangeQuery(Self,CanChange);
  end;
  if CanChange = True then
  begin
    FKeyChar := Value;
    if Assigned(OnKeyChange) then
    begin
      OnKeyChange(Self);
    end;
  end;
end;

procedure TCrypt.SetKeyInteger(Value: Integer);
var
  CanChange: Boolean;
begin
  CanChange := True;
  if Assigned(OnKeyChange) then
  begin
    OnKeyChangeQuery(Self,CanChange);
  end;
  if CanChange = True then
  begin
    FKeyInteger := Value;
    if Assigned(OnKeyChange) then
    begin
      OnKeyChange(Self);
    end;
  end;
end;

procedure TCrypt.Decrypt;
begin
  //...
  if Assigned(OnWork) = True then
  begin
    OnWork(Self,cmDecrypt);
  end;
end;

procedure TCrypt.Encrypt;
begin
  //...
  if Assigned(OnWork) = True then
  begin
    OnWork(Self,cmEncrypt);
  end;
end;

{ ----------------------------------------------------------------------------
  TXorCrypt
  ---------------------------------------------------------------------------- }

procedure TXorCrypt.SetKeyInteger(Value: Integer);
begin
  if not (KeyInteger in [0..31]) then
  begin
    raise EInvalidKey.Create('Invalid key value');
  end;
  inherited;
end;

procedure TXorCrypt.Decrypt;
begin
  { Bei Xor entspricht der Entschlüsselungs-Algorithmus dem der
    Verschlüsselung. Deshalb genügt hier ein Verweis auf "TXorCrypt.Encrypt". }
  Encrypt;
  inherited;
end;

procedure TXorCrypt.Encrypt;
var
  Encrypted: TStrings;
  LineIndex: Integer;
  CharIndex: Integer;
  Line: String;
begin
  Encrypted := TStringList.Create;
  try
    Encrypted.Assign(Lines);
    for LineIndex := 0 to Encrypted.Count do
    begin
      Line := Encrypted.Strings[LineIndex];
      for CharIndex := 1 to Length(Line) do
      begin
        if Line[CharIndex] > #31 then
        begin
          Line[CharIndex] := Chr(Ord(Line[CharIndex]) xor KeyInteger);
        end;
      end;
      Encrypted.Strings[LineIndex] := Line;
    end;
    Lines.Assign(Encrypted);
  finally
    Encrypted.Free;
  end;
  inherited;
end;

{ ----------------------------------------------------------------------------
  TVigenereCrypt
  ---------------------------------------------------------------------------- }

procedure TVigenereCrypt.SetKeyString(Value: String);
var
  Index: Integer;
begin
  Value := UpperCase(Value);
  for Index := 1 to Length(Value) do
  begin
    if not (Value[Index] in ['A'..'Z']) then
    begin
      raise EInvalidKey.Create('Invalid key value');
    end;
  end;
  inherited;
end;

procedure TVigenereCrypt.Decrypt;
var
  Encrypted: TStrings;
  LineIndex: Integer;
  CharIndex: Integer;
  Line: String;
  KeyIndex: Integer;
  CurKeyLetter: Integer;
  CurLetter: Integer;
begin
  Encrypted := TStringList.Create;
  try
    Encrypted.Assign(Lines);
    for LineIndex := 0 to Encrypted.Count do
    begin
      Line := Encrypted.Strings[LineIndex];
      for CharIndex := 1 to Length(Line) do
      begin
        if Line[CharIndex] in ['A'..'Z'] then
        begin
          CurKeyLetter := Ord(KeyString[1 + (KeyIndex mod Length(KeyString))]) - Ord('A');
          CurLetter := Ord(Line[CharIndex]) - Ord('A');
          Line[CharIndex] := Chr(Ord('A') + ((26 + CurLetter - CurKeyLetter) mod 26));
          Inc(KeyIndex);
        end
      end;
      Encrypted.Strings[LineIndex] := Line;
    end;
    Lines.Assign(Encrypted);
  finally
    Encrypted.Free;
  end;
  inherited;
end;

procedure TVigenereCrypt.Encrypt;
var
  Encrypted: TStrings;
  LineIndex: Integer;
  CharIndex: Integer;
  Line: String;
  KeyIndex: Integer;
  CurKeyLetter: Integer;
  CurLetter: Integer;
begin
  Encrypted := TStringList.Create;
  try
    Encrypted.Assign(Lines);
    for LineIndex := 0 to Encrypted.Count do
    begin
      Line := Encrypted.Strings[LineIndex];
      for CharIndex := 1 to Length(Line) do
      begin
        if Line[CharIndex] in ['A'..'Z'] then
        begin
          CurKeyLetter := Ord(KeyString[1 + (KeyIndex mod Length(KeyString))]) - Ord('A');
          CurLetter := Ord(Line[CharIndex]) - Ord('A');
          Line[CharIndex] := Chr(Ord('A') + ((CurLetter + CurKeyLetter) mod 26));
          Inc(KeyIndex);
        end
      end;
      Encrypted.Strings[LineIndex] := Line;
    end;
    Lines.Assign(Encrypted);
  finally
    Encrypted.Free;
  end;
  inherited;
end;

{ ----------------------------------------------------------------------------
  TCaesarCrypt
  ---------------------------------------------------------------------------- }

procedure TCaesarCrypt.SetKeyChar(Value: Char);
begin
  Value := CharUpperCase(Value);
  if not (Value in ['A'..'Z']) then
  begin
    raise EInvalidKey.Create('Invalid key value');
  end;
  inherited;
end;

procedure TCaesarCrypt.Decrypt;
begin
  //...
  inherited;
end;

procedure TCaesarCrypt.Encrypt;
begin
  //...
  inherited;
end;

end.
