Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit2;
- interface
- uses
- System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
- FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
- FMX.Objects, FMX.Controls.Presentation, FMX.StdCtrls;
- type
- TForm2 = class(TForm)
- btnDecrypt: TButton;
- Button3: TButton;
- btnEncrypt: TButton;
- procedure FormCreate(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure btnEncryptClick(Sender: TObject);
- procedure btnDecryptClick(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- type
- Arr = array of array of char;
- BoolArr = array of array of Boolean;
- IntArr = array of Integer;
- const
- N = 4;
- var
- Form2: TForm2;
- Counter: Integer;
- TempArr: IntArr;
- MyArr: Arr;
- MaskStr: string;
- StartIndex: Integer;
- implementation
- {$R *.fmx}
- function ExtractString(SourceStr: string): string;
- var
- ExtractStr: string;
- i: Integer;
- begin
- for i := 1 to Length(SourceStr) do
- if (MaskStr[i] in (['a'..'z', 'A'..'Z'])) then
- ExtractStr := ExtractStr + SourceStr[i];
- ExtractString := ExtractStr;
- end;
- function LowCase(ch: char): char;
- begin
- if ch in ['A'..'Z'] then
- LowCase := chr(ord(ch) + 32)
- else
- LowCase := ch;
- end;
- function GetMask(Str: string): string;
- var
- i: Integer;
- begin
- for i := 1 to Length(Str) do
- if (Str[i] in (['a'..'z', 'A'..'Z'])) then
- Str[i] := 'w';
- GetMask := Str;
- end;
- function ReadFromFile(FileName: string): string;
- var
- i: Integer;
- MyFile: TextFile;
- letter: char;
- begin
- for i := 1 to Length(MaskStr) do
- MaskStr := '';
- AssignFile(MyFile, FileName);
- Reset(MyFile);
- while not Eof(MyFile) do
- begin
- read(MyFile, letter);
- letter := LowCase(letter);
- MaskStr := MaskStr + letter;
- end;
- CloseFile(MyFile);
- ReadFromFile := MaskStr;
- end;
- procedure WriteToFile(Str: string; FinalStr: string; FileName: string);
- var
- MyFile: TextFile;
- i, k: Integer;
- begin
- AssignFile(MyFile, FileName);
- Rewrite(MyFile);
- k := 1;
- for i := 1 to Length(Str) do
- if (Str[i] = 'w') then
- begin
- Str[i] := FinalStr[k];
- inc(k);
- end;
- begin
- Write(MyFile, str);
- end;
- CloseFile(MyFile);
- end;
- function StringLength(Str: string): integer;
- var
- Amount: Integer;
- begin
- if Length(Str) < N then
- Amount := Length(Str)
- else
- Amount := N;
- StringLength := Amount;
- end;
- function ArrToStr(HelpArr: Arr): string;
- var
- i, j: Integer;
- TempStr: string;
- begin
- SetLength(HelpArr, n, n);
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- if (HelpArr[i, j] in ['a'..'z']) then
- TempStr := TempStr + HelpArr[i, j];
- ArrToStr := TempStr;
- end;
- function FillHoles(CharArr: Arr; BooleanArr: BoolArr; Str: string): Arr;
- var
- i, j: Integer;
- begin
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- if (BooleanArr[i, j] = True) then
- begin
- CharArr[i, j] := Str[StartIndex];
- inc(StartIndex);
- BooleanArr[i, j] := False;
- end;
- FillHoles := CharArr;
- end;
- function ReadHoles(CharArr: Arr; BooleanArr: BoolArr; Str: string): string;
- var
- i, j: Integer;
- begin
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- if (BooleanArr[i, j] = True) and (CharArr[i, j] <> '') and (CharArr[i, j] <> ' ') then
- begin
- Str := Str + CharArr[i, j];
- inc(StartIndex);
- BooleanArr[i, j] := False;
- end;
- ReadHoles := Str;
- end;
- function MakeHole(AmountSymbols: Integer; IndArr: IntArr; var BooleanArr: BoolArr; var TempCounter: Integer): BoolArr;
- var
- i: Integer;
- CurrentI, CurrentJ: Integer;
- NextI, NextJ: Integer;
- begin
- if TempCounter = 33 then
- TempCounter := 0;
- for i := 0 to AmountSymbols - 1 do
- begin
- CurrentI := IndArr[TempCounter];
- CurrentJ := IndArr[TempCounter + 1];
- NextI := CurrentJ;
- NextJ := N - CurrentI - 1;
- BooleanArr[Currenti, Currentj] := True;
- IndArr[TempCounter + N * 2] := NextI;
- IndArr[TempCounter + N * 2 + 1] := NextJ;
- inc(TempCounter, 2);
- end;
- MakeHole := BooleanArr;
- end;
- function Encryption(AmountSymbols: Integer; Str: string; IndArr: IntArr; CharArr: Arr): string;
- var
- i, j: Integer;
- TempCounter: Integer;
- EncryptStr: string;
- BooleanArr: BoolArr;
- begin
- SetLength(BooleanArr, N, N);
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- BooleanArr[i, j] := False;
- TempCounter := 0;
- for i := 0 to AmountSymbols - 1 do
- begin
- BooleanArr := MakeHole(N, TempArr, BooleanArr, TempCounter);
- CharArr := FillHoles(CharArr, BooleanArr, Str);
- end;
- EncryptStr := ArrToStr(CharArr);
- Encryption := EncryptStr;
- end;
- procedure ClearMatrix(CharArr: Arr);
- var
- i, j: Integer;
- begin
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- CharArr[i, j] := ' ';
- end;
- procedure TForm2.btnEncryptClick(Sender: TObject);
- var
- SourceStr, NewStr: string;
- PosAm: Integer;
- BlockAmount, i: Integer;
- begin
- MaskStr := ReadFromFile('Source.txt');
- SourceStr := ExtractString(MaskStr);
- MaskStr := GetMask(MaskStr);
- if (Length(SourceStr) div (N * N) > 0) and (Length(SourceStr) mod (N * N) = 0) then
- BlockAmount := Length(SourceStr) div (N * N)
- else
- if (Length(SourceStr) <> 0) then
- BlockAmount := Length(SourceStr) div (N * N) + 1
- else
- BlockAmount := 0;
- if BlockAmount <> 0 then
- for i := 0 to BlockAmount - 1 do
- begin
- if i = BlockAmount - 1 then
- ClearMatrix(MyArr);
- if i < BlockAmount - 1 then
- PosAm := N
- else
- PosAm := (Length(SourceStr) - StartIndex) div N + 1;
- Counter := 0;
- NewStr := NewStr + Encryption(PosAm, SourceStr, TempArr, MyArr);
- end;
- WriteToFile(MaskStr, NewStr, 'Encrypt.txt');
- end;
- procedure TForm2.Button1Click(Sender: TObject);
- var
- i: Integer;
- begin
- Counter := 0;
- for i := 0 to 2 * N - 1 do
- TempArr[i] := 0;
- end;
- function StrToArr(TempStr: string; k: Integer): Arr;
- var
- i, j: Integer;
- CharArr: Arr;
- begin
- SetLength(CharArr, n, n);
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- begin
- CharArr[i, j] := TempStr[k];
- inc(k);
- end;
- StrToArr := CharArr;
- end;
- function SortArray(AmountSymbols: Integer; IndArr: IntArr; var BooleanArr: BoolArr; var TempCounter: Integer): BoolArr;
- var
- i, Amount: Integer;
- Temper, SaveCounter, CurrentI, CurrentJ: Integer;
- tempi, tempj: Integer;
- begin
- Amount := N - 1;
- dec(TempCounter, 8);
- SaveCounter := TempCounter;
- for i := 0 to N - 2 do
- begin
- Temper := Amount;
- while Amount <> 0 do
- begin
- if IndArr[TempCounter] > IndArr[TempCounter + 2] then
- begin
- tempi := IndArr[TempCounter];
- IndArr[TempCounter] := IndArr[TempCounter + 2];
- IndArr[TempCounter + 2] := tempi;
- tempj := IndArr[TempCounter + 1];
- IndArr[TempCounter + 1] := IndArr[TempCounter + 3];
- IndArr[TempCounter + 3] := tempj;
- end;
- inc(TempCounter, 2);
- dec(Amount);
- end;
- TempCounter := SaveCounter;
- Amount := Temper;
- dec(Amount);
- end;
- if ((AmountSymbols mod n) = 0) then
- AmountSymbols := 0
- else
- AmountSymbols := N - AmountSymbols mod N;
- TempCounter := TempCounter + 2 * (N - AmountSymbols);
- while AmountSymbols <> 0 do
- begin
- CurrentI := IndArr[TempCounter];
- CurrentJ := IndArr[TempCounter + 1];
- BooleanArr[Currenti, Currentj] := False;
- inc(TempCounter, 2);
- dec(AmountSymbols);
- end;
- SortArray := BooleanArr;
- end;
- function Decryption(AmountSymbols: Integer; Str: string; IndArr: IntArr; CharArr: Arr; Itra: Integer): string;
- var
- TempCounter: Integer;
- i, j: Integer;
- NewStr2: string;
- NewArr: Arr;
- BooleanArr: BoolArr;
- begin
- SetLength(BooleanArr, N, N);
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- BooleanArr[i, j] := False;
- SetLength(NewArr, N, N);
- for i := 0 to N - 1 do
- for j := 0 to N - 1 do
- NewArr[i, j] := ' ';
- TempCounter := 0;
- if (AmountSymbols mod N <> 0) then
- inc(AmountSymbols, N);
- BooleanArr := MakeHole((AmountSymbols div N) * N, TempArr, BooleanArr, TempCounter);
- if (AmountSymbols mod N <> 0) then
- dec(AmountSymbols, N);
- BooleanArr := SortArray(AmountSymbols, TempArr, BooleanArr, TempCounter);
- NewArr := FillHoles(NewArr, BooleanArr, Str);
- StartIndex := 1;
- TempCounter := 0;
- if (AmountSymbols mod N <> 0) then
- inc(AmountSymbols, N);
- for j := 0 to AmountSymbols div N - 1 do
- begin
- BooleanArr := MakeHole(N, TempArr, BooleanArr, TempCounter);
- NewStr2 := ReadHoles(NewArr, BooleanArr, NewStr2);
- end;
- StartIndex := (Itra + 1) * 16 + 1;
- Decryption := NewStr2;
- end;
- procedure TForm2.btnDecryptClick(Sender: TObject);
- var
- SourceStr: string;
- BlockAmount, i, PosAm: Integer;
- NewStr: string;
- begin
- StartIndex := 1;
- MaskStr := ReadFromFile('Encrypt.txt');
- SourceStr := ExtractString(MaskStr);
- MaskStr := GetMask(MaskStr);
- if (Length(SourceStr) div (N * N) > 0) and (Length(SourceStr) mod (N * N) = 0) then
- BlockAmount := Length(SourceStr) div (N * N)
- else
- if (Length(SourceStr) <> 0) then
- BlockAmount := Length(SourceStr) div (N * N) + 1
- else
- BlockAmount := 0;
- if BlockAmount <> 0 then
- for i := 0 to BlockAmount - 1 do
- begin
- if i = BlockAmount - 1 then
- ClearMatrix(MyArr);
- if i < BlockAmount - 1 then
- PosAm := N * N
- else
- PosAm := (Length(SourceStr) - 16 * i);
- Counter := 0;
- NewStr := NewStr + Decryption(PosAm, SourceStr, TempArr, MyArr, i);
- end;
- WriteToFile(MaskStr, NewStr, 'Decrypt.txt');
- end;
- procedure RandomKey();
- var
- Starti, Startj: Integer;
- Nexti, Nextj: Integer;
- amount, i, j, f: Integer;
- BoolMatrix: BoolArr;
- cc: integer;
- begin
- randomize;
- amount := N;
- //firstcc := 0;
- SetLength(BoolMatrix, n, n);
- for i := 0 to n-1 do
- for j := 0 to n-1 do
- BoolMatrix[i, j] := False;
- for i := 0 to amount - 1 do
- begin
- repeat
- f := random(N);
- j := random(N);
- until (BoolMatrix[f, j] = False);
- BoolMatrix[f, j] := True;
- cc := 1;
- Starti := f;
- Startj := j;
- repeat
- Nexti := Startj;
- Nextj := N - Starti - 1;
- if (Starti + Nextj = n - 1) then
- begin
- BoolMatrix[Nexti, Nextj] := True;
- inc(cc);
- end;
- Starti := Nexti;
- Startj := Nextj;
- until cc = amount;
- TempArr[Counter] := f;
- TempArr[Counter + 1] := j;
- inc(Counter, 2);
- end;
- end;
- procedure TForm2.Button3Click(Sender: TObject);
- begin
- RandomKey();
- btnEncrypt.Enabled := True;
- btnDecrypt.Enabled := True;
- end;
- procedure TForm2.FormCreate(Sender: TObject);
- var
- i, j: Integer;
- begin
- Counter := 0;
- StartIndex := 1;
- SetLength(TempArr, 10 * N);
- SetLength(MyArr, N, N);
- end;
- begin
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement