SHARE
TWEET

Resh

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