TI3 16.11 00:01

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;

type
   TBuffer = array [1 .. 1024 * 156] of Byte;
   // TIntBuffer = array [1 .. 1024 * 512] of Byte;
   ////////////TIntBuffer = array [1 .. 1024 * 32] of Integer;
   TIntBuffer = array [1 .. 1024 * 156] of Integer;
   // TInt64Buffer = array [1 .. 1024 * 128] of Int64;
   TIntArray = array of Int64;
   TBoolArray = array of Boolean;

   TForm2 = class(TForm)
      mmPlainText: TMemo;
      Memo2: TMemo;
      Файл: TButton;
      OpenDialog: TOpenDialog;
      edtP: TEdit;
      Button1: TButton;
      Label1: TLabel;
      Button2: TButton;
      Label2: TLabel;
      ListBox: TListBox;
      Button3: TButton;
      Button4: TButton;
      edtG: TEdit;
      Label3: TLabel;
      edtX: TEdit;
      Label4: TLabel;
      Label5: TLabel;
      Button5: TButton;
      edtOpenKey: TEdit;
      Label6: TLabel;
      Label7: TLabel;
      edtPrivateKey: TEdit;
      Label8: TLabel;
      edtK: TEdit;
      Button6: TButton;
      procedure ProcessCode(FileName: string);
      procedure ФайлClick(Sender: TObject);
      procedure Button1Click(Sender: TObject);
      procedure Button2Click(Sender: TObject);
      procedure Button4Click(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 Button3Click(Sender: TObject);
      procedure Button5Click(Sender: TObject);
      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;
   Buffer: TBuffer;
   StreamSize: Int64;
   fNameCipher, fNameDecipher: string;
   f, fcipher, fDecipher: file;

const
   AMOUNT_ROOTS = 10000;

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;

procedure TForm2.Button1Click(Sender: TObject);
begin
   if IsPrimeNumber(StrToInt64(edtP.text)) then
      Label1.caption := 'Yes';
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, TempInt: 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
         TempInt := FastExp(i, round((p - 1) / PrimDeviders[j - 1]), p);
         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]));
         Memo2.Lines.Add(inttostr(OutputArray[i]));
         inc(i);
      end;
   end;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
   CheckEnteredNumber(edtP, 'p', NumberP, 257, 9223372036854775807);
   CheckEnteredNumber(edtX, 'x', NumberX, 2, StrToInt64(NumberP) - 1);
end;

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

procedure TForm2.Button4Click(Sender: TObject);
var
   y, a, k, p, kl, t: Int64;
   arr: TBuffer;
   i, j: Integer;
   ArrayB: TIntBuffer;
   Stream: TFileStream;
   Size: Integer;
begin
   NumberG := edtG.text;
   y := FastExp(StrToInt64(edtG.text), StrToInt64(NumberX),
     StrToInt64(NumberP));
   edtOpenKey.text := NumberP + ', ' + NumberG + ', ' + inttostr(y);
   edtPrivateKey.text := NumberX;
   a := FastExp(StrToInt64(edtG.text), StrToInt64(NumberK),
     StrToInt64(NumberP));
   k := StrToInt64(NumberK);
   p := StrToInt64(NumberP);
   for i := 1 to StreamSize do
   begin
      arr[i] := Buffer[i];
   end;
   kl := StreamSize;
   { i := 1;
     while i <= 8 * kl do
     begin
     t := FastExpMul(y, k, p, arr[i]);
     ArrayB[i] := a and $FF;
     ArrayB[i + 1] := (a shr 8) and $FF;
     ArrayB[i + 2] := (a shr $10) and $FF;
     ArrayB[i + 3] := (a shr $18) and $FF;

     ArrayB[i + 4] := t and $FF;
     ArrayB[i + 5] := (t shr 8) and $FF;
     ArrayB[i + 6] := (t shr $10) and $FF;
     ArrayB[i + 7] := (t shr $18) and $FF;

     inc(i, 8);
     end; }
   i := 1;
   j := 1;
   while i <= 2 * kl do
   begin
      ArrayB[i] := a;
      ArrayB[i + 1] := FastExpMulByte(y, k, p, arr[j]);
      inc(i, 2);
      inc(j, 1);
   end;
   Stream := TFileStream.Create(fNameCipher, fmCreate);
   Stream.Write(ArrayB[1], 2 * kl * SizeOf(Integer));
   Stream.Free;
   ShowMessage('Successfully ciphered');
end;

procedure TForm2.Button5Click(Sender: TObject);
begin
   Label1.caption := inttostr(FastExp(StrToInt64(edtG.text),
     StrToInt64(NumberX), StrToInt64(NumberP)));
end;

procedure TForm2.Button6Click(Sender: TObject);
var
   y, a, k, p, kl, t: Int64;
   arr: TBuffer;
   i, ka: Integer;
   ArrayRes: TBuffer;
   ArrayB: TIntBuffer;
   Stream: TFileStream;
   Size: Integer;
   Degr: Int64;
begin
   if OpenDialog.Execute then
   begin
      Stream := TFileStream.Create(OpenDialog.FileName, fmOpenRead);
      Size := Stream.ReadData(ArrayB);
      // Stream := TFileStream.Create(fNameCipher, fmCreate);
      // Stream.Read(ArrayB[1], 2 * kl * SizeOf(Integer));
   end;
   // Size := Size div 8;
   // Degr := StrToInt64(NumberX) * (StrToInt64(NumberP) - 2);
   Degr := (StrToInt64(NumberP) - 1 - StrToInt64(NumberX));
   i := 1;
   ka := 1;
   while i <= Size div 4 do
   begin
      // ArrayRes[ka] := FastExpMul(ArrayB[i + 1], Degr, StrToInt64(NumberP), ArrayB[i]);
      ArrayRes[ka] := FastExpMul(ArrayB[i], Degr, StrToInt64(NumberP),
        ArrayB[i + 1]);
      inc(i, 2);
      inc(ka, 1);
   end;

   Stream := TFileStream.Create(fNameDecipher, fmCreate);
   Stream.Write(ArrayRes[1], ka * SizeOf(byte));
   Stream.Free;
   ShowMessage('Successfully ciphered');

   { i := 1;
     while i <= 2 * kl do
     begin
     ArrayB[i] := a;
     ArrayB[i + 1] := FastExpMul(y, k, p, arr[i]);
     inc(i, 2);
     end;
     Stream := TFileStream.Create(fNameCipher, fmCreate);
     Stream.Write(ArrayB[1], 2 * kl * SizeOf(Integer));
     Stream.Free; }
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 IsPrimeButton(StrToInt64(Number)) then
               Label1.caption := 'Yes'
            else
            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 IsPrimeButton(StrToInt64(Number)) then
               Label1.caption := 'Yes'
            else
            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 TForm2.ProcessCode(FileName: string);
var
   Stream: TFileStream;
   FileByte: Byte;
   i: Integer;
   Size, ByteCounter, LinesCounter: Integer;
begin
   Stream := TFileStream.Create(FileName, fmOpenRead);
   Size := Stream.ReadData(Buffer);
   Stream.Position := 0;
   ByteCounter := 0;
   LinesCounter := 1;
   StreamSize := Stream.Size;
   for i := 0 to Stream.Size - 1 do
   begin
      Stream.ReadBuffer(FileByte, 1);
      inc(ByteCounter);
      if ByteCounter <= 8 then
         mmPlainText.text := mmPlainText.text + inttostr(FileByte) + ' '
      else if LinesCounter < 21 then
      begin
         ByteCounter := 0;
         inc(LinesCounter);
         mmPlainText.Lines.Add(inttostr(FileByte));
         inc(ByteCounter);
         mmPlainText.text := mmPlainText.text + ' ';
      end;
   end;
   Stream.Free;

   fNameCipher := FileName;
   i := Length(fNameCipher);
   while fNameCipher[i] <> '.' do
      Dec(i);
   Insert('  CIPHER', fNameCipher, i);
   Assignfile(fcipher, fNameCipher);
   fNameDecipher := fNameCipher;
   Insert(' DE', fNameDecipher, pos('CIPHER', fNameDecipher));
   Assignfile(fDecipher, fNameDecipher);
end;

procedure TForm2.ФайлClick(Sender: TObject);
begin
   if OpenDialog.Execute then
   begin
      mmPlainText.Clear;
      ProcessCode(OpenDialog.FileName);
   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.