Кодирование и декодирование текстовой информации циклическим кодом с исправлением тройных одиночных ошибок

 

ТЕКСТ ПРОГРАММЫ

 

unit main;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  //используемы

  Dialogs, ExtCtrls, Menus, jpeg, StdCtrls, ComCtrls, Grids, Math, Buttons,       //модули

  OleServer,obsh, Mask, HTTPApp;

 

Type

  Tfmzikl = class(TForm)  //описание используемых компонентов

    bevel1: TBevel;

    mm: TMainMenu;

    nfile: TMenuItem;

    nopen: TMenuItem;

    nsave: TMenuItem;

    nexit: TMenuItem;

    nhelp: TMenuItem;

   nhelp_avtor: TMenuItem;

    nhelp_prog: TMenuItem;

    nrun: TMenuItem;

    nnew: TMenuItem;

    od: TOpenDialog;

    sd: TSaveDialog;

    ncoding: TMenuItem;

    ndecoding: TMenuItem;

    nrazdel: TMenuItem;

    nisxodsms: TMenuItem;

    nstatic: TMenuItem;

    nmatrix: TMenuItem;

    ntablcod: TMenuItem;

    ndecodsms: TMenuItem;

    pllogo: TPanel;

    plInfo: TPanel;

    Image1: TImage;

    reInfo: TRichEdit;

    nlogo: TMenuItem;

    plstatic: TPanel;

    sgstatic: TStringGrid;

    pllong: TPanel;

   plh: TPanel;

    plmatrix: TPanel;

    gbmatrixcikl: TGroupBox;

    stInfoMatrix: TStaticText;

    edInfoMatrix: TEdit;

    udInfoMatrix: TUpDown;

    sgInfoMatrix: TStringGrid;

    StaticText1: TStaticText;

    edControlMatrix: TEdit;

    udControlMatrix: TUpDown;

    sgControlMatrix: TStringGrid;

 

    stPolinom: TStaticText;

    edPolinom: TEdit;

    gbParamtrCikl: TGroupBox;

    stDmin: TStaticText;

    stCorrect: TStaticText;

    stObnar: TStaticText;

    edObnar: TEdit;

    udObnar: TUpDown;

    edCorrect: TEdit;

    udCorrect: TUpDown;

    edDmin: TEdit;

    sbcoding: TSpeedButton;

    plcoding: TPanel;

    sgSym: TStringGrid;

    sbAutoTabl: TSpeedButton;

    ncanal: TMenuItem;

    plGoTo: TPanel;

    lbSource: TLabel;

    lbExit: TLabel;

    gbKanal: TGroupBox;

    lbCountError: TLabel;

    lbProb: TLabel;

    lbE1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    meCountError: TMaskEdit;

    udCountError: TUpDown;

    edE1: TEdit;

    edE2: TEdit;

    edE3: TEdit;

    sbAutoFill: TSpeedButton;

    plAllDecode: TPanel;

    reDecode: TRichEdit;

    lbernocor: TLabel;

    lbercor: TLabel;

    reSource: TRichEdit;

    reExit: TRichEdit;

    Label1: TLabel;

    procedure nexitClick(Sender: TObject);  //объявление процедур и функций

    procedure FormCreate(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure nnewClick(Sender: TObject);

    procedure nopenClick(Sender: TObject);

    procedure nsaveClick(Sender: TObject);

    procedure nlogoClick(Sender: TObject);

    procedure nisxodsmsClick(Sender: TObject);

    procedure FormClose(Sender: TObject;

              var Action: TCloseAction);

    procedure udInfoMatrixChangingEx(Sender: TObject;

      var AllowChange: Boolean; NewValue: Smallint;

      Direction: TUpDownDirection);

    procedure nstaticClick(Sender: TObject);

    procedure nmatrixClick(Sender: TObject);

    procedure udControlMatrixChangingEx(Sender: TObject;

 

      var AllowChange: Boolean; NewValue: Smallint;

      Direction: TUpDownDirection);

    procedure sgControlMatrixSetEditText(Sender: TObject; ACol,

      ARow: Integer; const Value: String);

    procedure udObnarChangingEx(Sender: TObject; var AllowChange: Boolean;

      NewValue: Smallint; Direction: TUpDownDirection);

    procedure udCorrectChangingEx(Sender: TObject;

      var AllowChange: Boolean; NewValue: Smallint;

      Direction: TUpDownDirection);

    procedure sbcodingClick(Sender: TObject);

    procedure ncodingClick(Sender: TObject);

    procedure sbAutoTablClick(Sender: TObject);

    procedure ntablcodClick(Sender: TObject);

    procedure ncanalClick(Sender: TObject);

    procedure sgSymDrawCell(Sender: TObject; ACol, ARow: Integer;

      Rect: TRect; State: TGridDrawState);

    procedure meCountErrorChange(Sender: TObject);

    procedure edE1Change(Sender: TObject);

    procedure sgSymKeyPress(Sender: TObject; var Key: Char);

    procedure edE1KeyPress(Sender: TObject; var Key: Char);

    procedure sbAutoFillClick(Sender: TObject);

    procedure ndecodingClick(Sender: TObject);

   procedure ndecodsmsClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure nhelp_avtorClick(Sender: TObject);

  public

   CodeButton:boolean; function FullText:boolean; procedure CreateMatrix;

   procedure DoCodingTabl; end;

var

fmzikl:Tfmzikl; Load:boolean; myf:AnsiString;

implementation uses Kanal, Cikl, logo, about;

{$R *.dfm}

procedure Tfmzikl.nexitClick(Sender: TObject);

begin Сlose; end;

procedure Tfmzikl.FormCreate(Sender: TObject);

begin

  with pllogo, plInfo, plstatic, plcoding, plGoto do

   begin Height:=258; Left:=5; Top:=6; Width:=452; Parent:=fmzikl; end;

   pllong.Parent:=plstatic; plh.Parent:=plstatic; end;

  with sgstatic do

   begin Height:=230; Left:=0; Top:=0; Width:=451; Parent:=plstatic; end;

  with Image1 do begin Parent:=pllogo; Align:=alClient; end;

  with reInfo do begin Parent:=plInfo; Color:=clInfoBk;

     Width:=458; Top:=-2; Left:=-2; Height:=262 end;

   with plmatrix do begin Height:=258; Left:=5; Top:=6; Width:=452; Parent:=fmzikl;end;

   with gbmatrixcikl do begin Height:=262; Left:=0; Top:=-4; Width:=452; Parent:=plmatrix;end;

   with plAllDecode do begin Height:=256; Left:=5; Top:=6; Width:=451; Parent:=fmzikl; end;

   with reDecode do begin Height:=214; Left:=2; Top:=2; Width:=443; Parent:=plAllDecode; end;

end;

procedure Tfmzikl.FormActivate(Sender: TObject);

begin

  plInfo.Visible:=false; plstatic.Visible:=false; plmatrix.Visible:=false; plcoding.Visible:=false;

  plgoto.Visible:=false; plAllDecode.Visible:=false; pllogo.Visible:=true; nnew.Enabled:=true;

 

  nopen.Enabled:=true; nsave.Enabled:=true; nexit.Enabled:=true; nlogo.Enabled:=true;

  nmatrix.Enabled:=false; ntablcod.Enabled:=false; ndecodsms.Enabled:=false;

  ncoding.Enabled:=false; ncanal.Enabled:=false; ndecoding.Enabled:=false;

end;

procedure Tfmzikl.nnewClick(Sender: TObject);

begin

  pllogo.Visible:=false; plstatic.Visible:=false; plmatrix.Visible:=false; plcoding.Visible:=false;

  plgoto.Visible:=false; plAllDecode.Visible:=false; plInfo.Visible:=true; reInfo.Lines.Clear;

  reInfo.SetFocus; nisxodsms.Enabled:=true; nstatic.Enabled:=true; nmatrix.Enabled:=false;

  ntablcod.Enabled:=false; ndecodsms.Enabled:=false; ncoding.Enabled:=false;

  ncanal.Enabled:=false; ndecoding.Enabled:=false;

end;

procedure Tfmzikl.nopenClick(Sender: TObject);

var F:TextFile;

  procedure LoadInfo;

   var Str:string; i:integer;

   begin reInfo.Clear; while not eof(F) do begin readln(F,Str); reInfo.Lines.Add(Str);

      MaxTransf:=reInfo.Lines.Count; for i:=0 to MaxTransf-1 do Transf[i]:=reInfo.Lines[i];

     end; end; Begin

ForceCurrentDirectory:=true; if od.Execute then begin AssignFile(F,od.FileName);

    Reset(F); LoadInfo; pllogo.Visible:=false; plstatic.Visible:=false; plmatrix.Visible:=false;

    plcoding.Visible:=false; plgoto.Visible:=false; plAllDecode.Visible:=false;

    plInfo.Visible:=true; nisxodsms.Enabled:=true; nmatrix.Enabled:=false;

    ndecodsms.Enabled:=false; ncoding.Enabled:=false; ndecoding.Enabled:=false;

    ncanal.Enabled:=false;

    if reInfo.Lines.Count<>0 then nstatic.Enabled:=true else nstatic.Enabled:=false; end

else ShowMessage('Файл не был выбран!');

end;

procedure Tfmzikl.nsaveClick(Sender: TObject);

begin if reInfo.Lines.Count=0 then ShowMessage('Нет данных!') else begin

    sd.FileName:=myf; if sd.Execute then begin myf:=sd.FileName;

      reInfo.Lines.SaveToFile(sd.FileName); end;

    ShowMessage('Текст не был сохранён, т.к. файл не был выбран!');

   end; end;

procedure Tfmzikl.nlogoClick(Sender: TObject);

begin plInfo.Visible:=false; plstatic.Visible:=false; plmatrix.Visible:=false;

plcoding.Visible:=false; plgoto.Visible:=false; plAllDecode.Visible:=false;

  pllogo.Visible:=true; end;

procedure Tfmzikl.nisxodsmsClick(Sender: TObject);

begin pllogo.Visible:=false; plstatic.Visible:=false; plmatrix.Visible:=false; lcoding.Visible:=false;

  plgoto.Visible:=false; plAllDecode.Visible:=false; plInfo.Visible:=true; end;

procedure Tfmzikl.FormClose(Sender: TObject; var Action: TCloseAction);

begin fmzikl.DestroyWindowHandle; Action:=caFree; end;

procedure Tfmzikl.nstaticClick(Sender: TObject);

var i,j,k,Sum,n:integer; StrS:String; Str:array[0..255] of Char; b:boolean; H:real;

begin if not FullText then begin ShowMessage('Нет данных!');exit;end;

  With sgstatic do begin ClearTabl(sgStatic); pllogo.Visible:=false; plInfo.Visible:=false;

   plmatrix.Visible:=false; plcoding.Visible:=false; plgoto.Visible:=false;

    plAllDecode.Visible:=false; plstatic.Visible:=true; nmatrix.Enabled:=true; RowCount:=1;

    LongStaticTabl:=0; Sum:=0; Cells[0,0]:='               Номер'; Cells[1,0]:='               Символ';

    Cells[2,0]:='              Частота'; for i:=0 to reInfo.Lines.Count-1 do begin

    StrS:=reInfo.Lines.Strings[i]; StrPCopy(Str,StrS); for j:=0 to StrLen(Str)-1 do begin

        b:=false; inc(Sum);

        for k:=1 to RowCount-1 do

 

   if (Cells[1,k]='                пробел   ') and (Str[j]=' ') or (Cells[1,k][23]=Str[j]) then begin

     b:=true; Cells[2,k]:='                      '+IntToStr(StrToInt(Cells[2,k])+1); end;

        if not b then begin RowCount:=RowCount+1;

             Cells[0,RowCount-1]:='                      '+IntToStr(RowCount-1);

        if Str[j]<>' ' then Cells[1,RowCount-1]:='                      '+Str[j]

          else Cells[1,RowCount-1]:='                пробел   '; Cells[2,RowCount-1]:='                      '+'1';

        end; end; if i=0 then begin RowCount:=RowCount+1;

        Cells[0,RowCount-1]:='                      '+IntToStr(RowCount-1);

        Cells[1,RowCount-1]:='        конец строки'; Cells[2,RowCount-1]:='                      '+'1';

        n:=RowCount-1; inc(sum); end else begin

   Cells[2,n]:='                      '+IntToStr(StrToInt(Cells[2,n])+1);

   inc(sum); end; end; FixedRows:=1;

    if RowCount<15 then DefaultColWidth:=148 else DefaultColWidth:=143;

    pllong.Caption:='Длина:  '+IntToStr(Sum)+'  символов'; AllSymbols:=sum;

    LongCodeTabl:=sgStatic.RowCount-1; LongStaticTabl:=LongCodeTabl;

    for i:=1 to LongStaticTabl do begin if sgStatic.Cells[1,i]='                пробел   ' then begin

        StaticTabl[i-1].Sym:=' '; StaticTabl[i-1].endline:=false; end else

      if sgStatic.Cells[1,i][5]=' ' then begin StaticTabl[i-1].Sym:=sgStatic.Cells[1,i][23];

        StaticTabl[i-1].endline:=false  end else begin StaticTabl[i-1].Sym:=chr(250);

        StaticTabl[i-1].endline:=true end; StaticTabl[i-1].P:=StrToInt(sgStatic.Cells[2,i]);

    end; end; H:=0; for j:=0 to LongStaticTabl-1 do

    H:=H-(StaticTabl[j].P/AllSymbols)*log2(StaticTabl[j].P/AllSymbols);

  plh.Caption:='Энтропия: '+FloatToStr(trunc(H*100)/100)+ ' бит/сим'; end;

function Tfmzikl.FullText:boolean; {Заполнение массива символами из reInfo}

var k:integer; begin MaxTransf:=0; for k:=0 to reInfo.Lines.Count-1 do begin

    Transf[k]:=reInfo.Lines[k]; MaxTransf:=MaxTransf+1; end;

  if reInfo.Lines.Count=0 then FullText:=false else FullText:=true; end;

procedure Tfmzikl.nmatrixClick(Sender: TObject);

begin pllogo.Visible:=false; plInfo.Visible:=false; plstatic.Visible:=false;

plcoding.Visible:=false; plgoto.Visible:=false; plAllDecode.Visible:=false;

plmatrix.Visible:=true; TypeCode:=7; CreateMatrix; end;

procedure Tfmzikl.CreateMatrix;

var i,j:integer; begin With sgInfoMatrix do for i:=0 to RowCount-1 do

      for j:=0 to ColCount-1 do if i=ColCount-1-j then Cells[i,j]:='1' else Cells[i,j]:='0';

        ClearTabl(sgControlMatrix); udObnar.Position:=1; udCorrect.Position:=1;

        edDmin.Text:='3'; gbParamtrCikl.visible:=(TypeCode=7);

        stPolinom.visible:=(TypeCode=7); edPolinom.visible:=(TypeCode=7); end;

procedure Tfmzikl.udInfoMatrixChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection);

var i,j:integer; begin

  With udInfoMatrix,sgInfoMatrix do if (NewValue<=Max) and (NewValue>=min) then

Begin RowCount:=NewValue; ColCount:=NewValue; Width:=NewValue*21+3;

    Height:=Width; sgControlMatrix.RowCount:=NewValue; sgControlMatrix.Height:=Height;

    for i:=0 to RowCount-1 do

      for j:=0 to ColCount-1 do if i=ColCount-1-j then Cells[i,j]:='1' else Cells[i,j]:='0'; end; end;

procedure Tfmzikl.udControlMatrixChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection);

begin With udControlMatrix,sgControlMatrix do if (NewValue<=Max) and (NewValue>=min)

        then begin ColCount:=NewValue; Width:=NewValue*21+3; end; end;

procedure Tfmzikl.sgControlMatrixSetEditText(Sender: TObject; ACol, ARow: Integer;

                                                                                const Value: String);

begin with sgControlMatrix do if (Value<>'0') and (Value<>'1') then Cells[ACol,ARow]:=''; end;

procedure Tfmzikl.udObnarChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection);

 

begin if (NewValue<udObnar.Min) or (NewValue>udObnar.Max) then exit;

   if NewValue<udCorrect.Position then AllowChange:=false else

    edDmin.Text:=IntToStr(NewValue+udCorrect.Position+1) end;

procedure Tfmzikl.udCorrectChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection);

begin if (NewValue<udCorrect.Min) or (NewValue>udCorrect.Max) then exit;

  if NewValue>udObnar.Position then udObnar.Position:=NewValue;

  edDmin.Text:=IntToStr(NewValue+udObnar.Position+1); end;

procedure Tfmzikl.sbcodingClick(Sender: TObject);

var i,j:integer; begin if TypeCode=7 then begin if edPolinom.Text='' then begin

     MessageDlg('Введите образующий полином!',mtWarning,[mbOk],0); exit; end;

for i:=1 to Length(edPolinom.Text) do if (edPolinom.Text[i]<>'0') and (edPolinom.Text[i]<>'1')

      then begin MessageDlg('Неправильно введен образующий полином',mtWarning,[mbOk],0);

          exit; end; end; for i:=0 to sgControlMatrix.ColCount-1 do

    for j:=0 to sgInfoMatrix.ColCount-1 do if sgControlMatrix.Cells[i,j]='' then begin

       ShowMessage('Заполните все ячейки проверочной матрицы!'); exit; end else

if (sgControlMatrix.Cells[i,j]<>'0')and(sgControlMatrix.Cells[i,j]<>'1') then begin

 //MessageDlg('Неправильно заполнена проверочная матрица',mtWarning,[mbOk],0);

ShowMessage('Неправильно заполнена проверочная матрица!'); exit;end;

   if TypeCode=7 then begin Polinom:=edPolinom.Text; Dmin:=StrToInt(edDmin.Text);

  SError:=udCorrect.Position; TError:=udObnar.Position; end;

   LongInfoSym:=sgInfoMatrix.ColCount; LongControlSym:=sgControlMatrix.ColCount;

  for j:=0 to LongInfoSym-1 do begin ObrazMatrix[j]:='';

    for i:=0 to LongInfoSym-1 do

      ObrazMatrix[j]:=ObrazMatrix[j]+sgInfoMatrix.Cells[i,j];

    for i:=0 to LongControlSym-1 do

      ObrazMatrix[j]:=ObrazMatrix[j]+sgControlMatrix.Cells[i,j]; end;

  CodeButton:=true; pllogo.Visible:=false; plInfo.Visible:=false; plstatic.Visible:=false;

    plmatrix.Visible:=false; plgoto.Visible:=false; plAllDecode.Visible:=false;

    plcoding.Visible:=true; ncoding.Enabled:=true; ncanal.Enabled:=false;

    ndecoding.Enabled:=false; ntablcod.Enabled:=true;