необходимо произвести сортировку по фамилии в БД. Не представляю как это можно сделать,хелп!
Код:
Program baza;
Uses crt;
type spisok=record;
fam:string;
imja:string;
oth:string;
yb:string;
adress:string;
zab:string;
dpp:string;
data:string;
end;
FT= file of spisok;
Var a:ft;
i,z,k,s1:integer;
s:real;
f:string;
Procedure Sozd (var a:ft);
Var i:integer;
zk:spisok;
j:string;
begin
rewrite (a);
while j<>'Y' do
begin
write ('Введите Фамилию ');
readln (zk.fam);
write ('Введите Имя ');
readln (zk.imja);
write ('Введите Отчество ');
readln (zk.oth);
write ('Год рождения ');
Readln (zk.yb);
write ('Адрес ');
readln (zk.adress);
write ('Заболевание ');
readln (zk.zab);
write ('Последнее посещение ');
readln (zk.dpp);
write (a,zk);
writeln ('Завершить ввод данных? ( Y \ N )');
readln (j);
end;
close (a);
end;
Procedure dop(var a:ft);
Var i:integer;
zk:spisok;
j:string;
begin
reset(a);
seek(a,filesize(a));
while j<>('Y') do
begin
write ('Введите Фамилию ');
readln (zk.fam);
write ('Введите Имя ');
readln (zk.imja);
write ('Введите Отчество ');
readln (zk.oth);
write ('Год рождения ');
Readln (zk.yb);
write ('Адрес ');
readln (zk.adress);
write ('Заболевание ');
readln (zk.zab);
write ('Последнее посещение ');
readln (zk.dpp);
write (a,zk);
writeln ('Завершить ввод данных? ( Y \ N )');
readln (j);
end;
close (a);
end;
procedure itog(f:String; var a:ft);
Var i,k,s1:integer;
zk:spisok;
begin
reset(a);
s1:=0;
while not eof(a) do
begin
read (a,zk);
if zk.zab='Диабет' then inc(s1);
end;
writeln('Число больных диабетом:',s1);
if (f<>'05') or (f<>'04') or (f<>'03') then
writeln('enter-назад');
readln;
close(a);
end;
Procedure vyvod (var a:ft; var k:integer;var f:string);
Var i:integer;
zk:spisok;
begin
reset(a);
writeln ('№ Фамилия | Имя | Отчество | Дата р.| Адрес |Болезнь|Посл.визит');
k:=0;
while not eof(a) do
begin
k:=k+1;
write (k);
read (a,zk);
write (zk.fam:11);
write (zk.imja:7);
write (zk.oth:12);
write (zk.yb:9);
write (zk.adress:20);
write (zk.zab:8);
write (zk.dpp:11);
writeln;
end;
writeln;
f:=copy(zk.dpp,4,2);
writeln('enter-назад');
readln;
close (a);
end;
procedure delete (k:integer; var a:ft);
Var n,m:longint;
i:byte;
zk:spisok;
mas:array [1..20] of spisok;
begin
repeat
clrscr;
i:=1;
reset(a);
writeln ('№ Фамилия | Имя | Отчество | Дата р.| Адрес |Болезнь|Посл.визит');
k:=0;
while not eof(a) do
begin
k:=k+1;
write (k);
read (a,zk);
write (zk.fam:11);
write (zk.imja:7);
write (zk.oth:12);
write (zk.yb:9);
write (zk.adress:20);
write (zk.zab:8);
write (zk.dpp:11);
writeln;
end;
writeln;
writeln ('Введите номер записи для удаления ');
readln(n);
if n>k then begin write ('Такого номера нет'); delay(2000); end;
until n<=k;
m:=filesize(a)-n;
seek (a,n);
while not eof(a) do
begin
read (a,mas[i]);
i:=i+1;
end;
close (a);
reset (a);
seek (a,n-1);
truncate (a);
close (a);
reset (a);
seek (a,n-1);
for i:=1 to m do
write (a,mas[i]);
writeln('enter-назад');
readln;
end;
Procedure poisk (var a:ft);
var i,k:integer;
zk:spisok;
name:string;
begin
reset (a);
write ('Введите Фамилию для поиска: ');
readln (name);
writeln ('Список с заданной фамилией ');
writeln ('№ Фамилия | Имя | Отчество | Дата р.| Адрес |Болезнь|Посл.визит');
k:=0;
while not eof(a) do
begin
read (a,zk);
if zk.fam=name then
begin
k:=k+1;
write (k);
write (zk.fam:11);
write (zk.imja:7);
write (zk.oth:12);
write (zk.yb:9);
write (zk.adress:20);
write (zk.zab:8);
write (zk.dpp:11);
writeln;
end;
end;
if k<1 then writeln('Такого пациента нет');
writeln('enter-назад');
readln;
close(a);
end;
begin
repeat
clrscr;
assign (a,'n:\BD1.txt');
writeln ('Меню:');
writeln ('1:Создание ');
writeln ('2:Вывод ');
writeln ('3:Удаление ');
writeln ('4:Поиск ');
writeln ('5:Дополнить таблицу ');
writeln ('6:Итог ');
writeln ('7:Выход ');
readln (z);
clrscr;
case z of
1:sozd(a);
2:vyvod (a,k,f);
3:delete(k,a);
4:poisk (a);
5:dop (a);
6:itog (f,a);
end;
until z=7;
end.