SHARE
TWEET

Untitled

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.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
  8.  
  9. type
  10.   TForm2 = class(TForm)
  11.     Button1: TButton;
  12.     Edit1: TEdit;
  13.     memoEncrypt: TMemo;
  14.     memoDecrypt: TMemo;
  15.     Button2: TButton;
  16.     Button3: TButton;
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure Button2Click(Sender: TObject);
  19.     procedure Button3Click(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   Form2: TForm2;
  28.  
  29. implementation
  30.  
  31. {$R *.dfm}
  32.  
  33. function GetStr(var str: String): String;
  34. var
  35.   i: Integer;
  36.   newStr: String;
  37. begin
  38.   for i := 1 to Length(str) do
  39.   begin
  40.     if (ord(str[i]) >= 1072) and (ord(str[i]) <= 1103) or (ord(str[i]) = 1105)then
  41.       newStr := newStr + str[i];
  42.     result := newStr;
  43.   end;
  44. end;
  45.  
  46. function LowerCase(Str: string): string;
  47. var
  48.   i: integer;
  49. begin
  50.   Result := Str;
  51.   for i := 1 to length(Result) do
  52.   begin
  53.      if (Result[i] in ['А'..'Я']) then
  54.         Result[i] := chr(ord(Result[i]) + 32);
  55.      if Result[i] = 'Ё' then
  56.         Result[i] := 'ё';
  57.   end;
  58. end;
  59.  
  60. function Encrypt(str: string; const Coolkey: string):string;
  61. const
  62.    SizeAlphabet = 33;
  63.    Alphabet = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
  64. var
  65.    i, j, Position, KeyCounter, Offset: integer;
  66.    temp, key: string;
  67. begin
  68.    str := GetStr(Str);
  69.    Key := Coolkey;
  70.    KeyCounter := 0;
  71.    for i := 1 to length(str) do
  72.    begin
  73.       inc(KeyCounter);
  74.       if KeyCounter > length(key) then
  75.       begin
  76.          KeyCounter := 1;
  77.          for  j := 1 to Length(Key) do
  78.             Key[j] := Alphabet[pos(Key[j], Alphabet) + 1];
  79.       end;
  80.       Position := pos(str[i], Alphabet) + pos(key[KeyCounter], Alphabet) - 1;
  81.       if Position > SizeAlphabet then
  82.          Position := Position - SizeAlphabet;
  83.       Result:=Result + Alphabet[Position];
  84.    end;
  85. end;
  86.  
  87.  
  88. function Decrypt(str, key: string): string;
  89. const
  90.    SizeAlphabet = 33;
  91.    Alphabet = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
  92. var
  93.    i, j, Position, KeyCounter: integer;
  94.    Temp: string;
  95. begin
  96.    Str := GetStr(Str);
  97.    Str := LowerCase(str);
  98.    Key := LowerCase(key);
  99.    KeyCounter := 0;
  100.    for i := 1 to length(str) do
  101.    begin
  102.       inc(KeyCounter);
  103.       if KeyCounter > length(Key) then
  104.       begin
  105.          KeyCounter := 1;
  106.          for  j := 1 to Length(Key) do
  107.             Key[j] := Alphabet[pos(Key[j], Alphabet) + 1];
  108.       end;
  109.       Position := pos(Str[i], Alphabet) - pos(Key[KeyCounter], Alphabet) + 1;
  110.       if Position <= 0 then
  111.          Position := Position + SizeAlphabet;
  112.       Result := Result + Alphabet[Position];
  113.    end;
  114. end;
  115.  
  116. procedure TForm2.Button1Click(Sender: TObject);
  117. begin
  118.    memoDecrypt.Text := Encrypt(memoEncrypt.Text,edit1.Text);
  119. end;
  120.  
  121. procedure TForm2.Button2Click(Sender: TObject);
  122. begin
  123.    memoDecrypt.Text := Decrypt(memoDecrypt.Text,edit1.Text);
  124. end;
  125.  
  126. procedure TForm2.Button3Click(Sender: TObject);
  127. begin
  128.    memoEncrypt.Lines.Clear;
  129.    memoDecrypt.Lines.Clear;
  130.    edit1.Text:='';
  131. end;
  132.  
  133. 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