simple encryption program

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Menus, ShellApi, windows, LCLType;

type

  { TLinCryptWindow }

  TLinCryptWindow = class(TForm)
    Benc: TButton;
    Bdec: TButton;
    Bclip: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    MainMenu: TMainMenu;
    MHelp: TMenuItem;
    Help: TMenuItem;
    About: TMenuItem;
    Tkey: TEdit;
    Minput: TMemo;
    Moutput: TMemo;
    procedure AboutClick(Sender: TObject);
    procedure BclipClick(Sender: TObject);
    procedure BdecClick(Sender: TObject);
    procedure BencClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HelpClick(Sender: TObject);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  LinCryptWindow: TLinCryptWindow;

implementation

{$R *.lfm}

{ TLinCryptWindow }

//COLLECTION OF ALGORITHMS


function caesar(inStr:string; keyStr:string; dec:boolean):string;
  var //position in text, current Letter
      posT,curLetter:integer;
      //encode-decode switch, key integer variable
      x,key:integer;

  begin
    try
    //setting length of result
    setLength(result,length(inStr));
    //initializing key variable
    key := 0;
    //generating key in the constant range of 0..25
    for posT := 1 to Length(keyStr) do  key := (key + ord(keyStr[posT])) mod 26;

    //defining switch
    if dec then x := -1 else x := 1;

    for posT := 1 to Length(inStr) do
    begin

         //--capitalized letters--
         if inStr[posT] in ['A'..'Z'] then
         begin

         //normalizing by substracting 'A'-ASCII code from letter-ASCII code
         curLetter := (ord(inStr[posT]) - ord('A'));
         //shift and integration of switch
         curLetter := (26 + curLetter + x * key) mod 26;
         //denormalizing and translate ASCII into letter
         result[posT] := chr(curLetter + ord('A'));

         //transfere everything else than letters as it is
         end else result[posT] := inStr[posT];


         //--uncapitalized letters--
         if inStr[posT] in ['a'..'z'] then
         begin
         curLetter := (ord(inStr[posT]) - ord('a'));
         curLetter := (52 + curLetter + x * key) mod 26;
         result[posT] := chr(curLetter + ord('a'));
         end else result[posT] := inStr[posT];
    end;

    except
       //catching exceptions and showing error message
       on E : Exception do showMessage('An '+E.Classname+' error occured: '+E.Message);
    end;
  end;

function vigenere(inStr:string; keyStr:string; dec:boolean):string;
var //position in text and position in key
    posT, posK: integer;
    //current letter from key word and current to encrypt/decrypt letter
    curKeyLetter, curLetter:integer;
    //encode-decode switch variable
    x:integer;

  begin
    try
    //setting length of result
    setLength(result, Length(inStr));
    //initializing key variable
    posK := 0;
    //defining switch
    if dec then x := -1 else x := 1;

    for posT := 1 to Length(inStr) do
    begin
         //--capitalized letters--
         if inStr[posT] in ['A'..'Z'] then
         begin
         //repeated scanning of key for letter and normalizing
         curKeyLetter :=  ord(keyStr[1 + (posK mod Length(keyStr))]) - ord('A');
         //normalizing by substracting 'A'-ASCII code from letter-ASCII code
         curLetter := (ord(inStr[posT]) - ord('A'));
         //shift, integration of switch and denormalizing
         result[posT] := chr(((26 + curLetter + x * curKeyLetter) mod 26) + ord('A'));
         //increasing position in key
         inc(posK);

         //transfere everything else than letters as it is
         end else result[posT] := inStr[posT];


         //--uncapitalized letters--
         if inStr[posT] in ['a'..'z'] then
         begin
         curKeyLetter :=  ord(keyStr[1 + (posK mod Length(keyStr))]) - ord('a');
         curLetter := (ord(inStr[posT]) - ord('a'));

         result[posT] := chr(((52 + curLetter + x * curKeyLetter) mod 26) + ord('a'));
         inc(posK);
         end else result[posT] := inStr[posT];
    end;


    except
       //catching exceptions and showing error message
       on E : Exception do showMessage('An '+E.Classname+' error occured: '+E.Message);
    end;
end;

function pseudoRand(inStr:string; keyStr:string; dec:boolean):string;
  var //position in text, current letter variable
      posT,curLetter:integer;
      //encode-decode switch and seed integer variable
      x,seed:integer;

  begin
    try
    //setting length of result
    setLength(result,length(inStr));
    //initializing seed variable
    seed := 0;
    //generating seed out of sum of ASCII values of key chars
    for posT := 1 to Length(keyStr) do  seed := (seed + ord(keyStr[posT]));
    //setting seed for Random
    RandSeed := seed;

    //defining switch
    if dec then x := -1 else x := 1;

    for posT := 1 to Length(inStr) do
    begin
         //--capitalized letters--
         if inStr[posT] in ['A'..'Z'] then
         begin
         //normalizing
         curLetter := (ord(inStr[posT]) - ord('A'));
         //shift by random letter between A and Z
         curLetter := (26 + curLetter + x * Random(26)) mod 26;
         //denormalizing and translating to letter
         result[posT] := chr(curLetter + ord('A'));
         //transfere everything else than letters as it is
         end else result[posT] := inStr[posT];

         //--uncapitalized letters--
         if inStr[posT] in ['a'..'z'] then
         begin
         curLetter := (ord(inStr[posT]) - ord('a'));
         //shifting by random letter between a and z
         curLetter := (52 + curLetter + x * Random(52)) mod 26;
         result[posT] := chr(curLetter + ord('a'));
         end else result[posT] := inStr[posT];
    end;

    except
       //catching exceptions and showing error message
       on E : Exception do showMessage('An '+E.Classname+' error occured: '+E.Message);
    end;
  end;



//amount of blocks
function amBl(i1:integer;i2:integer):integer;
begin
  if (i1 mod i2) <> 0 then result := (i1 div i2) else result := (i1 div i2) - 1;
end;

//calculation of block length
function calcBl(keyStr:string):integer;
var i:integer;
begin
  result := 0;
  for i := 1 to Length(keyStr) do
  begin
     result := (result + ord(keyStr[i])) mod 5;
     result := result + 2;
  end;

end;

//desperate try to add strings
function append(s1,s2:string):string;
begin
  insert(s2,s1,Length(s1)+1);
  result := s1;
end;

function rotation(inStr,keyStr:string):string;
var //array of chars -> string
    block,temp:string;
    //position in block  variable
    posB:integer;
    //block length and block count variable
    bl, bc:integer;
    //null character as placeholder
    n : ansiChar;

begin
   //calculating block length 2..6
   bl := calcBl(keyStr);
   setLength(block,bl);
   result := '';
   temp := '';
   {n := #00;}

   for bc := 0 to amBl(Length(inStr),bl) do
     begin
       //filling block with chars starting from back of virtual block (in inStr)
       for posB := 1 to bl do
       begin
       block[posB] := inStr[bc * bl + posB];
       {if inStr[bc * bl + posB] = ' ' then block[posB] := n;}
       end;

       //adding the block in front of the existing result string
       temp := result;
       result := block + temp;
       //result := append(block,temp);
       //result :=  concat(block,temp);
       //if you try this with breakpoints and watches you'll see that it actually works

     end;

end;



//ACTIONS

procedure TLinCryptWindow.FormCreate(Sender: TObject);
begin
  //clearing memos
  Minput.clear;
  Moutput.clear;

end;


procedure TLinCryptWindow.BencClick(Sender: TObject);
var i, order:integer;
    //boolean variable to set to true if  test is passed
    //and to false if something is wrong with password
    test:boolean;
begin
Moutput.clear;
test := true;
order := 0;

for i := 1 to Length(Tkey.Text) do
begin
  //only digits, capitalized and uncapitalized letters allowed
  if Tkey.Text[i] in ['0'..'9'] + ['A'..'Z'] + ['a'..'z'] then test := true else
  begin
    showMessage('Password must not contain spaces or spezial characters.'+sLineBreak+
    'Password can only contain capitalized and uncapitalize letters as well as numbers.'+sLineBreak+
    'Please click OK and use another password.');
    test := false;
    //breaking and exiting the BencClick procedure
    exit;
  end;
  //sum of all ASCII values in the key for constant order for one key
  order := order + ord(Tkey.Text[i]);
end;
//calculating a constant value to choose one order out of four
order := order mod 4; //mod 5;

if test then
  begin
    case order of
    0: Moutput.Text := pseudoRand(vigenere(caesar(Minput.Text, Tkey.Text, false), Tkey.Text, false), Tkey.Text, false);
    1: Moutput.Text := vigenere(caesar(pseudoRand(Minput.Text, Tkey.Text, false), Tkey.Text, false), Tkey.Text, false);
    2: Moutput.Text := caesar(vigenere(caesar(Minput.Text, Tkey.Text, false), Tkey.Text, false), Tkey.Text, false);
    3: Moutput.Text := pseudoRand(vigenere(pseudoRand(Minput.Text, Tkey.Text, false), Tkey.Text, false), Tkey.Text, false);
    //4: Minput.Text := rotation(vigenere(caesar(pseudoRand(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true),Tkey.Text);
    end
  end

end;


procedure TLinCryptWindow.BdecClick(Sender: TObject);
var i,order:integer;
    test:boolean;
begin
Minput.clear;
test := true;
order := 0;

for i := 1 to Length(Tkey.Text) do
begin
  if Tkey.Text[i] in ['0'..'9'] + ['A'..'Z'] + ['a'..'z'] then test := true else
  begin
    showMessage('Password must not contain spaces or spezial characters.'+sLineBreak+
    'Password can only contain capitalized and uncapitalize letters as well as numbers.'+sLineBreak+
    'Please click OK and use another password.');
    test := false;
    exit;
  end;
  order := order + ord(Tkey.Text[i]);
end;
order := order mod 4; //mod 5;

if test then
  begin
    case order of
    0: Minput.Text := pseudoRand(vigenere(caesar(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true);
    1: Minput.Text := vigenere(caesar(pseudoRand(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true);
    2: Minput.Text := caesar(vigenere(caesar(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true);
    3: Minput.Text := pseudoRand(vigenere(pseudoRand(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true);
    //4: Minput.Text := rotation(vigenere(caesar(pseudoRand(Moutput.Text, Tkey.Text, true), Tkey.Text, true), Tkey.Text, true),Tkey.Text);
    end
  end

end;

procedure TLinCryptWindow.BclipClick(Sender: TObject);
begin
     Moutput.SelectAll;
     Moutput.CopyToClipboard;
end;

procedure TLinCryptWindow.HelpClick(Sender: TObject);
begin
   ShellExecute(0, 'open', pchar(ExtractFilePath(Application.ExeName) + 'help.pdf'), nil, nil,sw_ShowNormal);
end;

procedure TLinCryptWindow.AboutClick(Sender: TObject);
begin
  Application.MessageBox('Author: Aaron Schade'+sLineBreak+'Date created: 25.05.2014'+sLineBreak+'Version: 1.0', 'About: LinCrypt', MB_ICONINFORMATION)
end;


end.