Лабы / Лаба1 / Лаба1 / Лаба1 / Delphi / unCrypt

unit unCrypt;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Panel1: TPanel;
mmResult: TMemo;
Label1: TLabel;
Panel2: TPanel;
Button1: TButton;
Button3: TButton;
Panel3: TPanel;
Button6: TButton;
odTables: TOpenDialog;
Button5: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TArrChar=array of Char;
TArrCode=array of real;
var
Form1: TForm1;
vctrAlphabet:TArrChar;
vctrUncryptAlphabet:TArrChar;
vctrCode:TArrCode;
vctrUncryptCode:TArrCode;
AllSymbolsOfText:integer=0;
ProgrammPath:string;
const N=32; {количество букв для русского языка}
implementation

{$R *.dfm}
{Загружаем расшифровочный вектор}
procedure LoadUncryptVector(FileName:string);
var FS:TextFile;
var buf:char;
i:cardinal;
begin
i:=0;
AssignFile(FS,FileName);
Reset(FS);
Finalize(vctrUncryptAlphabet);
SetLength(vctrUncryptAlphabet,N);
while(not EOF(FS)) do begin
Read(FS,buf);
if (buf<>#10)and (buf<>#13) then begin vctrUncryptAlphabet[i]:=buf;
inc(i);
end;
end;
CloseFile(FS);
end;
{Сортировка поубыванию частот векторов частот и алфавитов}
procedure SortVectors();
var i,j:integer;
var buf:real;
var bufchar:char;
begin
{Сортируем стандартные частоты по убыванию}
For i:=0 to N-1 do begin
For j:=0 to N-2 do begin
if vctrCode[j]<vctrCode[j+1] then begin
buf:=vctrCode[j];
vctrCode[j]:=vctrCode[j+1];
vctrCode[j+1]:=buf;
bufchar:=vctrAlphabet[j];
vctrAlphabet[j]:=vctrAlphabet[j+1];
vctrAlphabet[j+1]:=bufchar;
end;
end;
end;
{Сортируем зашифрованные частоты по убыванию}
For i:=0 to N-1 do begin
For j:=0 to N-2 do begin
if vctrUncryptCode[j]<vctrUncryptCode[j+1] then begin
buf:=vctrUncryptCode[j];
vctrUncryptCode[j]:=vctrUncryptCode[j+1];
vctrUncryptCode[j+1]:=buf;
bufchar:=vctrUncryptAlphabet[j];
vctrUncryptAlphabet[j]:=vctrUncryptAlphabet[j+1];
vctrUncryptAlphabet[j+1]:=bufchar;
end;
end;
end;
end;

{Зануляем таблицу частот}
procedure NullHZCryptTable();
var i:integer;
begin
SetLength(vctrUncryptCode,N);
for i:=0 to N-1 do vctrUncryptCode[i]:=0;
end;

{Формирование зашифрованного алфавита от А до Я}
procedure FormatCryptArrayOfAlphabet();
var i:integer;
begin
SetLength(vctrUncryptAlphabet,N);
for i:=0 to N-1 do vctrUncryptAlphabet[i]:=char(224+i);
end;

{Формирование стандартного алфавита от А до Я}
procedure FormatStandardArrayOfAlphabet();
var i:integer;
begin
Finalize(vctrAlphabet);
SetLength(vctrAlphabet,N);
for i:=0 to N-1 do vctrAlphabet[i]:=char(224+i);
end;

{Загрузка стандартной таблицы частот}
procedure LoadStandartCharTable();
var i:integer;
var F:TextFile;
var value:real;
begin
SetLength(vctrCode,N);
AssignFile(F,'Tables\CryptTable.txt');
reset(F);
i:=0;
while (not EOF(F)) do begin
Read(F,value);
vctrCode[i]:=value;
inc(i);
end;
CloseFile(F);
end;

{Функция подсчета количества букв в тексте}
procedure CharIterator(ch:char);
var i:integer;
begin
for i:=0 to N-1 do begin
if (ch=vctrAlphabet[i])
then vctrUncryptCode[i]:=vctrUncryptCode[i]+1;
end;

end;
{Подсчет частот букв в зашифрованном тексте}
procedure CalculateTable();
var i:integer;
begin
for i:=0 to N-1 do vctrUncryptCode[i]:=vctrUncryptCode[i]/AllSymbolsOfText;

end;
{}
procedure TForm1.Button1Click(Sender: TObject);
var F:TextFile; {Входной текстовый файл}
var ReadChar:char; {}
var i:integer;
begin
{--------------------------}
{Очищаем массивы,переменные, и т.д.}
Finalize(vctrAlphabet);
Finalize(vctrCode);
Finalize(vctrUncryptAlphabet);
Finalize(vctrUncryptCode);
AllSymbolsOfText:=0;
mmResult.Clear;
NullHZCryptTable();//Создаем и зануляем
//таблцу шифрованого текста частот
{--------------------------}
FormatCryptArrayOfAlphabet();
//Задаем зашифрованный алфавит частотной таблицы в формате от А до Я
FormatStandardArrayOfAlphabet();
{Загрузка стандартной таблицы частот}
LoadStandartCharTable();
{--------------------------}

{--------------------------}
Application.ProcessMessages; {Чтобы не подвисало :)}
if OpenDialog1.Execute then begin {Если передано имя файло то}
AssignFile(F,OpenDialog1.FileName); {Связываем файловый поток
с именем файла диалога}
reset(F); {открываем поток на чтение}
while (not EOF(F)) do
begin
REad(F,ReadChar);
if (ReadChar<>#10) and
(ReadChar<>#13) and
(ReadChar<>' ') and
(ReadChar<>',') and
(ReadChar<>'.') and
(ReadChar<>'-') and
(ReadChar<>',') and
(ReadChar<>':') and
(ReadChar<>'"') then
inc(AllSymbolsOfText); //подсчет количества букв
CharIterator(ReadChar);
end;
CloseFile(F); //закрываем файловый поток
CalculateTable(); //расчитываем частоту

{Заполняем Мему}

mmResult.Lines.Add('Количество символов: '+inttostr(AllSymbolsOfText));
mmResult.Lines.Add('');
mmResult.Lines.Add(' Частотные таблицы:');

For i:=0 to N-1 do
mmResult.Lines.Add('Частота Буквы '+ vctrAlphabet[i] +' стандартная= '+
floattostr(vctrCode[i]) +' , в зашифрованном тексте= '+
floattostr(vctrUncryptCode[i]));
SortVectors(); //Сортируем
mmResult.Lines.Add('');
mmResult.Lines.Add(' Частотные таблицы после сортировка:');
For i:=0 to N-1 do
mmResult.Lines.Add('Буква: '+ vctrAlphabet[i] +'. частота= '+
floattostr(vctrCode[i]) +
'. Буква в зашифрованном тексте: '+
vctrUncryptAlphabet[i]+'. частота= '+
floattostr(vctrUncryptCode[i]) +'.'

);

end;//od.Execute

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Finalize(vctrAlphabet);
Finalize(vctrCode);
Finalize(vctrUncryptAlphabet);
Finalize(vctrUncryptCode);
end;


procedure TForm1.Button3Click(Sender: TObject);
var ResultFile,InputFile:TextFile;
var bufRead,bufWrite:char;
var i:integer;
var stopflag:boolean;
begin
AssignFile(ResultFile,ProgrammPath+'OutPutFile.txt');
AssignFile(InputFile,OpenDialog1.FileName);
Reset(InputFile);
Rewrite(ResultFile);
while (not EOF(INputFile)) do
begin
Read(InputFile,bufRead);
for i:=0 to N-1 do
begin
stopFlag:=false;
if (bufRead=vctrUncryptAlphabet[i]) then begin
Write(ResultFile,vctrAlphabet[i]);
stopFlag:=true;
break;
end;
end;
if stopFlag=false then Write(ResultFile,bufRead);
end;
CloseFile(InputFile);
CloseFile(ResultFile);
end;

procedure TForm1.Button5Click(Sender: TObject);
var NameFile:string;
begin
NameFile:=ProgrammPath+'Ucrypt.log';
mmResult.Lines.SaveToFile(NameFile);
end;

procedure TForm1.Button6Click(Sender: TObject);
var ResultFile,InputFile:TextFile;
var bufRead,bufWrite:char;
var i:integer;
var stopflag:boolean;
begin
if odTables.Execute then begin
FormatStandardArrayOfAlphabet(){формируем стандартный алфавит};
LoadUncryptVector(odTables.FileName);
For i:=0 to N-1 do
mmResult.Lines.Add('Буква: '+ vctrAlphabet[i] +
'. Буква в зашифрованном тексте: '+
vctrUncryptAlphabet[i]+'. частота= '
);
AssignFile(ResultFile,ProgrammPath+'UncryptFile.txt');
AssignFile(InputFile,OpenDialog1.FileName);
Reset(InputFile);
Rewrite(ResultFile);
while (not EOF(INputFile)) do
begin
Read(InputFile,bufRead);
for i:=0 to N-1 do
begin
stopFlag:=false;
if (bufRead=vctrUncryptAlphabet[i]) then begin
Write(ResultFile,vctrAlphabet[i]);
stopFlag:=true;
break;
end;
end;
if stopFlag=false then Write(ResultFile,bufRead);
end;
CloseFile(InputFile);
CloseFile(ResultFile);

end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ProgrammPath:=extractfilepath(Application.ExeName);
end;

end.