R0b0t1

program Encryption2;
var
  chars: array of Char;
procedure StrToIntArr(input: string; var output: TIntegerArray);
var
  sc: Integer;
  cc: Integer;

begin
  SetArrayLength(output, 0);
  SetArrayLength(output, Length(input));

  for sc := 1 to Length(input) do
    for cc := 0 to High(chars) do
      if input[sc] = chars[cc] then
        output[sc - 1] := cc;
end;

procedure IntArrToStr(input: TIntegerArray; var output: string);
var
  sc: Integer;

begin
  output := '';
  for sc := 0 to High(input) do
  begin
    if input[sc] > High(input) then
      input[sc] := input[sc] mod (High(chars) + 1)
    else if input[sc] < 0 then
      input[sc] := (((High(chars) + 1) * 10) - input[sc]) mod (High(chars) + 1);
    output := output + chars[input[sc]];
  end;
end;

procedure SToIA(input: string; var output: TIntegerArray);
var
  sc: Integer;

begin
  SetArrayLength(output, 0);
  SetArrayLength(output, Length(input));

  for sc := 1 to Length(input) do
    output[sc - 1] := Ord(input[sc]);
end;

procedure IAToS(input: TIntegerArray; var output: string);
var
  sc: Integer;

begin
  output := '';
  for sc := 0 to High(input) do
    output := output + Chr(input[sc]);
end;

procedure EncryptOffset(input: string; offset: Integer; var output: string);
var
  iTIA: TIntegerArray; // 'InputTIntegerArray' - holds the integer version of the string
  sc: Integer; // 'StringChar' - the char of the input/output string it's on

begin
  output := ''; // Reset output
  StrToIntArr(input, iTIA); // Change to TIntegerArray

  for sc := 0 to High(iTIA) do // Loop through all char's
    IncEx(iTIA[sc], offset); // Increase them by 'offset' to change their value

  IntArrToStr(iTIA, output); // Convert it back
end;

procedure DecryptOffset(input: string);
var
  cc: Integer; // 'CharChar' - the char currently being added to offset
  s: string; // Simple string holder

begin
  for cc := 0 to High(chars) do // Loop through every char available
  begin
    EncryptOffset(input, cc, s); // Use the encryption to decrypt it due to the looping nature of it - genius, eh?
    Writeln(s); // Write it out since we have no idea of the content, it will have to be browsed through to find the right one
  end;
end;

procedure EncryptSplit(input: string; var output: string);
var
  iTIA: TIntegerArray; // 'InputTintegerArray' - holds the integer version of the input string
  oTIA: TIntegerArray; // 'OutputTintegerArray' - holds the integer version of the output string
  sc: Integer; // 'StringChar' - the char of the input string currently being decrypted

begin
  output := ''; // Reset output
  StrToIntArr(input, iTIA);
  SetArrayLength(oTIA, (High(iTIA) + 1) * 2); // Double the length as each char is split into 2, so takes up twice as much space

  for sc := 0 to High(iTIA) do // Loop through all of the characters in the integer string
  begin
    oTIA[(sc * 2) + 1] := Random(iTIA[sc]); // Set the second of each pair to a random value below the actual
    oTIA[sc * 2] := iTIA[sc] - oTIA[(sc * 2) + 1]; // Subtract the random char from the actual char so that it can be decrypted by combining
  end;

  IntArrToStr(oTIA, output); // Convert back to string
end;

procedure DecryptSplit(input: string; var output: string);
var
  iTIA: TIntegerArray; // 'InputTintegerArray' - holds the integer version of the input string
  oTIA: TIntegerArray; // 'OutputTintegerArray' - holds the integer version of the output string
  sc: Integer; // 'StringChar' - the char of the input string currently being decrypted

begin
  output := ''; // Reset output
  StrToIntArr(input, iTIA); // Convert input to integer array
  SetArrayLength(oTIA, (High(iTIA) + 1) div 2); // Half the length as each pair of chars is combined, so takes up half as much space

  for sc := 0 to High(oTIA) do // Loop through all of the characters in the integer string
    oTIA[sc] := iTIA[(sc * 2) + 1] + iTIA[sc * 2]; // Simply add them together

  IntArrToStr(oTIA, output); // Convert back to string
end;

procedure EncryptMD5(input: string; var output: string);
begin
  output := ''; // Reset output
  output := MD5(input); // Convert it to MD5 hash
end;

// Currently doesn't work fully but very close to
procedure DecryptMD5(input: string; var output: TStringArray);
var
  pl: Integer;
  s: string;
  i: Int64;
  pli: Integer;

begin
  while true do
  begin
    Inc(pl); // Used to make it an infite for loop
    SetLength(s, pl); // Change the length of 's' to current attempting length
    while i <= Round(Pow(High(chars) + 1, pl)) - 1 do // Int64's don't work in for loops, so replaced with a while
    begin
      for pli := 1 to pl do // 'pli' refers to current char it's on, so runs through all of them
        s[pli] := chars[Floor(i div Pow(High(chars) + 1, pli - 1)) mod (High(chars) + 1)]; // Very complicated - unexplainable possibly
      if MD5(s) = input then // Check to see if the made pass collides
      begin
        SetArrayLength(output, High(output) + 2); // Increase output array
        output[High(output)] := s; // Add the collision on
        Writeln(output[High(output)]); // Write it out
        if not StrToBoolDef(Readln('Continue?'), False) then // Check to see if it should continue
          Exit; // Exit if they choose not to continue
      end;
      if i mod 121212 = 0 then // Write out current string and what it's on every 121212 string combonations
        Writeln('Another 121,212 (' + IntToStr(i) + ') - ' + s + '...');
      i := i + 1; // Increase 'i', not Inc as it doesn't work with 'i'
    end;
  end;
end;

procedure EncryptKey(input: string; key: string; var output: string);
var
  sc: Integer; // 'StringChar' - the char of the input string currently being encrypted

begin
  output := input; // We adjust the output which will be the same length

  for sc := 1 to Length(input) do // Run through all the chars
        output[sc] := Chr(Ord(input[sc]) + Ord(key[(sc - 1) mod Length(key) + 1])); // Change the char to char+key using mod to loop it around
end;

procedure DecryptKey(input: string; matchText: string; var output: string);
var
  s: string; // Stores the current key
  sc, si, ei: Integer; // 'StringChar' - char of the string currently on, 'StartInt' - the ascii char to start on, 'EndInt' - the ascii char to end on
begin
  si := 32; // Ascii value to start on
  ei := 126; // " to end on
  s := Chr(si) + Chr(si); // Set the key initially to 2 start char's
  SetLength(output, Length(s)); // 'output' will be the same length as 'input', so set it to the same length
  repeat // Loop that increments key length
    repeat // Loop that increments char's
      s[Length(s)] := Chr(Ord(s[Length(s)]) + 1); // Increase last char by 1 ascii value
      for sc := 1 to Length(input) do // Loop through all char's of input
        output[sc] := Chr(Ord(input[sc]) - Ord(s[(sc - 1) mod Length(s) + 1])); // Set the individual char's of output to input - current key, which loops with mod
      if Pos(matchText, output) > 0 then // Checks to see if the matchText is there
      begin
        Writeln(s); // Writes out the key if it does
        Exit; // and exits to stop it running
      end;
      for sc := 1 to Length(s) do // Loop through the entire key char's
        if Ord(s[sc]) < ei then // If it is smaller than 'ei', break
          Break; // because that means it doesn't need to increase key size
      if sc = (Length(s) + 1) then // 'for' loops leave values 1 higher than the 'to' value, so this means 'key' needs to be increased in length
        Break; // Break out of the char loop to the key increasing loop
      for sc := Length(s) downto 2 do // Run through all the char's from last to first
        if Ord(s[sc]) >= ei then // If it is bigger than 'ei'
        begin
          s[sc] := Chr(si); // Reset it to 'si'
          s[sc-1] := Chr(Ord(s[sc-1]) + 1); // and increase the next char (reverse order) by 1
        end;
    until false // End char incrementing loop
    s := s + Chr(si); // Add another char onto the end (I use 'si' char, but any can be used)
    for sc := 1 to Length(s) do // Loop through all of the char's
      s[sc] := Chr(si); // and reset them to 'si'
  until false // End key length incrementing loop
end;

procedure EncryptShrShl(input: string; var output: string);
var
  sc: Integer;
begin
  SetLength(output, Length(input));
  for sc := 1 to Length(input) do
    output[sc] := Chr(Ord(input[sc])shl 1);
end;

procedure DecryptShrShl(input: string);
var
  sc, shift: Integer;
  s: string;
begin
  SetLength(s, Length(input));
  for shift := 1 to 3 do
  begin
    for sc := 1 to Length(input) do
      s[sc] := Chr(Ord(input[sc])shr shift);
    Writeln('R' + IntToStr(shift) + ':' + s);
  end;
end;

procedure EncryptIncrement(input: string; var output: string);
var
  sc: Integer;

begin
  SetLength(output, Length(input));
  for sc := 1 to Length(input) do
    output[sc] := Chr(Ord(input[sc]) + sc);
end;

procedure DecryptIncrement(input: string; var output:string);
var
  sc: Integer;
begin
  SetLength(output, Length(input));
  for sc := 1 to Length(input) do
    output[sc] := Chr(Ord(input[sc]) - sc);
end;


var
  s: string;

begin
  ClearDebug;
end.