SHARE
TWEET

Zhd

a guest Sep 15th, 2019 86 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit1;
  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.   TForm1 = class(TForm)
  11.     memoEncrypt: TMemo;
  12.     memoDecrypt: TMemo;
  13.     Edit1: TEdit;
  14.     Button1: TButton;
  15.     Button2: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.     procedure Button2Click(Sender: TObject);
  18.   private
  19.     { Private declarations }
  20.   public
  21.     { Public declarations }
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.dfm}
  30.  
  31. type
  32.    ChArr = array of char;
  33.  
  34. function ArrToStr(TempArr: ChArr; Str: string): string;
  35. var
  36.    i, j: Integer;
  37.    TempStr: string;
  38. begin
  39.    SetLength(TempArr, Length(Str));
  40.    for i := 0 to Length(Str) - 1 do
  41.          TempStr := TempStr + TempArr[i];
  42.    ArrToStr := TempStr;
  43. end;
  44.  
  45. function NumerateStr(Str: string; Key: Integer): string;
  46. var
  47.    i, j: Integer;
  48.    NewArr: ChArr;
  49.    NewStr: string;
  50. begin
  51.    SetLength(NewArr, Length(Str));
  52.    i := 1;
  53.    while (i <= Length(Str)) do
  54.    begin
  55.       for j := 1 to Key do
  56.       begin
  57.          NewArr[i - 1] := chr(j);
  58.          inc(i);
  59.       end;
  60.       for j := Key - 1 downto 2 do
  61.       begin
  62.          NewArr[i - 1] := chr(j);
  63.          inc(i);
  64.       end;
  65.    end;
  66.    NumerateStr := ArrToStr(NewArr, Str);
  67. end;
  68.  
  69. function Encrypt(Str: string; SourceStr: string; Key: integer): string;
  70. var
  71.    i, j, m: Integer;
  72.    NewStr: string;
  73. begin
  74.    i := 1;
  75.    j := 1;
  76.    m := 1;
  77.    NewStr := SourceStr;
  78.    while (j <= Key) do
  79.    begin
  80.       while (i <= Length(Str)) do
  81.       begin
  82.          if (Str[i] = chr(j)) then
  83.          begin
  84.             NewStr[m] := SourceStr[i];
  85.             inc(m);
  86.          end;
  87.          inc(i);
  88.       end;
  89.       i := 1;
  90.       inc(j);
  91.    end;
  92.    Encrypt := NewStr;
  93. end;
  94.  
  95. function Decrypt(NumStr: string; SourceStr: string; Key: integer): string;
  96. var
  97.    i, j, m: Integer;
  98. begin
  99.    i := 1;
  100.    j := 1;
  101.    m := 1;
  102.    while (j <= Key) do
  103.    begin
  104.       while (i <= Length(SourceStr)) do
  105.       begin
  106.          if (NumStr[i] = chr(j)) then
  107.          begin
  108.             NumStr[i] := SourceStr[m];
  109.             inc(m);
  110.          end;
  111.          inc(i);
  112.       end;
  113.       i := 1;
  114.       inc(j);
  115.    end;
  116.    Decrypt := NumStr;
  117. end;
  118.  
  119. procedure TForm1.Button1Click(Sender: TObject);
  120. var
  121.    SourceStr, NumStr, NewStr: string;
  122. begin
  123.    SourceStr := memoEncrypt.Text;
  124.    NumStr := NumerateStr(SourceStr, strtoint(edit1.Text));
  125.    NewStr := Encrypt(NumStr, SourceStr, strtoint(edit1.Text));
  126.    memoDecrypt.Text := NewStr;
  127. end;
  128.  
  129. procedure TForm1.Button2Click(Sender: TObject);
  130. var
  131.    SourceStr, NumStr: string;
  132. begin
  133.    SourceStr := memoDecrypt.Text;
  134.    NumStr := NumerateStr(SourceStr, strtoint(edit1.Text));
  135.    NumStr := Decrypt(NumStr, SourceStr, strtoint(edit1.Text));
  136.    memoDecrypt.Text := NumStr;
  137. end;
  138.  
  139. 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