SHARE
TWEET

TI3 17.11 13:00

a guest Nov 17th, 2019 100 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7.    System.Classes, Vcl.Graphics,
  8.    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math, Vcl.Grids;
  9.  
  10. type
  11.    TBuffer = array [1 .. 1024 * 128] of Byte;
  12.    TIntBuffer = array [1 .. 1024 * 128] of Integer;
  13.    TIntArray = array of Int64;
  14.    TBoolArray = array of Boolean;
  15.    TBytesToPrint = array of Byte;
  16.    TIntToPrint = array of Integer;
  17.  
  18.    TForm2 = class(TForm)
  19.       mmPlainText: TMemo;
  20.       Файл: TButton;
  21.       OpenDialog: TOpenDialog;
  22.       edtP: TEdit;
  23.       Button2: TButton;
  24.       Label2: TLabel;
  25.       ListBox: TListBox;
  26.       Button4: TButton;
  27.       edtG: TEdit;
  28.       Label3: TLabel;
  29.       edtX: TEdit;
  30.       Label4: TLabel;
  31.       Label5: TLabel;
  32.       edtOpenKey: TEdit;
  33.       Label6: TLabel;
  34.       Label7: TLabel;
  35.       edtPrivateKey: TEdit;
  36.       Label8: TLabel;
  37.       edtK: TEdit;
  38.       Button6: TButton;
  39.       sgOutput: TStringGrid;
  40.     Label1: TLabel;
  41.     Label9: TLabel;
  42.       procedure ProcessCode(FileName: string);
  43.       procedure ФайлClick(Sender: TObject);
  44.       procedure Button2Click(Sender: TObject);
  45.       procedure Button4Click(Sender: TObject);
  46.       procedure edtPKeyPress(Sender: TObject; var Key: Char);
  47.       procedure CheckEnteredNumber(Sender: TObject; Ident: Char;
  48.         var Number: string; BottomLine: Integer; TopLine: Int64);
  49.       procedure FormCreate(Sender: TObject);
  50.       procedure ListBoxClick(Sender: TObject);
  51.       procedure edtXKeyPress(Sender: TObject; var Key: Char);
  52.       procedure CheckEnteredNumberExt(Sender: TObject; Ident: Char;
  53.         var Number: string; BottomLine: Integer; TopLine: Int64);
  54.       procedure edtKKeyPress(Sender: TObject; var Key: Char);
  55.       procedure Button6Click(Sender: TObject);
  56.    private
  57.       { Private declarations }
  58.    public
  59.       { Public declarations }
  60.    end;
  61.  
  62. var
  63.    Form2: TForm2;
  64.    NumberP, NumberX, NumberG, NumberK: string;
  65.    Buffer: TBuffer;
  66.    StreamSize: Int64;
  67.    fNameCipher, fNameDecipher: string;
  68.    f, fcipher, fDecipher: file;
  69.  
  70. const
  71.    AMOUNT_ROOTS = 10000;
  72.    cBytesMax = 128;
  73.  
  74. implementation
  75.  
  76. {$R *.dfm}
  77.  
  78. function IsPrimeNumber(Number: Int64): Boolean;
  79. var
  80.    i: Integer;
  81. begin
  82.    result := false;
  83.    if not Odd(Number) and (Number <> 2) then
  84.       Exit;
  85.    i := 3;
  86.    while i <= Sqrt(Number) do
  87.    begin
  88.       if Number mod i = 0 then
  89.          Exit;
  90.       inc(i, 2);
  91.    end;
  92.    result := true;
  93. end;
  94.  
  95. function FastExp(Number, Degree, Module: Int64): Int64;
  96. var
  97.    Num, Deg, Res, TempNum: Int64;
  98. begin
  99.    Num := Number;
  100.    Deg := Degree;
  101.    Res := 1;
  102.    while Deg <> 0 do
  103.    begin
  104.       while (Deg mod 2) = 0 do
  105.       begin
  106.          Deg := Deg div 2;
  107.          TempNum := Num mod Module;
  108.          Num := (TempNum * TempNum) mod Module;
  109.       end;
  110.       Deg := Deg - 1;
  111.       Res := (Res * Num) mod Module;
  112.    end;
  113.    FastExp := Res;
  114. end;
  115.  
  116. function FastExpMul(Number, Degree, Module: Int64;
  117.   var Multiplier: Integer): Int64;
  118. var
  119.    TempRes, TempInt: Int64;
  120. begin
  121.    TempRes := FastExp(Number, Degree, Module);
  122.    TempInt := Multiplier mod Module;
  123.    FastExpMul := (TempRes * TempInt) mod Module;
  124. end;
  125.  
  126. function FastExpMulByte(Number, Degree, Module: Int64;
  127.   var Multiplier: Byte): Int64;
  128. var
  129.    TempRes, TempInt: Int64;
  130. begin
  131.    TempRes := FastExp(Number, Degree, Module);
  132.    TempInt := Multiplier mod Module;
  133.    FastExpMulByte := (TempRes * TempInt) mod Module;
  134. end;
  135.  
  136. function ExtendedGCD(a, b: Integer; var x, y, gcd: Integer): Integer;
  137. var
  138.    x1, y1: Integer;
  139. begin
  140.    If b = 0 Then
  141.    begin
  142.       gcd := a;
  143.       x := 1;
  144.       y := 0;
  145.       Exit
  146.    end;
  147.    ExtendedGCD(b, a mod b, x1, y1, gcd);
  148.    x := y1;
  149.    y := x1 - (a div b) * y1;
  150.    result := gcd;
  151. end;
  152.  
  153. function FindPrimeDividers(Number: Int64; var Amount: Int64): TIntArray;
  154. var
  155.    i, j, k: Int64;
  156.    PrimeArray, ResArray: TIntArray;
  157. begin
  158.    SetLength(PrimeArray, Number);
  159.    for i := 2 to Number do
  160.       if Number mod i = 0 then
  161.       begin
  162.          k := 0;
  163.          for j := 2 to i div 2 do
  164.             if i mod j = 0 then
  165.                k := k + 1;
  166.          if k = 0 then
  167.          begin
  168.             PrimeArray[Amount] := i;
  169.             inc(Amount);
  170.          end;
  171.       end;
  172.    SetLength(ResArray, Amount);
  173.    for i := 0 to Amount - 1 do
  174.       ResArray[i] := PrimeArray[i];
  175.    FindPrimeDividers := ResArray;
  176. end;
  177.  
  178. function FindPrimRoots(p: Int64): TIntArray;
  179. var
  180.    PrimDeviders, PrimRoots, ResArray: TIntArray;
  181.    BoolArray: TBoolArray;
  182.    i, j, PrimDivNum, PrimRootNum: Int64;
  183. begin
  184.    SetLength(PrimDeviders, p);
  185.    SetLength(PrimRoots, p);
  186.    SetLength(BoolArray, p);
  187.    for i := 0 to p - 1 do
  188.       BoolArray[i] := true;
  189.    PrimDivNum := 0;
  190.    PrimRootNum := 0;
  191.    PrimDeviders := FindPrimeDividers(p - 1, PrimDivNum);
  192.    for i := 2 to p - 1 do
  193.    begin
  194.       for j := 1 to PrimDivNum do
  195.       begin
  196.          if (FastExp(i, round((p - 1) / PrimDeviders[j - 1]), p) = 1) then
  197.          begin
  198.             BoolArray[i] := false;
  199.             break;
  200.          end;
  201.       end;
  202.       if BoolArray[i] = true then
  203.       begin
  204.          PrimRoots[PrimRootNum] := i;
  205.          inc(PrimRootNum);
  206.       end;
  207.    end;
  208.    SetLength(ResArray, PrimRootNum);
  209.    for i := 0 to PrimRootNum - 1 do
  210.       ResArray[i] := PrimRoots[i];
  211.    FindPrimRoots := ResArray;
  212. end;
  213.  
  214. procedure TForm2.Button2Click(Sender: TObject);
  215. var
  216.    i: Integer;
  217.    OutputArray: TIntArray;
  218.    k: Int64;
  219. begin
  220.    CheckEnteredNumber(edtP, 'p', NumberP, 257, 9223372036854775807);
  221.    CheckEnteredNumber(edtX, 'x', NumberX, 2, StrToInt64(NumberP) - 1);
  222.    CheckEnteredNumberExt(edtK, 'k', NumberK, 2, StrToInt64(NumberP) - 1);
  223.    if (NumberP <> ' ') and (NumberX <> ' ') and (NumberK <> ' ') then
  224.    begin
  225.       SetLength(OutputArray, StrToInt64(NumberP));
  226.       OutputArray := FindPrimRoots(StrToInt64(NumberP));
  227.       i := 0;
  228.       if high(OutputArray) > AMOUNT_ROOTS then
  229.          k := AMOUNT_ROOTS
  230.       else
  231.          k := high(OutputArray);
  232.       while (i <= k) do
  233.       begin
  234.          ListBox.Items.Insert(i, inttostr(OutputArray[i]));
  235.          inc(i);
  236.       end;
  237.    end;
  238. end;
  239.  
  240. function IsPrimeButton(Number: Int64): Boolean;
  241. begin
  242.    if IsPrimeNumber(Number) then
  243.       result := true
  244.    else
  245.       result := false;
  246. end;
  247.  
  248. procedure EncryptLFSR(InputFileName, OutputFileName: string;
  249.   var Output: TIntToPrint);
  250. var
  251.    InputBuffer: array [1 .. cBytesMax div 2] of Byte;
  252.    OutputBuffer: array [1 .. cBytesMax] of Integer;
  253.    InputStream, OutputStream: TFileStream;
  254.    cBytes, i, j: Integer;
  255.    IsOutputFilled: Boolean;
  256.    y, a, k, p: Int64;
  257. begin
  258.    NumberG := Form2.edtG.text;
  259.    y := FastExp(StrToInt64(Form2.edtG.text), StrToInt64(NumberX),
  260.      StrToInt64(NumberP));
  261.    Form2.edtOpenKey.text := NumberP + ', ' + NumberG + ', ' + inttostr(y);
  262.    Form2.edtPrivateKey.text := NumberX;
  263.    a := FastExp(StrToInt64(Form2.edtG.text), StrToInt64(NumberK),
  264.      StrToInt64(NumberP));
  265.    k := StrToInt64(NumberK);
  266.    p := StrToInt64(NumberP);
  267.    InputStream := TFileStream.Create(InputFileName, fmOpenRead);
  268.    OutputStream := TFileStream.Create(OutputFileName, fmCreate);
  269.    IsOutputFilled := false;
  270.    SetLength(Output, cBytesMax);
  271.    repeat
  272.       cBytes := InputStream.ReadData(InputBuffer);
  273.       i := 1;
  274.       j := 1;
  275.       while i <= cBytes * 2 do
  276.       begin
  277.          OutputBuffer[i] := a;
  278.          OutputBuffer[i + 1] := FastExpMulByte(y, k, p, InputBuffer[j]);
  279.          if not IsOutputFilled then
  280.          begin
  281.             Output[i - 1] := OutputBuffer[i];
  282.             Output[i] := OutputBuffer[i + 1];
  283.          end;
  284.          inc(i, 2);
  285.          inc(j, 1);
  286.       end;
  287.       if not IsOutputFilled then
  288.       begin
  289.          SetLength(Output, cBytes * 2);
  290.          IsOutputFilled := true;
  291.       end;
  292.       OutputStream.WriteData(OutputBuffer, cBytes * 2 * SizeOf(Integer));
  293.    until (InputStream.Position = InputStream.Size);
  294.    InputStream.Free;
  295.    OutputStream.Free;
  296. end;
  297.  
  298. procedure DecryptLFSR(InputFileName, OutputFileName: string;
  299.   var Output: TBytesToPrint);
  300. var
  301.    InputBuffer: array [1 .. cBytesMax] of Integer;
  302.    OutputBuffer: array [1 .. cBytesMax div 2] of Byte;
  303.    InputStream, OutputStream: TFileStream;
  304.    cBytes, i, j: Integer;
  305.    IsOutputFilled: Boolean;
  306.    Degr: Int64;
  307. begin
  308.    Degr := (StrToInt64(NumberP) - 1 - StrToInt64(NumberX));
  309.    InputStream := TFileStream.Create(InputFileName, fmOpenRead);
  310.    OutputStream := TFileStream.Create(OutputFileName, fmCreate);
  311.    IsOutputFilled := false;
  312.    SetLength(Output, cBytesMax div 2);
  313.    repeat
  314.       cBytes := InputStream.ReadData(InputBuffer);
  315.       i := 1;
  316.       j := 1;
  317.       while i <= cBytes div 4 do
  318.       begin
  319.          OutputBuffer[j] := FastExpMul(InputBuffer[i], Degr,
  320.            StrToInt64(NumberP), InputBuffer[i + 1]);
  321.          if not IsOutputFilled then
  322.          begin
  323.             Output[j - 1] := OutputBuffer[j];
  324.          end;
  325.          inc(i, 2);
  326.          inc(j, 1);
  327.       end;
  328.       if not IsOutputFilled then
  329.       begin
  330.          SetLength(Output, cBytes div 2);
  331.          IsOutputFilled := true;
  332.       end;
  333.       OutputStream.WriteData(OutputBuffer, cBytes div 2 div SizeOf(Integer));
  334.    until (InputStream.Position = InputStream.Size);
  335.    InputStream.Free;
  336.    OutputStream.Free;
  337. end;
  338.  
  339. procedure TForm2.Button4Click(Sender: TObject);
  340. var
  341.    y, a, k, p, kl: Int64;
  342.    arr: TBuffer;
  343.    i, j: Integer;
  344.    ArrayB: TIntBuffer;
  345.    Stream: TFileStream;
  346. begin
  347.    NumberG := edtG.text;
  348.    y := FastExp(StrToInt64(edtG.text), StrToInt64(NumberX),
  349.      StrToInt64(NumberP));
  350.    edtOpenKey.text := NumberP + ', ' + NumberG + ', ' + inttostr(y);
  351.    edtPrivateKey.text := NumberX;
  352.    a := FastExp(StrToInt64(edtG.text), StrToInt64(NumberK),
  353.      StrToInt64(NumberP));
  354.    k := StrToInt64(NumberK);
  355.    p := StrToInt64(NumberP);
  356.    for i := 1 to StreamSize do
  357.    begin
  358.       arr[i] := Buffer[i];
  359.    end;
  360.    kl := StreamSize;
  361.    i := 1;
  362.    j := 1;
  363.    while i <= 2 * kl do
  364.    begin
  365.       ArrayB[i] := a;
  366.       ArrayB[i + 1] := FastExpMulByte(y, k, p, arr[j]);
  367.       inc(i, 2);
  368.       inc(j, 1);
  369.    end;
  370.    Stream := TFileStream.Create(fNameCipher, fmCreate);
  371.    Stream.Write(ArrayB[1], 2 * kl * SizeOf(Integer));
  372.    Stream.Free;
  373.    ShowMessage('Successfully ciphered');
  374. end;
  375.  
  376. procedure TForm2.Button6Click(Sender: TObject);
  377. var
  378.    Output: TBytesToPrint;
  379. begin
  380.    if OpenDialog.Execute then
  381.    begin
  382.       DecryptLFSR(OpenDialog.FileName, fNameDecipher, Output);
  383.    end;
  384. end;
  385.  
  386. procedure TForm2.CheckEnteredNumber(Sender: TObject; Ident: Char;
  387.   var Number: string; BottomLine: Integer; TopLine: Int64);
  388. begin
  389.    with Sender as TEdit do
  390.       if Number <> ' ' then
  391.       begin
  392.          if (StrToInt64(Number) >= BottomLine) and (StrToInt64(Number) < TopLine)
  393.          then
  394.          begin
  395.             if not IsPrimeButton(StrToInt64(Number)) then
  396.             begin
  397.                ShowMessage('Число ' + Ident + ' должно быть простым');
  398.                Number := ' ';
  399.                Clear;
  400.             end;
  401.          end
  402.          else
  403.          begin
  404.             ShowMessage('Введите число ' + Ident + ' больше ' +
  405.               inttostr(BottomLine - 1) + ' меньше ' + inttostr(TopLine));
  406.             Number := ' ';
  407.             Clear;
  408.          end;
  409.       end
  410.       else
  411.       begin
  412.          ShowMessage('Введите простое число ' + Ident);
  413.          Number := ' ';
  414.          Clear;
  415.       end;
  416. end;
  417.  
  418. procedure TForm2.CheckEnteredNumberExt(Sender: TObject; Ident: Char;
  419.   var Number: string; BottomLine: Integer; TopLine: Int64);
  420. var
  421.    x, y, gcd: Integer;
  422. begin
  423.    with Sender as TEdit do
  424.    begin
  425.       if Number <> ' ' then
  426.       begin
  427.          if (StrToInt64(Number) >= BottomLine) and (StrToInt64(Number) < TopLine)
  428.          then
  429.          begin
  430.             if not IsPrimeButton(StrToInt64(Number)) then
  431.             begin
  432.                ShowMessage('Число ' + Ident + ' должно быть простым');
  433.                Number := ' ';
  434.                Clear;
  435.             end;
  436.          end
  437.          else
  438.          begin
  439.             ShowMessage('Введите число ' + Ident + ' больше ' +
  440.               inttostr(BottomLine - 1) + ' меньше ' + inttostr(TopLine));
  441.             Number := ' ';
  442.             Clear;
  443.          end;
  444.       end
  445.       else
  446.       begin
  447.          ShowMessage('Введите простое число ' + Ident);
  448.          Number := ' ';
  449.          Clear;
  450.       end;
  451.       if NumberK <> ' ' then
  452.          if ExtendedGCD(StrToInt64(NumberK), StrToInt64(NumberP) - 1, x, y,
  453.            gcd) <> 1 then
  454.          begin
  455.             ShowMessage('Введите число k взаимно простое с p - 1');
  456.             Number := ' ';
  457.             Clear;
  458.          end;
  459.    end;
  460. end;
  461.  
  462. procedure TForm2.edtKKeyPress(Sender: TObject; var Key: Char);
  463. const
  464.    Digit: set of Char = ['0' .. '9'];
  465. begin
  466.    if Key in Digit then
  467.       NumberK := NumberK + Key;
  468.    if Key = #8 then
  469.       NumberK := ' ';
  470. end;
  471.  
  472. procedure TForm2.edtPKeyPress(Sender: TObject; var Key: Char);
  473. const
  474.    Digit: set of Char = ['0' .. '9'];
  475. begin
  476.    if Key in Digit then
  477.       NumberP := NumberP + Key;
  478.    if Key = #8 then
  479.       NumberP := ' ';
  480. end;
  481.  
  482. procedure TForm2.edtXKeyPress(Sender: TObject; var Key: Char);
  483. const
  484.    Digit: set of Char = ['0' .. '9'];
  485. begin
  486.    if Key in Digit then
  487.       NumberX := NumberX + Key;
  488.    if Key = #8 then
  489.       NumberX := ' ';
  490. end;
  491.  
  492. procedure OutputSource(InputFileName: string;
  493.   var Output: TBytesToPrint);
  494. var
  495.    InputBuffer: array [1 .. cBytesMax div 2] of Byte;
  496.    OutputBuffer: array [1 .. cBytesMax] of Integer;
  497.    InputStream, OutputStream: TFileStream;
  498.    cBytes, i, j: Integer;
  499.    IsOutputFilled: Boolean;
  500.    y, a, k, p: Int64;
  501. begin
  502.    InputStream := TFileStream.Create(InputFileName, fmOpenRead);
  503.    IsOutputFilled := false;
  504.    SetLength(Output, cBytesMax div 2);
  505.    //repeat
  506.       cBytes := InputStream.ReadData(InputBuffer);
  507.       if Length(Output) > 0 then
  508.       begin
  509.          Form2.sgOutput.RowCount := cBytes + 1;
  510.          i := Low(InputBuffer);
  511.          while i <= cBytes do
  512.          begin
  513.             // Form2.sgOutput.Cells[0, i] := inttostr(InputBuffer[i]);
  514.             Output[i-1] := InputBuffer[i];
  515.             Form2.sgOutput.Cells[0, i] := inttostr(Output[i-1]);
  516.             inc(i);
  517.          end;
  518.       end;
  519.       Form2.Label1.Caption := inttostr(i);
  520.       {if not IsOutputFilled then
  521.       begin
  522.          SetLength(Output, cBytes);
  523.          IsOutputFilled := true;
  524.       end;}
  525.       //OutputStream.WriteData(OutputBuffer, cBytes);
  526.    //until (InputStream.Position = InputStream.Size);
  527.    InputStream.Free;
  528.    //OutputStream.Free;
  529. end;
  530.  
  531. procedure TForm2.ProcessCode(FileName: string);
  532. var
  533.    Stream: TFileStream;
  534.    i: Integer;
  535.    Size, ByteCounter, LinesCounter: Integer;
  536. begin
  537.    { Stream := TFileStream.Create(FileName, fmOpenRead);
  538.      Size := Stream.ReadData(Buffer);
  539.      Stream.Position := 0;
  540.      ByteCounter := 0;
  541.      LinesCounter := 1;
  542.      StreamSize := Stream.Size;
  543.  
  544.      if Length(Output) > 0 then
  545.      begin
  546.      sgOutput.RowCount := Length(Output) div 2 + 1;
  547.      i := Low(Output);
  548.      j := Low(Output);
  549.      while i <= High(Output) do
  550.      begin
  551.      sgOutput.Cells[1, j] := inttostr(Output[i]) + ', ' +
  552.      inttostr(Output[i + 1]);
  553.      inc(i, 2);
  554.      inc(j);
  555.      end;
  556.      end;
  557.  
  558.      for i := 0 to Size - 1 do
  559.      begin
  560.      inc(ByteCounter);
  561.      if ByteCounter <= 8 then
  562.      mmPlainText.text := mmPlainText.text +
  563.      inttostr(Buffer[ByteCounter + 8 * (LinesCounter - 1)]) + ' '
  564.      else if LinesCounter < 21 then
  565.      begin
  566.      ByteCounter := 0;
  567.      inc(LinesCounter);
  568.      mmPlainText.Lines.Add
  569.      (inttostr(Buffer[ByteCounter + 8 * LinesCounter]));
  570.      inc(ByteCounter);
  571.      mmPlainText.text := mmPlainText.text + ' ';
  572.      end;
  573.      end;
  574.      Stream.Free; }
  575.  
  576.    fNameCipher := FileName;
  577.    i := Length(fNameCipher);
  578.    while fNameCipher[i] <> '.' do
  579.       Dec(i);
  580.    Insert('  CIPHER', fNameCipher, i);
  581.    Assignfile(fcipher, fNameCipher);
  582.    fNameDecipher := fNameCipher;
  583.    Insert(' DE', fNameDecipher, pos('CIPHER', fNameDecipher));
  584.    Assignfile(fDecipher, fNameDecipher);
  585. end;
  586.  
  587. procedure TForm2.ФайлClick(Sender: TObject);
  588. var
  589.    Output: TIntToPrint;
  590.    Source: TBytesToPrint;
  591.    i, j: Integer;
  592. begin
  593.    if OpenDialog.Execute then
  594.    begin
  595.       mmPlainText.Clear;
  596.       ProcessCode(OpenDialog.FileName);
  597.       OutputSource(OpenDialog.FileName, Source);
  598.       EncryptLFSR(OpenDialog.FileName, fNameCipher, Output);
  599.       if Length(Output) > 0 then
  600.       begin
  601.          sgOutput.RowCount := Length(Output) div 2  + 1;
  602.          i := Low(Output);
  603.          j := Low(Output);
  604.          while i <= High(Output) do
  605.          begin
  606.             sgOutput.Cells[1, j + 1] := inttostr(Output[i]) + ', ' +
  607.               inttostr(Output[i + 1]);
  608.             inc(i, 2);
  609.             inc(j);
  610.          end;
  611.       end;
  612.       Form2.Label9.Caption := inttostr(j);
  613.    end;
  614. end;
  615.  
  616. procedure TForm2.FormCreate(Sender: TObject);
  617. begin
  618.    NumberP := ' ';
  619.    NumberX := ' ';
  620. end;
  621.  
  622. procedure TForm2.ListBoxClick(Sender: TObject);
  623. var
  624.    i: Integer;
  625. begin
  626.    for i := 0 to ListBox.Items.Count - 1 do
  627.       if ListBox.Selected[i] then
  628.          edtG.text := ListBox.Items[i];
  629. end;
  630.  
  631. 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