SHARE
TWEET

Untitled

a guest Sep 15th, 2019 87 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Project2;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8.   System.SysUtils;
  9.  
  10. const
  11.   N = 4;
  12. Type
  13.   Arr = array of array of char;
  14.   arr2 = array of integer;
  15.   Arr3 = array of array of Boolean;
  16. var
  17.   Str: string;
  18.   i: Integer;
  19.   FirstArr: arr2;
  20.   Alphabet: set of char;
  21.  
  22. function ArrToStr(TempArr: Arr): string;
  23. var
  24.    i, j: Integer;
  25.    TempStr: string;
  26. begin
  27.    SetLength(TempArr, n, n);
  28.    for i := 0 to n - 1 do
  29.       for j := 0 to n - 1 do
  30.          TempStr := TempStr + TempArr[i, j];
  31.    ArrToStr := TempStr;
  32. end;
  33.  
  34. function StrToArr(TempStr: string): Arr;
  35. var
  36.    i, j, k: Integer;
  37.    TempArr: Arr;
  38. begin
  39.    k := 1;
  40.    SetLength(TempArr, n, n);
  41.    for i := 0 to n - 1 do
  42.       for j := 0 to n - 1 do
  43.       begin
  44.          TempArr[i, j] := TempStr[k];
  45.          inc(k);
  46.       end;
  47.    StrToArr := TempArr;
  48. end;
  49.  
  50. function GetNext(MyStr: string; MyArr: arr; amount: Integer): string;
  51. var
  52.    counter: Integer;
  53.    i, j, k, f: Integer;
  54.    CurrentI, CurrentJ: Integer;
  55.    NextI, NextJ: Integer;
  56.    str, str2: string;
  57. begin
  58.    counter := 0;
  59.    k := amount  + 1;
  60.    for i := 0 to Length(MyStr) - amount - 1 do
  61.    begin
  62.       CurrentI := FirstArr[counter];
  63.       CurrentJ := FirstArr[counter + 1];
  64.       NextI :=  CurrentJ;
  65.       NextJ :=  N - CurrentI - 1;
  66.       MyArr[Nexti, Nextj] := MyStr[k];
  67.       inc(k);
  68.       FirstArr[counter + n * 2] := Nexti;
  69.       FirstArr[counter + n * 2 + 1] := Nextj;
  70.       inc(counter, 2);
  71.       exclude(Alphabet, AnsiChar(MyArr[Nexti, Nextj]));
  72.    end;
  73.    for i := 97 to 122 do
  74.       if (chr(i) in Alphabet)  then
  75.             str2 := str2 + chr(i);
  76.    for i := 0 to n-1 do
  77.        for j := 0 to n-1 do
  78.           if MyArr[i,j] = '' then
  79.           begin
  80.              randomize;
  81.              f := random(Length(str2)) + 1;
  82.              MyArr[i,j] := str2[f];
  83.           end;
  84.    str := ArrToStr(MyArr);
  85.    GetNext := str;
  86. end;
  87.  
  88. function Deshifr(TempArr: Arr; n1: integer): string;
  89. var
  90.    counter: Integer;
  91.    i: Integer;
  92.    CurrentI, CurrentJ: Integer;
  93.    NextI, NextJ: Integer;
  94.    TempStr: string;
  95. begin
  96.    counter := 0;
  97.    for i := 0 to n1 - 1 do
  98.    begin
  99.       CurrentI := FirstArr[counter];
  100.       CurrentJ := FirstArr[counter + 1];
  101.       TempStr := TempStr + TempArr[CurrentI, CurrentJ];
  102.       NextI :=  CurrentJ;
  103.       NextJ :=  N - CurrentI - 1;
  104.       FirstArr[counter + n * 2] := Nexti;
  105.       FirstArr[counter + n * 2 + 1] := Nextj;
  106.       inc(counter, 2);
  107.    end;
  108.    Deshifr := TempStr;
  109. end;
  110.  
  111. function GetString(MyStr: string): string;
  112. var
  113.   Starti, Startj: Integer;
  114.   Nexti, Nextj: Integer;
  115.   MyArr: Arr;
  116.   amount, k, i, j, f: Integer;
  117.   BoolMatrix: Arr3;
  118.   cc: integer;
  119.   firstcc: integer;
  120. begin
  121.    Alphabet := ['a'..'z', 'A'..'Z'];
  122.    randomize;
  123.    k:=1;
  124.    if Length(MyStr) < N then
  125.      amount := Length(MyStr)
  126.    else
  127.      amount := N;
  128.    SetLength(FirstArr, Length(MyStr)*2);
  129.    firstcc := 0;
  130.    SetLength(BoolMatrix, n, n);
  131.    for i := 0 to n-1 do
  132.        for j := 0 to n-1 do
  133.           BoolMatrix[i,j] := False;
  134.    SetLength(MyArr, n, n);
  135.    for i := 0 to amount - 1 do
  136.    begin
  137.      repeat
  138.         f := random(N);
  139.         j := random(N);
  140.      until (BoolMatrix[f,j] = False);
  141.      BoolMatrix[f,j] := True;
  142.      cc := 1;
  143.      Starti := f;
  144.      Startj := j;
  145.      repeat
  146.        Nexti :=  Startj;
  147.        Nextj :=  N - Starti - 1;
  148.        if (Starti + Nextj = n - 1) then
  149.        begin
  150.          BoolMatrix[Nexti,Nextj] := True;
  151.          inc(cc);
  152.        end;
  153.        Starti := Nexti;
  154.        Startj := Nextj;
  155.      until cc = amount;
  156.      MyArr[f, j] := MyStr[k];
  157.      exclude(Alphabet, AnsiChar(MyArr[f, j]));
  158.      FirstArr[firstcc] := f;
  159.      FirstArr[firstcc + 1] := j;
  160.      inc(firstcc, 2);
  161.      inc(k);
  162.    end;
  163.    GetString := GetNext(MyStr, MyArr, amount);
  164. end;
  165.  
  166. function LowCase(ch: char): char;
  167. begin
  168.    if ch in ['A'..'Z'] then
  169.       LowCase := chr(ord(ch) + 32)
  170.    else
  171.       LowCase := ch;
  172. end;
  173.  
  174. var
  175.    mystr: string;
  176.    NewArr: Arr;
  177.    NewStr: string;
  178.    myFile: TextFile;
  179.    letter: char;
  180.    text: string;
  181. begin
  182.    AssignFile(myFile, 'Test.txt');
  183.    Reset(myFile);
  184.    while not Eof(myFile) do
  185.    begin
  186.       read(myFile, letter);
  187.       if (letter in (['a'..'z', 'A'..'Z'])) then
  188.       begin
  189.          letter := LowCase(letter);
  190.          Str := Str + letter;
  191.       end;
  192.    end;
  193.    CloseFile(myFile);
  194.    mystr := GetString(Str);
  195.    for i := 1 to Length(mystr) do
  196.       write(mystr[i]);
  197.    NewArr := StrToArr(mystr);
  198.    NewStr := Deshifr(NewArr, Length(Str));
  199.    writeln;
  200.    for i := 1 to Length(NewStr) do
  201.       write(NewStr[i]);
  202.    readln;
  203. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top