SHARE
TWEET

Reshetka

a guest Sep 15th, 2019 86 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  7.   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
  8.   FMX.Objects, FMX.Controls.Presentation, FMX.StdCtrls;
  9.  
  10. type
  11.   TForm2 = class(TForm)
  12.     btnDecrypt: TButton;
  13.     Button3: TButton;
  14.     btnEncrypt: TButton;
  15.     procedure FormCreate(Sender: TObject);
  16.     procedure Button1Click(Sender: TObject);
  17.     procedure btnEncryptClick(Sender: TObject);
  18.     procedure btnDecryptClick(Sender: TObject);
  19.     procedure Button3Click(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. type
  27.   Arr = array of array of char;
  28.   BoolArr = array of array of Boolean;
  29.   IntArr = array of Integer;
  30. const
  31.   N = 4;
  32. var
  33.   Form2: TForm2;
  34.   Counter: Integer;
  35.   TempArr: IntArr;
  36.   MyArr: Arr;
  37.   MaskStr: string;
  38.   StartIndex: Integer;
  39.  
  40. implementation
  41.  
  42. {$R *.fmx}
  43.  
  44. function ExtractString(SourceStr: string): string;
  45. var
  46.    ExtractStr: string;
  47.    i: Integer;
  48. begin
  49.    for i := 1 to Length(SourceStr) do
  50.       if (MaskStr[i] in (['a'..'z', 'A'..'Z'])) then
  51.          ExtractStr := ExtractStr + SourceStr[i];
  52.    ExtractString := ExtractStr;
  53. end;
  54.  
  55. function LowCase(ch: char): char;
  56. begin
  57.    if ch in ['A'..'Z'] then
  58.       LowCase := chr(ord(ch) + 32)
  59.    else
  60.       LowCase := ch;
  61. end;
  62.  
  63. function GetMask(Str: string): string;
  64. var
  65.    i: Integer;
  66. begin
  67.    for i := 1 to Length(Str) do
  68.       if (Str[i] in (['a'..'z', 'A'..'Z'])) then
  69.          Str[i] := 'w';
  70.    GetMask := Str;
  71. end;
  72.  
  73. function ReadFromFile(FileName: string): string;
  74. var
  75.    i: Integer;
  76.    MyFile: TextFile;
  77.    letter: char;
  78. begin
  79.    for i := 1 to Length(MaskStr) do
  80.       MaskStr := '';
  81.    AssignFile(MyFile, FileName);
  82.    Reset(MyFile);
  83.    while not Eof(MyFile) do
  84.    begin
  85.       read(MyFile, letter);
  86.       letter := LowCase(letter);
  87.       MaskStr := MaskStr + letter;
  88.    end;
  89.    CloseFile(MyFile);
  90.    ReadFromFile := MaskStr;
  91. end;
  92.  
  93. procedure WriteToFile(Str: string; FinalStr: string; FileName: string);
  94. var
  95.    MyFile: TextFile;
  96.    i, k: Integer;
  97. begin
  98.    AssignFile(MyFile, FileName);
  99.    Rewrite(MyFile);
  100.    k := 1;
  101.    for i := 1 to Length(Str) do
  102.       if (Str[i] = 'w') then
  103.       begin
  104.          Str[i] := FinalStr[k];
  105.          inc(k);
  106.       end;
  107.    begin
  108.       Write(MyFile, str);
  109.    end;
  110.    CloseFile(MyFile);
  111. end;
  112.  
  113. function StringLength(Str: string): integer;
  114. var
  115.    Amount: Integer;
  116. begin
  117.    if Length(Str) < N then
  118.       Amount := Length(Str)
  119.    else
  120.       Amount := N;
  121.    StringLength := Amount;
  122. end;
  123.  
  124. function ArrToStr(HelpArr: Arr): string;
  125. var
  126.    i, j: Integer;
  127.    TempStr: string;
  128. begin
  129.    SetLength(HelpArr, n, n);
  130.    for i := 0 to n - 1 do
  131.       for j := 0 to n - 1 do
  132.          if (HelpArr[i, j] in ['a'..'z']) then
  133.             TempStr := TempStr + HelpArr[i, j];
  134.    ArrToStr := TempStr;
  135. end;
  136.  
  137. function FillHoles(CharArr: Arr; BooleanArr: BoolArr; Str: string): Arr;
  138. var
  139.    i, j: Integer;
  140. begin
  141.    for i := 0 to N - 1 do
  142.       for j := 0 to N - 1 do
  143.          if (BooleanArr[i, j] = True) then
  144.          begin
  145.             CharArr[i, j] := Str[StartIndex];
  146.             inc(StartIndex);
  147.             BooleanArr[i, j] := False;
  148.          end;
  149.    FillHoles := CharArr;
  150. end;
  151.  
  152. function ReadHoles(CharArr: Arr; BooleanArr: BoolArr; Str: string): string;
  153. var
  154.    i, j: Integer;
  155. begin
  156.    for i := 0 to N - 1 do
  157.       for j := 0 to N - 1 do
  158.          if (BooleanArr[i, j] = True) and (CharArr[i, j]  <> '') and (CharArr[i, j]  <> ' ') then
  159.          begin
  160.             Str := Str + CharArr[i, j];
  161.             inc(StartIndex);
  162.             BooleanArr[i, j] := False;
  163.          end;
  164.    ReadHoles := Str;
  165. end;
  166.  
  167. function MakeHole(AmountSymbols: Integer; IndArr: IntArr; var BooleanArr: BoolArr; var TempCounter: Integer): BoolArr;
  168. var
  169.    i: Integer;
  170.    CurrentI, CurrentJ: Integer;
  171.    NextI, NextJ: Integer;
  172. begin
  173.    if TempCounter = 33 then
  174.       TempCounter := 0;
  175.    for i := 0 to AmountSymbols - 1 do
  176.    begin
  177.       CurrentI := IndArr[TempCounter];
  178.       CurrentJ := IndArr[TempCounter + 1];
  179.       NextI :=  CurrentJ;
  180.       NextJ :=  N - CurrentI - 1;
  181.       BooleanArr[Currenti, Currentj] := True;
  182.       IndArr[TempCounter + N * 2] := NextI;
  183.       IndArr[TempCounter + N * 2 + 1] := NextJ;
  184.       inc(TempCounter, 2);
  185.    end;
  186.    MakeHole := BooleanArr;
  187. end;
  188.  
  189. function Encryption(AmountSymbols: Integer; Str: string; IndArr: IntArr; CharArr: Arr): string;
  190. var
  191.    i, j: Integer;
  192.    TempCounter: Integer;
  193.    EncryptStr: string;
  194.    BooleanArr: BoolArr;
  195. begin
  196.    SetLength(BooleanArr, N, N);
  197.    for i := 0 to N - 1 do
  198.       for j := 0 to N - 1 do
  199.          BooleanArr[i, j] := False;
  200.    TempCounter := 0;
  201.    for i := 0 to AmountSymbols - 1  do
  202.    begin
  203.       BooleanArr := MakeHole(N, TempArr, BooleanArr, TempCounter);
  204.       CharArr := FillHoles(CharArr, BooleanArr, Str);
  205.    end;
  206.    EncryptStr := ArrToStr(CharArr);
  207.    Encryption := EncryptStr;
  208. end;
  209.  
  210. procedure ClearMatrix(CharArr: Arr);
  211. var
  212.    i, j: Integer;
  213. begin
  214.    for i := 0 to N - 1 do
  215.       for j := 0 to N - 1 do
  216.          CharArr[i, j] := ' ';
  217. end;
  218.  
  219. procedure TForm2.btnEncryptClick(Sender: TObject);
  220. var
  221.    SourceStr, NewStr: string;
  222.    PosAm: Integer;
  223.    BlockAmount, i: Integer;
  224. begin
  225.    MaskStr := ReadFromFile('Source.txt');
  226.    SourceStr := ExtractString(MaskStr);
  227.    MaskStr := GetMask(MaskStr);
  228.    if (Length(SourceStr) div (N * N) > 0) and (Length(SourceStr) mod (N * N) = 0) then
  229.       BlockAmount :=  Length(SourceStr) div (N * N)
  230.    else
  231.       if (Length(SourceStr) <> 0) then
  232.          BlockAmount :=  Length(SourceStr) div (N * N) + 1
  233.       else
  234.          BlockAmount := 0;
  235.    if BlockAmount <> 0 then
  236.       for i := 0 to BlockAmount - 1 do
  237.       begin
  238.          if i =  BlockAmount - 1 then
  239.             ClearMatrix(MyArr);
  240.          if i < BlockAmount - 1 then
  241.             PosAm := N
  242.          else
  243.             PosAm := (Length(SourceStr) - StartIndex) div N + 1;
  244.          Counter := 0;
  245.          NewStr := NewStr + Encryption(PosAm, SourceStr, TempArr, MyArr);
  246.       end;
  247.    WriteToFile(MaskStr, NewStr, 'Encrypt.txt');
  248. end;
  249.  
  250. procedure TForm2.Button1Click(Sender: TObject);
  251. var
  252.    i: Integer;
  253. begin
  254.    Counter := 0;
  255.    for i := 0 to 2 * N - 1 do
  256.       TempArr[i] := 0;
  257. end;
  258.  
  259. function StrToArr(TempStr: string; k: Integer): Arr;
  260. var
  261.    i, j: Integer;
  262.    CharArr: Arr;
  263. begin
  264.    SetLength(CharArr, n, n);
  265.    for i := 0 to n - 1 do
  266.       for j := 0 to n - 1 do
  267.       begin
  268.          CharArr[i, j] := TempStr[k];
  269.          inc(k);
  270.       end;
  271.    StrToArr := CharArr;
  272. end;
  273.  
  274. function SortArray(AmountSymbols: Integer; IndArr: IntArr; var BooleanArr: BoolArr; var TempCounter: Integer): BoolArr;
  275. var
  276.   i, Amount: Integer;
  277.   Temper, SaveCounter, CurrentI, CurrentJ: Integer;
  278.   tempi, tempj: Integer;
  279. begin
  280.    Amount := N - 1;
  281.    dec(TempCounter, 8);
  282.    SaveCounter := TempCounter;
  283.    for i := 0 to N - 2 do
  284.    begin
  285.       Temper := Amount;
  286.       while Amount <> 0 do
  287.       begin
  288.       if IndArr[TempCounter] > IndArr[TempCounter + 2] then
  289.       begin
  290.          tempi := IndArr[TempCounter];
  291.          IndArr[TempCounter] := IndArr[TempCounter + 2];
  292.          IndArr[TempCounter + 2] := tempi;
  293.          tempj := IndArr[TempCounter + 1];
  294.          IndArr[TempCounter + 1] := IndArr[TempCounter + 3];
  295.          IndArr[TempCounter + 3] := tempj;
  296.       end;
  297.       inc(TempCounter, 2);
  298.       dec(Amount);
  299.       end;
  300.       TempCounter := SaveCounter;
  301.       Amount := Temper;
  302.       dec(Amount);
  303.    end;
  304.    if ((AmountSymbols mod n) = 0) then
  305.       AmountSymbols := 0
  306.    else
  307.       AmountSymbols := N - AmountSymbols mod N;
  308.    TempCounter := TempCounter + 2 * (N - AmountSymbols);
  309.    while AmountSymbols <> 0 do
  310.    begin
  311.       CurrentI := IndArr[TempCounter];
  312.       CurrentJ := IndArr[TempCounter + 1];
  313.       BooleanArr[Currenti, Currentj] := False;
  314.       inc(TempCounter, 2);
  315.       dec(AmountSymbols);
  316.    end;
  317.    SortArray := BooleanArr;
  318. end;
  319.  
  320. function Decryption(AmountSymbols: Integer; Str: string; IndArr: IntArr; CharArr: Arr; Itra: Integer): string;
  321. var
  322.    TempCounter: Integer;
  323.    i, j: Integer;
  324.    NewStr2: string;
  325.    NewArr: Arr;
  326.    BooleanArr: BoolArr;
  327. begin
  328.    SetLength(BooleanArr, N, N);
  329.    for i := 0 to N - 1 do
  330.       for j := 0 to N - 1 do
  331.          BooleanArr[i, j] := False;
  332.    SetLength(NewArr, N, N);
  333.    for i := 0 to N - 1 do
  334.       for j := 0 to N - 1 do
  335.          NewArr[i, j] := ' ';
  336.    TempCounter := 0;
  337.    if (AmountSymbols mod N <> 0) then
  338.       inc(AmountSymbols, N);
  339.    BooleanArr := MakeHole((AmountSymbols div N) * N, TempArr, BooleanArr, TempCounter);
  340.    if (AmountSymbols mod N <> 0) then
  341.       dec(AmountSymbols, N);
  342.    BooleanArr := SortArray(AmountSymbols, TempArr, BooleanArr, TempCounter);
  343.    NewArr := FillHoles(NewArr, BooleanArr, Str);
  344.    StartIndex := 1;
  345.    TempCounter := 0;
  346.    if (AmountSymbols mod N <> 0) then
  347.       inc(AmountSymbols, N);
  348.    for j := 0 to AmountSymbols div N - 1 do
  349.    begin
  350.        BooleanArr := MakeHole(N, TempArr, BooleanArr, TempCounter);
  351.        NewStr2 := ReadHoles(NewArr, BooleanArr, NewStr2);
  352.    end;
  353.    StartIndex := (Itra + 1) * 16 + 1;
  354.    Decryption := NewStr2;
  355. end;
  356.  
  357. procedure TForm2.btnDecryptClick(Sender: TObject);
  358. var
  359.    SourceStr: string;
  360.    BlockAmount, i, PosAm: Integer;
  361.    NewStr: string;
  362. begin
  363.    StartIndex := 1;
  364.    MaskStr := ReadFromFile('Encrypt.txt');
  365.    SourceStr := ExtractString(MaskStr);
  366.    MaskStr := GetMask(MaskStr);
  367.    if (Length(SourceStr) div (N * N) > 0) and (Length(SourceStr) mod (N * N) = 0) then
  368.       BlockAmount :=  Length(SourceStr) div (N * N)
  369.    else
  370.       if (Length(SourceStr) <> 0) then
  371.          BlockAmount :=  Length(SourceStr) div (N * N) + 1
  372.       else
  373.          BlockAmount := 0;
  374.    if BlockAmount <> 0 then
  375.    for i := 0 to BlockAmount - 1 do
  376.    begin
  377.       if i =  BlockAmount - 1 then
  378.          ClearMatrix(MyArr);
  379.       if i < BlockAmount - 1 then
  380.          PosAm := N * N
  381.       else
  382.          PosAm := (Length(SourceStr) - 16 * i);
  383.       Counter := 0;
  384.       NewStr := NewStr + Decryption(PosAm, SourceStr, TempArr, MyArr, i);
  385.    end;
  386.    WriteToFile(MaskStr, NewStr, 'Decrypt.txt');
  387. end;
  388.  
  389. procedure RandomKey();
  390. var
  391.   Starti, Startj: Integer;
  392.   Nexti, Nextj: Integer;
  393.   amount, i, j, f: Integer;
  394.   BoolMatrix: BoolArr;
  395.   cc: integer;
  396. begin
  397.    randomize;
  398.    amount := N;
  399.    //firstcc := 0;
  400.    SetLength(BoolMatrix, n, n);
  401.    for i := 0 to n-1 do
  402.        for j := 0 to n-1 do
  403.           BoolMatrix[i, j] := False;
  404.    for i := 0 to amount - 1 do
  405.    begin
  406.      repeat
  407.         f := random(N);
  408.         j := random(N);
  409.      until (BoolMatrix[f, j] = False);
  410.      BoolMatrix[f, j] := True;
  411.      cc := 1;
  412.      Starti := f;
  413.      Startj := j;
  414.      repeat
  415.        Nexti :=  Startj;
  416.        Nextj :=  N - Starti - 1;
  417.        if (Starti + Nextj = n - 1) then
  418.        begin
  419.          BoolMatrix[Nexti, Nextj] := True;
  420.          inc(cc);
  421.        end;
  422.        Starti := Nexti;
  423.        Startj := Nextj;
  424.      until cc = amount;
  425.      TempArr[Counter] := f;
  426.      TempArr[Counter + 1] := j;
  427.      inc(Counter, 2);
  428.    end;
  429. end;
  430.  
  431. procedure TForm2.Button3Click(Sender: TObject);
  432. begin
  433.    RandomKey();
  434.    btnEncrypt.Enabled := True;
  435.    btnDecrypt.Enabled := True;
  436. end;
  437.  
  438. procedure TForm2.FormCreate(Sender: TObject);
  439. var
  440.    i, j: Integer;
  441. begin
  442.    Counter := 0;
  443.    StartIndex := 1;
  444.    SetLength(TempArr, 10 * N);
  445.    SetLength(MyArr, N, N);
  446. end;
  447.  
  448. begin
  449. 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