Rest=array[0 n1] of byte; { Остаток }

Polinom=array[0 n1] of byte; { Образующий полином P(x) }

Procedure Init(var m1:Move_code;var p1:Polinom;

var r1:Rest;var flag:integer);

Procedure FxPx(var m6:Move_Code);

Procedure Divizion(var m2:Move_code;var r2:Rest;

p2:Polinom;var flag:integer);

Procedure BildMoveCode(var m3:Move_code;r3:Rest;var flag:integer);

Procedure Decoder(var m6:Move_Code);

Procedure MakeError(var m4:Move_code;var err:integer);

Procedure BildMoveCodeMultiplication(var m7:Move_Code);

Procedure Correction(var m5:Move_code;p5:Polinom;var r5:Rest);

Implementation

Procedure Init;

var

i:integer;

begin

p1[5]:=1;

p1[4]:=1;

p1[3]:=1;

p1[2]:=1;

p1[1]:=0;

p1[0]:=1;

flag:=0;

for i:=n1 downto 0 do

r1[i]:=0;

Randomize;

for i:=n-n1 downto 0 do

m1[i]:=random(2);

end;

Procedure FxPx(var m6:Move_Code);

var

i:integer;

k:byte;

begin

k:=5;

while(k>0) do

begin

for i:=n downto 1 do

m6[i]:=m6[i-1];

dec(k);

end;

for i:=n1-1 downto 0 do

m6[i]:=0;

end;

Procedure Divizion(var m2:Move_code;var r2:Rest;

p2:Polinom;var flag:integer);

label

RETURN;

var

i,j,i1,kol,Countzero:integer;

begin

j:=n;

RETURN:while((j>=0)and(m2[j]=0))do dec(j);

if(j>n1)

then begin

for i:=n1 downto 0 do

begin

r2[i]:=m2[j];

dec(j);

end;

while(j>=0)do

begin

for i:=n1 downto 0 do

r2[i]:=r2[i] xor p2[i];

i1:=n1;

while((i1>=0)and(r2[i1]=0))do dec(i1);

if(i1=-1)then goto RETURN;

Kol:=n1-i1;

while(Kol>0)do

begin

for i:=n1 downto 1 do

r2[i]:=r2[i-1];

dec(Kol);

end;

Kol:=n1-i1;

while((Kol>0)and(j>=0))do

begin

r2[Kol-1]:=m2[j];

dec(Kol);

dec(j);

end;

if((j=-1)and(Kol=0))

then begin

for i:=n1 downto 0 do

r2[i]:=r2[i] xor p2[i];

end

else flag:=Kol;

end;

end

else if(n1=j)

then begin

for i:=n1 downto 0 do

begin

r2[i]:=m2[j];

dec(j);

end;

for i:=n1 downto 0 do

r2[i]:=r2[i] xor p2[i]

end

else if(j<n1)

then begin

for i:=j downto 0 do

r2[i]:=m2[i]

end;

end;

Procedure BildMoveCode(var m3:Move_code;r3:Rest;var flag:integer);

var

i,k:integer;

begin

if(flag>0)then

begin

k:=n1-flag;

for i:=n1 downto flag do

begin

m3[k]:=r3[i];

dec(k);

end;

end

else begin

for i:=n1-1 downto 0 do

m3[i]:=r3[i];

end;

end;

Procedure MakeError(var m4:Move_code;var err:integer);

begin

Randomize;

err:=Random(n);

m4[err]:=m4[err] xor 1;

end;

Procedure Decoder(var m6:Move_Code);

var

i:integer;

k:byte;

begin

k:=5;

while(k>0) do

begin

for i:=0 to n-1 do

m6[i]:=m6[i+1];

dec(k);

end;

for i:=n downto n-n1+1 do

m6[i]:=0;

end;

Procedure BildMoveCodeMultiplication(var m7:Move_Code);

var

m1,m2,m3,m4,mm:Move_Code;

i,j:integer;

begin

mm:=m7;

m1:=m7;

for j:=0 to 1 do

begin

for i:=n downto 1 do

m1[i]:=m1[i-1];

m1[j]:=0;

end;

m2:=m7;

for j:=0 to 2 do

begin

for i:=n downto 1 do

m2[i]:=m2[i-1];

m2[j]:=0;

end;

m3:=m7;

for j:=0 to 3 do

begin

for i:=n downto 1 do

m3[i]:=m3[i-1];

m3[j]:=0;

end;

m4:=m7;

for j:=0 to 4 do

begin

for i:=n downto 1 do

m4[i]:=m4[i-1];

m4[j]:=0;

end;

for i:=n downto 0 do

m7[i]:=mm[i] xor m1[i]xor m2[i]xor m3[i] xor m4[i];

end;

Procedure Correction(var m5:Move_code;p5:Polinom;var r5:Rest);

var

i,Correctflag,i1:integer;

Count,Countcarry,Carryflag:byte;

begin

Correctflag:=0;

Countcarry:=0;

repeat

for i:=n1 downto 0 do

r5[i]:=0;

Count:=0;

Divizion(m5,r5,p5,Correctflag);

i1:=n1;

while((i1>=Correctflag)and(r5[i1]=0))do dec(i1);

if({(i1=Correctflag-1) or

(}(i1=Correctflag)and(r5[Correctflag]=1)){)}

then m5[0]:=m5[0] xor r5[Correctflag]

else begin

Carryflag:=m5[n];

for i:=n downto 1 do

m5[i]:=m5[i-1];

m5[0]:=Carryflag;

inc(Countcarry);

end;

until ({(i1=Correctflag-1) or

(}(i1=Correctflag)and(r5[Correctflag]=1));{);}

while (Countcarry>0) do

begin

Carryflag:=m5[0];

for i:=0 to n-1 do

m5[i]:=m5[i+1];

m5[n]:=Carryflag;

dec(Countcarry);

end;

end;

end.

Приложение № 2

Процедуры и функции модуля _Serv.

Unit _SERV;

Interface

Uses

Crt,Dos;

Const

EmptyBorder =0;

SingleBorder =1;

DoubleBorder =2;

BorderChar:array[0 2,1 6] of Char=

((#32,#32,#32,#32,#32,#32),

(#218,#196,#191,#179,#192,#217),

(#201,#205,#187,#186,#200,#188));

MaxChar =80;

MaxLine =25;

MenuTop =3;

SubMenuTop =2;

MenuLine :array[1 MenuTop]of string[20]=

(' О программе .',' Демонстрация ' ‘Выход ');

SubMenuLine :array[1 SubMenuTop]of string[20]=

(' Сложением' , ' Умножением');

Procedure SetWindow(x1,y1,x2,y2,Bord:byte;Header:string);

Procedure CursorOff;

Function GetMainMenuChoice:byte;

Function GetSubMenuChoice:byte;

Procedure About;

Implementation

Procedure SetWindow(x1,y1,x2,y2,Bord:byte;Header:string);

var

i:integer;

begin

if not ((x1<1) or (x2<=x1) or

(y1<1) or (y2<=y1) or (x2>MaxChar) or

(y2>MaxLine) or (Bord>2)) then

begin

GotoXY(x1,y1);

Write(BorderChar[Bord,1]);

for i:=1 to x2-x1-1 do

begin

GotoXY(x1+i,y1);

Write(BorderChar[Bord,2]);

end;

GotoXY(x2,y1);

Write(BorderChar[Bord,3]);

for i:=1 to y2-y1-1 do

begin

GotoXY(x1,y1+i);

Write(BorderChar[Bord,4]);

GotoXY(x2,y1+i);

Write(BorderChar[Bord,4]);

end;

GotoXY(x1,y2);

Write(BorderChar[Bord,5]);

for i:=1 to x2-x1-1 do

begin

GotoXY(x1+i,y2);

Write(BorderChar[Bord,2]);

end;

GotoXY(x2,y2);

Write(BorderChar[Bord,6]);

end;

GotoXY((x2-x1-ord(Header[0])) div 2+x1,y1);

Write(Header)

end;

Procedure CursorOff;

begin

asm

mov ah,1

mov ch,20h

int 10h

end;

end;

Function GetMainMenuChoice:byte;

var

Count:byte;

i:integer;

ch,ch1:char;

begin

Count:=1;

while KeyPressed do

ch:=Readkey;

repeat

for i:=1 to MenuTop do

begin

if(i=Count)then

begin

HighVideo;

TextColor(0);

end

else

begin

LowVideo;

TextColor(8);

end;

GotoXY(25,10+i);

Writeln(MenuLine[i]);

CursorOff;

end;

if KeyPressed

then begin

ch:=Readkey;

if(ch=#0)