Правила форума
Прочтите прежде чем задавать вопрос!
*Тупанул при написании. Для запуска файла надо в том же каталоге создать файл "database" и указать его имя при запросе в программе.
program students;
uses crt,dos;
label ChangeFile;
type spisok = record
nomer: string[6]; // Порядковый номер
zach: string[7]; // Номер зачетной книжки
fam: string[20]; // Фамилия
imya: string[20]; // Имя
otch: string[20]; //Отчество
gruppa: string[8]; //Номер группы
end;
StudentDataBase = file of spisok;
var a: StudentDataBase;
i, z: integer;
s: real;
c:char;
q:boolean;
DataBase: string;
k:byte;
p:string;
ss:string;
{-------------------------------------------------> INPUT}
procedure new(var a: StudentDataBase);
var j: integer; zk: spisok;
begin
reset(a);
seek(a, filesize(a));
repeat
begin
with zk do begin
writeln;
write('#................: ');
readln(nomer);
write('Зачетная книжка..: ');
readln(zach);
write('Фамилия..........: ');
readln(fam);
write('Имя..............: ');
readln(imya);
write('Отчество.........: ');
Readln(otch);
write('Группа...........: ');
readln(gruppa);
writeln;
write(a, zk);
writeln;
writeln('Продолжить запись? Да: 1 Нет: 0');
readln(j);
end;
end;
until j =0;
close(a);
end;
{-----------------------------------------------> // INPUT}
{-------------------------------------------------> OUTPUT}
procedure output(var a: StudentDataBase);
var i: integer; zk: spisok;
begin
with zk do begin
clrscr;
reset(a);
writeln;
writeln(' База данных "Студенты" ');
writeln;
writeln(& #39;============================================================================
===');
writeln(' № | з/книжка | Фамилия | Имя | Отчество | Группа ');
writeln(& #39;============================================================================
===');
while not eof(a) do
begin
read(a, zk);
write(nomer:6);
write('|', zach: 10);
write('|', fam: 17);
write('|', imya: 13);
write('|', otch: 18);
write('|', gruppa: 8);
writeln;
writeln('-------------------------------------------------------------------------------');
end;
writeln;
writeln(' Нажмите клавишу Enter для перехода в меню...');
close(a);
end;
readln;
end;
{-----------------------------------------------> // OUTPUT}
{------------------------------------------> FIND}
procedure find(var a: StudentDataBase);
var i: integer;
zk: spisok;
student: string;
begin
clrscr;
reset(a);
write('Введите данные для поиска: ');
readln(student);
writeln;
writeln(' База данных "Студенты" ');
writeln;
writeln(& #39;============================================================================
===');
writeln(' № | з/книжка | Фамилия | Имя | Отчество | Группа ');
writeln(& #39;============================================================================
===');
while not eof(a) do
begin
with zk do begin
read(a, zk);
if (zach = student) or (fam=student) or (imya=student) or (otch=student) or (gruppa=student) then
begin
write(nomer:6);
write('|', zach: 10);
write('|', fam: 17);
write('|', imya: 13);
write('|', otch: 18);
write('|', gruppa: 8);
writeln;
writeln('-------------------------------------------------------------------------------');
end;
end;
end;
close(a);
writeln;
writeln(' Нажмите клавишу Enter для перехода в меню...');
readln;
end;
{------------------------------------------> // FIND}
begin
changefile:
{------------------------------------------> LOADING}
clrscr;
write('Укажите имя загружаемой базы: ');
readln(DataBase);
repeat
clrscr;
assign(a, DataBase);
{------------------------------------------> // LOADING} // временно отключил
{-------> MENU}
write('Disk Size: ', DiskSize(0) div 1024 div 1024, ' Мбайт');
writeln;
write('Current File: ', DataBase);
writeln;
writeln('Menu: ');
writeln;
writeln('1: New Record(-s)');
writeln('2: Output Record(-s)');
writeln('3: Find Record(-s)');
writeln('4: Change File | отключил');
writeln('5: Exit');
writeln('6: Delete File');
writeln('7: Add Record(-s) | не работает');
writeln('8: Delete Record(-s) | не работает');
writeln('9: Current Record: | не работает');
readln(z);
case z of
1: new(a);
2: output(a);
3: find(a);
4: goto changefile;
5: q:=true;
6: begin
erase(a);
writeln;
write('File ', Database, ' was deleted');
readln;
end;
end;
until q;
end.
Сообщение отредактировано: hemm -
