TI3 17.11 13:50

unit Unit2;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
   System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math, Vcl.Grids;

type
   TIntArray = array of Int64;
   TBoolArray = array of Boolean;
   TBytesToPrint = array of Byte;
   TIntToPrint = array of Integer;

   TForm2 = class(TForm)
      mmPlainText: TMemo;
      Файл: TButton;
      OpenDialog: TOpenDialog;
      edtP: TEdit;
      Button2: TButton;
      Label2: TLabel;
      ListBox: TListBox;
      edtG: TEdit;
      Label3: TLabel;
      edtX: TEdit;
      Label4: TLabel;
      Label5: TLabel;
      edtOpenKey: TEdit;
      Label6: TLabel;
      Label7: TLabel;
      edtPrivateKey: TEdit;
      Label8: TLabel;
      edtK: TEdit;
      Button6: TButton;
      sgOutput: TStringGrid;
      Label1: TLabel;
      Label9: TLabel;
      procedure ProcessCode(FileName: string);
      procedure ФайлClick(Sender: TObject);
      procedure Button2Click(Sender: TObject);
      procedure edtPKeyPress(Sender: TObject; var Key: Char);
      procedure CheckEnteredNumber(Sender: TObject; Ident: Char;
        var Number: string; BottomLine: Integer; TopLine: Int64);
      procedure FormCreate(Sender: TObject);
      procedure ListBoxClick(Sender: TObject);
      procedure edtXKeyPress(Sender: TObject; var Key: Char);
      procedure CheckEnteredNumberExt(Sender: TObject; Ident: Char;
        var Number: string; BottomLine: Integer; TopLine: Int64);
      procedure edtKKeyPress(Sender: TObject; var Key: Char);
      procedure Button6Click(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   Form2: TForm2;
   NumberP, NumberX, NumberG, NumberK: string;
   fNameCipher, fNameDecipher: string;

const
   AMOUNT_ROOTS = 10000;
   cBytesMax = 128;

implementation

{$R *.dfm}

function IsPrimeNumber(Number: Int64): Boolean;
var
   i: Integer;
begin
   result := false;
   if not Odd(Number) and (Number <> 2) then
      Exit;
   i := 3;
   while i <= Sqrt(Number) do
   begin
      if Number mod i = 0 then
         Exit;
      inc(i, 2);
   end;
   result := true;
end;

function FastExp(Number, Degree, Module: Int64): Int64;
var
   Num, Deg, Res, TempNum: Int64;
begin
   Num := Number;
   Deg := Degree;
   Res := 1;
   while Deg <> 0 do
   begin
      while (Deg mod 2) = 0 do
      begin
         Deg := Deg div 2;
         TempNum := Num mod Module;
         Num := (TempNum * TempNum) mod Module;
      end;
      Deg := Deg - 1;
      Res := (Res * Num) mod Module;
   end;
   FastExp := Res;
end;

function FastExpMul(Number, Degree, Module: Int64;
  var Multiplier: Integer): Int64;
var
   TempRes, TempInt: Int64;
begin
   TempRes := FastExp(Number, Degree, Module);
   TempInt := Multiplier mod Module;
   FastExpMul := (TempRes * TempInt) mod Module;
end;

function FastExpMulByte(Number, Degree, Module: Int64;
  var Multiplier: Byte): Int64;
var
   TempRes, TempInt: Int64;
begin
   TempRes := FastExp(Number, Degree, Module);
   TempInt := Multiplier mod Module;
   FastExpMulByte := (TempRes * TempInt) mod Module;
end;

function ExtendedGCD(a, b: Integer; var x, y, gcd: Integer): Integer;
var
   x1, y1: Integer;
begin
   If b = 0 Then
   begin
      gcd := a;
      x := 1;
      y := 0;
      Exit
   end;
   ExtendedGCD(b, a mod b, x1, y1, gcd);
   x := y1;
   y := x1 - (a div b) * y1;
   result := gcd;
end;

function FindPrimeDividers(Number: Int64; var Amount: Int64): TIntArray;
var
   i, j, k: Int64;
   PrimeArray, ResArray: TIntArray;
begin
   SetLength(PrimeArray, Number);
   for i := 2 to Number do
      if Number mod i = 0 then
      begin
         k := 0;
         for j := 2 to i div 2 do
            if i mod j = 0 then
               k := k + 1;
         if k = 0 then
         begin
            PrimeArray[Amount] := i;
            inc(Amount);
         end;
      end;
   SetLength(ResArray, Amount);
   for i := 0 to Amount - 1 do
      ResArray[i] := PrimeArray[i];
   FindPrimeDividers := ResArray;
end;

function FindPrimRoots(p: Int64): TIntArray;
var
   PrimDeviders, PrimRoots, ResArray: TIntArray;
   BoolArray: TBoolArray;
   i, j, PrimDivNum, PrimRootNum: Int64;
begin
   SetLength(PrimDeviders, p);
   SetLength(PrimRoots, p);
   SetLength(BoolArray, p);
   for i := 0 to p - 1 do
      BoolArray[i] := true;
   PrimDivNum := 0;
   PrimRootNum := 0;
   PrimDeviders := FindPrimeDividers(p - 1, PrimDivNum);
   for i := 2 to p - 1 do
   begin
      for j := 1 to PrimDivNum do
      begin
         if (FastExp(i, round((p - 1) / PrimDeviders[j - 1]), p) = 1) then
         begin
            BoolArray[i] := false;
            break;
         end;
      end;
      if BoolArray[i] = true then
      begin
         PrimRoots[PrimRootNum] := i;
         inc(PrimRootNum);
      end;
   end;
   SetLength(ResArray, PrimRootNum);
   for i := 0 to PrimRootNum - 1 do
      ResArray[i] := PrimRoots[i];
   FindPrimRoots := ResArray;
end;

procedure TForm2.Button2Click(Sender: TObject);
var
   i: Integer;
   OutputArray: TIntArray;
   k: Int64;
begin
   CheckEnteredNumber(edtP, 'p', NumberP, 257, 9223372036854775807);
   CheckEnteredNumber(edtX, 'x', NumberX, 2, StrToInt64(NumberP) - 1);
   CheckEnteredNumberExt(edtK, 'k', NumberK, 2, StrToInt64(NumberP) - 1);
   if (NumberP <> ' ') and (NumberX <> ' ') and (NumberK <> ' ') then
   begin
      SetLength(OutputArray, StrToInt64(NumberP));
      OutputArray := FindPrimRoots(StrToInt64(NumberP));
      i := 0;
      if high(OutputArray) > AMOUNT_ROOTS then
         k := AMOUNT_ROOTS
      else
         k := high(OutputArray);
      while (i <= k) do
      begin
         ListBox.Items.Insert(i, inttostr(OutputArray[i]));
         inc(i);
      end;
   end;
end;

function IsPrimeButton(Number: Int64): Boolean;
begin
   if IsPrimeNumber(Number) then
      result := true
   else
      result := false;
end;

procedure EncryptLFSR(InputFileName, OutputFileName: string;
  var Output: TIntToPrint);
var
   InputBuffer: array [1 .. cBytesMax div 2] of Byte;
   OutputBuffer: array [1 .. cBytesMax] of Integer;
   InputStream, OutputStream: TFileStream;
   cBytes, i, j: Integer;
   IsOutputFilled: Boolean;
   y, a, k, p: Int64;
begin
   NumberG := Form2.edtG.text;
   y := FastExp(StrToInt64(Form2.edtG.text), StrToInt64(NumberX),
     StrToInt64(NumberP));
   Form2.edtOpenKey.text := NumberP + ', ' + NumberG + ', ' + inttostr(y);
   Form2.edtPrivateKey.text := NumberX;
   a := FastExp(StrToInt64(Form2.edtG.text), StrToInt64(NumberK),
     StrToInt64(NumberP));
   k := StrToInt64(NumberK);
   p := StrToInt64(NumberP);
   InputStream := TFileStream.Create(InputFileName, fmOpenRead);
   OutputStream := TFileStream.Create(OutputFileName, fmCreate);
   IsOutputFilled := false;
   SetLength(Output, cBytesMax);
   repeat
      cBytes := InputStream.ReadData(InputBuffer);
      i := 1;
      j := 1;
      while i <= cBytes * 2 do
      begin
         OutputBuffer[i] := a;
         OutputBuffer[i + 1] := FastExpMulByte(y, k, p, InputBuffer[j]);
         if not IsOutputFilled then
         begin
            Output[i - 1] := OutputBuffer[i];
            Output[i] := OutputBuffer[i + 1];
         end;
         inc(i, 2);
         inc(j, 1);
      end;
      if not IsOutputFilled then
      begin
         SetLength(Output, cBytes * 2);
         IsOutputFilled := true;
      end;
      OutputStream.WriteData(OutputBuffer, cBytes * 2 * SizeOf(Integer));
   until (InputStream.Position = InputStream.Size);
   InputStream.Free;
   OutputStream.Free;
end;

procedure DecryptLFSR(InputFileName, OutputFileName: string;
  var Output: TBytesToPrint);
var
   InputBuffer: array [1 .. cBytesMax] of Integer;
   OutputBuffer: array [1 .. cBytesMax div 2] of Byte;
   InputStream, OutputStream: TFileStream;
   cBytes, i, j: Integer;
   IsOutputFilled: Boolean;
   Degr: Int64;
begin
   Degr := (StrToInt64(NumberP) - 1 - StrToInt64(NumberX));
   InputStream := TFileStream.Create(InputFileName, fmOpenRead);
   OutputStream := TFileStream.Create(OutputFileName, fmCreate);
   IsOutputFilled := false;
   SetLength(Output, cBytesMax div 2);
   repeat
      cBytes := InputStream.ReadData(InputBuffer);
      i := 1;
      j := 1;
      while i <= cBytes div 4 do
      begin
         OutputBuffer[j] := FastExpMul(InputBuffer[i], Degr,
           StrToInt64(NumberP), InputBuffer[i + 1]);
         if not IsOutputFilled then
         begin
            Output[j - 1] := OutputBuffer[j];
         end;
         inc(i, 2);
         inc(j, 1);
      end;
      if not IsOutputFilled then
      begin
         SetLength(Output, cBytes div 2  div SizeOf(Integer));
         IsOutputFilled := true;
      end;
      OutputStream.WriteData(OutputBuffer, cBytes div 2 div SizeOf(Integer));
   until (InputStream.Position = InputStream.Size);
   InputStream.Free;
   OutputStream.Free;
end;



procedure TForm2.Button6Click(Sender: TObject);
var
   Output: TBytesToPrint;
   i, j: Integer;
begin
   if OpenDialog.Execute then
   begin
      DecryptLFSR(OpenDialog.FileName, fNameDecipher, Output);
      if Length(Output) > 0 then
      begin
         sgOutput.RowCount := Length(Output) + 1;
         i := Low(Output);
         j := Low(Output);
         while i <= High(Output) do
         begin
            {sgOutput.Cells[2, j + 1] := inttostr(Output[i]) + ', ' +
              inttostr(Output[i + 1]);
            inc(i, 2);
            inc(j);}
            sgOutput.Cells[2, i + 1] := inttostr(Output[i]);
            inc(i);
         end;
      end;
   end;
end;

procedure TForm2.CheckEnteredNumber(Sender: TObject; Ident: Char;
  var Number: string; BottomLine: Integer; TopLine: Int64);
begin
   with Sender as TEdit do
      if Number <> ' ' then
      begin
         if (StrToInt64(Number) >= BottomLine) and (StrToInt64(Number) < TopLine)
         then
         begin
            if not IsPrimeButton(StrToInt64(Number)) then
            begin
               ShowMessage('Число ' + Ident + ' должно быть простым');
               Number := ' ';
               Clear;
            end;
         end
         else
         begin
            ShowMessage('Введите число ' + Ident + ' больше ' +
              inttostr(BottomLine - 1) + ' меньше ' + inttostr(TopLine));
            Number := ' ';
            Clear;
         end;
      end
      else
      begin
         ShowMessage('Введите простое число ' + Ident);
         Number := ' ';
         Clear;
      end;
end;

procedure TForm2.CheckEnteredNumberExt(Sender: TObject; Ident: Char;
  var Number: string; BottomLine: Integer; TopLine: Int64);
var
   x, y, gcd: Integer;
begin
   with Sender as TEdit do
   begin
      if Number <> ' ' then
      begin
         if (StrToInt64(Number) >= BottomLine) and (StrToInt64(Number) < TopLine)
         then
         begin
            if not IsPrimeButton(StrToInt64(Number)) then
            begin
               ShowMessage('Число ' + Ident + ' должно быть простым');
               Number := ' ';
               Clear;
            end;
         end
         else
         begin
            ShowMessage('Введите число ' + Ident + ' больше ' +
              inttostr(BottomLine - 1) + ' меньше ' + inttostr(TopLine));
            Number := ' ';
            Clear;
         end;
      end
      else
      begin
         ShowMessage('Введите простое число ' + Ident);
         Number := ' ';
         Clear;
      end;
      if NumberK <> ' ' then
         if ExtendedGCD(StrToInt64(NumberK), StrToInt64(NumberP) - 1, x, y,
           gcd) <> 1 then
         begin
            ShowMessage('Введите число k взаимно простое с p - 1');
            Number := ' ';
            Clear;
         end;
   end;
end;

procedure TForm2.edtKKeyPress(Sender: TObject; var Key: Char);
const
   Digit: set of Char = ['0' .. '9'];
begin
   if Key in Digit then
      NumberK := NumberK + Key;
   if Key = #8 then
      NumberK := ' ';
end;

procedure TForm2.edtPKeyPress(Sender: TObject; var Key: Char);
const
   Digit: set of Char = ['0' .. '9'];
begin
   if Key in Digit then
      NumberP := NumberP + Key;
   if Key = #8 then
      NumberP := ' ';
end;

procedure TForm2.edtXKeyPress(Sender: TObject; var Key: Char);
const
   Digit: set of Char = ['0' .. '9'];
begin
   if Key in Digit then
      NumberX := NumberX + Key;
   if Key = #8 then
      NumberX := ' ';
end;

procedure OutputSource(InputFileName: string; var Output: TBytesToPrint);
var
   InputBuffer: array [1 .. cBytesMax div 2] of Byte;
   InputStream: TFileStream;
   cBytes, i: Integer;
begin
   InputStream := TFileStream.Create(InputFileName, fmOpenRead);
   SetLength(Output, cBytesMax div 2);
   cBytes := InputStream.ReadData(InputBuffer);
   if Length(Output) > 0 then
   begin
      Form2.sgOutput.RowCount := cBytes + 1;
      i := Low(InputBuffer);
      while i <= cBytes do
      begin
         Output[i - 1] := InputBuffer[i];
         Form2.sgOutput.Cells[0, i] := inttostr(Output[i - 1]);
         inc(i);
      end;
   end;
   InputStream.Free;
end;

procedure TForm2.ProcessCode(FileName: string);
var
   i: Integer;
begin
   fNameCipher := FileName;
   i := Length(fNameCipher);
   while fNameCipher[i] <> '.' do
      Dec(i);
   Insert('  CIPHER', fNameCipher, i);
   fNameDecipher := fNameCipher;
   Insert(' DE', fNameDecipher, pos('CIPHER', fNameDecipher));
end;

procedure TForm2.ФайлClick(Sender: TObject);
var
   Output: TIntToPrint;
   Source: TBytesToPrint;
   i, j: Integer;
begin
   if OpenDialog.Execute then
   begin
      mmPlainText.Clear;
      ProcessCode(OpenDialog.FileName);
      OutputSource(OpenDialog.FileName, Source);
      EncryptLFSR(OpenDialog.FileName, fNameCipher, Output);
      if Length(Output) > 0 then
      begin
         sgOutput.RowCount := Length(Output) div 2 + 1;
         i := Low(Output);
         j := Low(Output);
         while i <= High(Output) do
         begin
            sgOutput.Cells[1, j + 1] := inttostr(Output[i]) + ', ' +
              inttostr(Output[i + 1]);
            inc(i, 2);
            inc(j);
         end;
      end;
   end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
   NumberP := ' ';
   NumberX := ' ';
end;

procedure TForm2.ListBoxClick(Sender: TObject);
var
   i: Integer;
begin
   for i := 0 to ListBox.Items.Count - 1 do
      if ListBox.Selected[i] then
         edtG.text := ListBox.Items[i];
end;

end.