TP / 10 / 10-51

program Lab10;

uses Crt;

const
BD = 'BD.dat';
L = 18; { „«Ё­  ⥪бв®ў®Ј® Ї®«п }

type
Pupil = Record
Class, Angl, Mat, Inf: Byte;
FIO, Data, Addr, Tel: String[L];
end;

var
Index: Longint;
f: file of Pupil;

procedure Ekran(str:String);
begin
ClrScr;
GotoXY(32,1);
Write(str);
WriteLn;
WriteLn;
end;

procedure Menu;
begin
Ekran('‹ Ў®а в®а­ п 10');
WriteLn('1 - Џа®б¬®ва');
WriteLn('2 - „®Ў ўЁвм');
WriteLn('3 - €§¬Ґ­Ёвм');
WriteLn('4 - “¤ «Ёвм');
WriteLn('5 - Џ®ЁбЄ');
WriteLn('6 - ‘®авЁа®ўЄ ');
WriteLn('Esc - ‚л室');
end;

procedure PMenu;
begin
WriteLn('1 - ”€Ћ');
WriteLn('2 - „ в  ஦¤Ґ­Ёп');
WriteLn('3 - Ђ¤аҐб');
WriteLn('4 - ’Ґ«Ґд®­');
WriteLn('5 - Љ« бб');
WriteLn('6 - Ђ­Ј«Ё©бЄЁ©');
WriteLn('7 - Њ вҐ¬ вЁЄ ');
WriteLn('8 - €­д®а¬ вЁЄ ');
WriteLn;
end;

procedure Title;
begin
WriteLn('” ¬Ё«Ёп €¬п ЋвзҐбвў®':L,'„ в  ஦¤Ґ­Ёп':L,'Ђ¤аҐб':L,'’Ґ«Ґд®­':L);
WriteLn('Љ« бб':L,'Ђ­Ј«Ё©бЄЁ©':L,'Њ вҐ¬ вЁЄ ':L,'€­д®а¬ вЁЄ ':L);
WriteLn;
end;

procedure Prosmotr;
var
w: Pupil;
i: Byte;
begin
reset(f);
Ekran('Џа®б¬®ва');
Title;
for i:=1 to Index do begin
Read(f,w);
if w.Class > 0 then
with w do begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
close(f);
ReadLn;
end;

procedure Dobavlenie;
var
w: Pupil;
begin
repeat
reset(f);
Seek(f,Index);
Ekran('„®Ў ў«Ґ­ЁҐ');
with w do begin
Inc(Index); WriteLn(Index);
Write('”€Ћ: '); ReadLn(FIO);
Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(Data);
Write('Ђ¤аҐб: '); ReadLn(Addr);
Write('’Ґ«Ґд®­: '); ReadLn(Tel);
Write('Љ« бб: '); ReadLn(Class);
Write('Ђ­Ј«Ё©бЄЁ©: '); ReadLn(Angl);
Write('Њ вҐ¬ вЁЄ : '); ReadLn(Mat);
Write('€­д®а¬ вЁЄ : '); ReadLn(Inf);
end;
Write(f,w);
close(f);
WriteLn;
WriteLn('Esc - ¬Ґ­о');
until ReadKey = #27;
end;

procedure Redact;
var
w: Pupil;
i: Longint;
begin
repeat
reset(f);
Ekran('ђҐ¤ ЄвЁа®ў ­ЁҐ');
Write('Ќ®¬Ґа иЄ®«м­ЁЄ : ');
ReadLn(i);
if not (i <= Index) and (i >= 1) then begin
WriteLn('Ќ®¬Ґа ¤®«¦Ґ­ Ўлвм: 1..',Index);
ReadLn;
break;
end
else with w do begin
Write('”€Ћ: '); ReadLn(FIO);
Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(Data);
Write('Ђ¤аҐб: '); ReadLn(Addr);
Write('’Ґ«Ґд®­: '); ReadLn(Tel);
Write('Љ« бб: '); ReadLn(Class);
Write('Ђ­Ј«Ё©бЄЁ©: '); ReadLn(Angl);
Write('Њ вҐ¬ вЁЄ : '); ReadLn(Mat);
Write('€­д®а¬ вЁЄ : '); ReadLn(Inf);
Seek(f,i-1); Write(f,w);
end;
close(f);
WriteLn;
WriteLn('Esc - ¬Ґ­о');
until ReadKey = #27;
end;

procedure Udalenie;
var
i,n: Longint;
w: Pupil;
begin
repeat
WriteLn;
WriteLn('O - “¤ «Ёвм ®¤­г § ЇЁбм');
WriteLn('A - “¤ «Ёвм ўбҐ § ЇЁбЁ');
WriteLn;
case UpCase(ReadKey) of
'O': begin
Write('Ќ®¬Ґа иЄ®«м­ЁЄ : ');
ReadLn(n);
if not (n <= Index) and (n >= 1) then begin
WriteLn('Ќ®¬Ґа ¤®«¦Ґ­ Ўлвм: 1..',Index);
ReadLn;
break;
end
else begin
reset(f);
for i:= n to Index-1 do begin
Seek(f,i); Read(f,w);
Seek(f,i-1); Write(f,w);
end;
Seek(f,FileSize(f)-1);
TruncAte(f);
Dec(Index);
close(f);
WriteLn('„ ­­лҐ г¤ «Ґ­л');
end;
end;
'A': begin
erase(f);
rewrite(f);
close(f);
Index:= 0;
WriteLn('‚ᥠ¤ ­­лҐ г¤ «Ґ­л');
end;
end;
WriteLn;
WriteLn('Esc - ¬Ґ­о');
until ReadKey = #27;
end;

procedure Poisk;
var
i: Longint;
ws,w: Pupil;
begin
repeat
reset(f);
Ekran('Џ®ЁбЄ');
PMenu;
Case ReadKey of
'1': begin
Write('”€Ћ: '); ReadLn(ws.FIO);
Title;
for i:=1 to Index do With w do begin
Read(f,w);
if Pos(ws.FIO,FIO) > 0 then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'2': begin
Write('„ в  ஦¤Ґ­Ёп: '); ReadLn(ws.Data);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if Pos(ws.Data,Data) > 0 then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'3': begin
Write('Ђ¤аҐб: '); ReadLn(ws.Addr);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if Pos(ws.Addr,Addr) > 0 then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'4': begin
Write('’Ґ«Ґд®­: '); ReadLn(ws.Tel);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if Pos(ws.Tel,Tel) > 0 then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'5': begin
Write('Љ« бб: '); ReadLn(ws.Class);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if ws.Class = Class then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'6': begin
Write('Ђ­Ј«Ё©бЄЁ© '); ReadLn(ws.Angl);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if ws.Angl = Angl then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'7': begin
Write('Њ вҐ¬ вЁЄ  '); ReadLn(ws.Mat);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if ws.Mat = Mat then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
'8': begin
Write('€­д®а¬ вЁЄ  '); ReadLn(ws.Inf);
Title;
for i:=1 to Index do with w do begin
Read(f,w);
if ws.Inf = Inf then begin
WriteLn(FIO:L,Data:L,Addr:L,Tel:L);
WriteLn(Class:L,Angl:L,Mat:L,Inf:L);
end;
end;
end;
end;
close(f);
WriteLn;
WriteLn('Esc - ¬Ґ­о');
until ReadKey = #27;
end;

function Direct(C: Boolean; D: Char): Boolean;
begin
if D = '+' then Direct:= C else Direct:= not C;
end;

procedure Sortirovka;
var
Ch,D: Char;
Comp: Boolean;
i,j,Nt: Longint;
w1,w2,t: Pupil;
begin
repeat
Ekran('‘®авЁа®ўЄ ');
PMenu;
Ch:= ReadKey;
Case Ch of
'1': WriteLn('”€Ћ');
'2': WriteLn('„ в  ஦¤Ґ­Ёп');
'3': WriteLn('Ђ¤аҐб');
'4': WriteLn('’Ґ«Ґд®­');
'5': WriteLn('Љ« бб');
'6': WriteLn('Ђ­Ј«Ё©бЄЁ©');
'7': WriteLn('Њ вҐ¬ вЁЄ ');
'8': WriteLn('€­д®а¬ вЁЄ ');
end;
Write('Ќ Їа ў«Ґ­ЁҐ (+,-): '); ReadLn(D);
reset(f);
for i:=0 to Index-2 do begin
Seek(f,i); Read(f,w1);
t:= w1; Nt:= i;
{******************************************************}
for j:=i to Index-1 do begin
Seek(f,j); Read(f,w2);
Case Ch of
'1': Comp:= Direct(w2.FIO < w1.FIO, D);
'2': Comp:= Direct(w2.Data < w1.Data, D);
'3': Comp:= Direct(w2.Addr < w1.Addr, D);
'4': Comp:= Direct(w2.Tel < w1.Tel, D);
'5': Comp:= Direct(w2.Class < w1.Class, D);
'6': Comp:= Direct(w2.Angl < w1.Angl, D);
'7': Comp:= Direct(w2.Mat < w1.Mat, D);
'8': Comp:= Direct(w2.Inf < w1.Inf, D);
end;
if Comp then begin
t:= w2;
Nt:= j;
end;
end;
{******************************************************}
Case Ch of
'1': Comp:= Direct(t.FIO < w1.FIO, D);
'2': Comp:= Direct(t.Data < w1.Data, D);
'3': Comp:= Direct(t.Addr < w1.Addr, D);
'4': Comp:= Direct(t.Tel < w1.Tel, D);
'5': Comp:= Direct(t.Class < w1.Class, D);
'6': Comp:= Direct(t.Angl < w1.Angl, D);
'7': Comp:= Direct(t.Mat < w1.Mat, D);
'8': Comp:= Direct(t.Inf < w1.Inf, D);
end;
if Comp then begin
Seek(f,i); Write(f,t);
Seek(f,Nt); Write(f,w1);
end;
end;
close(f);
Prosmotr;
WriteLn;
WriteLn('Esc - ¬Ґ­о');
until ReadKey = #27;
end;

begin
assign(f,BD);
{$I-}
reset(f);
{$I+}
if IOResult<>0 then rewrite(f);
Index:= FileSize(f);
close(f);
repeat
Menu;
case ReadKey of
'1': Prosmotr;
'2': Dobavlenie;
'3': Redact;
'4': Udalenie;
'5': Poisk;
'6': Sortirovka;
#27: exit;
end;
until False
end.