Реализация алгоритмов шифрования на Delphi / RSA / Unit1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, Math, Buttons;

type
TIncodeMes = array of Integer;
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Label5: TLabel;
Edit5: TEdit;
Label6: TLabel;
Label7: TLabel;
Edit6: TEdit;
Edit7: TEdit;
Button1: TButton;
Edit8: TEdit;
Label8: TLabel;
Label9: TLabel;
Memo1: TMemo;
Label10: TLabel;
Memo2: TMemo;
Label11: TLabel;
Memo3: TMemo;
XPManifest1: TXPManifest;
Button2: TButton;
Button3: TButton;
BitBtn1: TBitBtn;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Edit8KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
FMes: TIncodeMes;
public
{ Public declarations }
end;

var
Form1: TForm1;
n,x:Word;
d,e:Word;

implementation

{$R *.dfm}
//Быстрое возведение в степень
function Bit(Value, n: Integer): Boolean;
asm
bt eax, edx
setc al
and eax, 0FFh
end;

function FastPower(a, b, n: integer): integer;
var i:integer;
ai:extended;
begin
ai:=a;
for i:=Trunc(log2(b))-1 downto 0 do
if Bit(b,i) then ai:=Round(sqr(ai)*a) mod n else ai:=Round(sqr(ai)) mod n;
result:=Round(ai);
end;

//Кодируем
function Encrypt(s: string; e, n: integer): TIncodeMes;
var I: Integer;
begin
SetLength(result, length(s));
for i:=0 to Length(s)-1 do
result[i] := FastPower(ord(s[i + 1]), e, n)
end;

//Декодируем
function Decrypt(s: array of integer; e, n: integer): string;
var i:Integer;
begin
SetLength(Result, Length(s));
for i:=0 to Length(s)-1 do
result[i+1]:=chr(FastPower(s[i],e,n))
end;

procedure TForm1.Button1Click(Sender: TObject);
var up:word;
uq: word;
p,q: word;
i,j:integer;
fl:boolean;
ei:word;
begin
try
up:=StrToInt(Edit1.Text);
uq:=StrToInt(Edit2.Text);
except
beep;
ShowMessage('Опаньки... :''( Произошла ошибка '#13'Проверьте введенные значения');
exit;
end;
//Находим простые числа P и Q
for i:=up downto 1 do
begin
fl:=False;
for j:=2 to (round(sqrt(i))+1) do
begin
if ((i mod j)=0) and (i<>j) then
begin
fl:=True;
Break;
end;
end;
if not fl then
begin
p:=i;
Break;
end;
end;
Edit3.Text:=IntToStr(P);
for i:=uq downto 1 do
begin
fl:=False;
for j:=2 to (round(sqrt(i))+1) do
begin
if ((i mod j)=0) and (i<>j) then
begin
fl:=True;
Break;
end;
end;
if not fl then
begin
q:=i;
Break;
end;
end;
//Находим значение функции Эйлера и число N
Edit4.Text:=IntToStr(q);
x:=(p-1)*(q-1);
Edit5.Text:=IntToStr(x);
n:=p*q;
Edit6.Text:=IntToStr(n);
//Находим открытый ключ E
For i:=Round(x/4) to x-1 do
begin
fl:=False;
For j:=i downto 2 do
begin
if ((i mod j)=0) and ((X mod j)=0) then
begin
fl:=True;
break;
end;
end;
if not fl then
begin
E:=i;
break;
end;
end;
Edit7.Text:=IntToStr(E);
//Находим закрытый ключ D
For i := 2 to X do
begin
if (e*i mod x=1) and (e<>i) then
begin
d:=i;
break;
end;
end;
Edit8.Text:=IntToStr(D);
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,n,e:integer;
begin
try
n:=StrToInt(Edit6.Text);
e:=StrToInt(Edit7.Text);
except
beep;
ShowMessage('Опаньки... :''( Произошла ошибка '#13'Проверьте введенные значения');
exit;
end;
FMes:=Encrypt(Memo1.Lines.Text,e,n);
for i:=0 to High(FMes) do Memo2.Lines.Append(IntToStr(FMes[i]));
for i:=0 to High(FMes) do FMes[i]:=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,n,d:integer;
s:string;
begin
Memo3.Clear;
for i:=0 to Memo2.Lines.Count-1 do
FMes[i]:=StrToInt(Memo2.Lines[i]);
try
d:=StrToInt(Edit8.Text);
n:=StrToInt(Edit6.Text);
s:=Decrypt(FMes,d,n);
except
beep;
ShowMessage('Опаньки... :''( Произошла ошибка '#13'Проверьте введенные значения');
exit;
end;
Memo3.Lines.Add(s);
end;

procedure TForm1.Edit8KeyPress(Sender: TObject; var Key: Char);
begin
if not(key in ['0'..'9', #8]) then key:=#0;
end;

end.