Работа с записями - файл записей.
Программа вводит список анкет, сохраняет его в файле, читает список анкет из файла,
позволяет добавить анкету к списку, редактировать заданную номером анкету.
Программа использует очень простое и понятное меню.
---- Исходный текст программы ----
Program menu1;
Uses crt, WinDOS;
{Модуль WinDOS можно найти в комплекте BP (Borland Pascal)
Если кому-то нужны модули или весь BP или модули
TP (Tubro Professional), пишите - выложу на сайт.
Можно обойтись без WinDOS, если выкинуть из программы Procedure FileList; -
которая выдает список файлов *.dat в рабочей папке}
Const KP=8;
Type arr = array [1..KP] of String;
anketa=record
FIO: string[45];
dat_r: string[8];
adres: string[50];
curs: 1..5;
gruppa: string[3]
end;
Var i,YY: byte;
C,C1: Char;
a: arr;
ank1: anketa;
Kolic: Integer;
FA: file of anketa;
FName:string;
Procedure ReadFileName(var FN:string);
begin
write(' Введите имя файла -> ');
readln(FN);
end;
Procedure WriteToFile(FN:string; App: Boolean);
{Citaet s klav, zapis v file}
var ta: byte; IOR: Integer; FSize: Longint;
begin ta:= textattr;
Kolic:= 0;
Assign(FA,FN);
If App then
begin
{$I-}
reset(FA);
{$I+}
IOR:= IOResult;
If IOR<>0 then
begin writeln(' Ошибка чтения- файл не найден, IOR= ',IOR);
writeln(' Жми Enter !!'); readln; clrscr;
exit;
end;
FSize:= filesize(FA); Kolic:= FSize;
seek(FA,FSize);
writeln(' **** Сейчас ',FSize,' анкет в файле. Добавь еще... ***');
end else
rewrite(FA);
clrscr;
writeln(' Введите анкеты. Выход - пустая фамилия');
Repeat
writeln(' ********* ',kolic+1,'-я анкета ****************');
write(' Фамилия, И.О. -> '); readln (ank1.FIO);
if ank1.FIO = '' then break;
inc(Kolic);
write(' Дата рожд -> '); readln (ank1.dat_r);
write(' Адрес -> '); readln (ank1.adres);
write(' Курс (1..5) -> '); readln (ank1.curs);
write(' Группа (до 3 симв) -> '); readln (ank1.gruppa);
writeln(' *******************************************');
writeln;
write(FA,ank1);
until false;
Close(FA);
clrscr;
textattr:= ta;
end;
procedure ReadFromFile(FN:string);
var IOR,Nomer: Integer; ta: byte;
ss: Char;
begin
ta:= textattr;
Assign(FA,FN);
{$I-}
Reset(FA);
{$I+}
IOR:= IOREsult;
If IOR<> 0 then
begin writeln(' Ошибка чтения: файл не найден, IOR= ',IOR);
writeln(' Жми Enter !!'); readln; clrscr;
exit;
end;
writeln(' ***** Прочтено из файла '+FN+' ******');
writeln; Nomer:= 1;
while not eof(FA) do
begin
read(FA,ank1);
writeln(' ***** Анкета N: ',Nomer,' *********');
with ank1 do
begin
writeln(' Фамилия: '+FIO);
writeln(' Дата рожден: ', dat_r);
writeln(' Адрес: ',adres);
writeln(' Группа: ',gruppa);
writeln(' Курс: ',curs);
end;
if Nomer mod 4 = 0 then
begin
write(' Для продолжения нажмите клавишу F '); ss:= readkey;
if ss in ['f','F'] then
begin
clrscr;
end;
end;
inc(Nomer);
end;
Close(FA);
write(' Для продолжения жмите Enter'); readln; clrscr;
end;
procedure FindEdit(FN:string);
label me1,me2;
var IOR,Nomer,FSize,ii,kk: Integer; ta,xx: byte;
ss: Char; busik: string;
begin
Assign(FA,FN);
{$I-}
Reset(FA);
{$I+}
IOR:= IOREsult;
If IOR<> 0 then
begin writeln(' Ошибка чтения: файл не найден, IOR= ',IOR);
writeln(' Жми Enter !!'); readln; clrscr;
exit;
end;
FSize:= FileSize(FA);
clrscr;
writeln(' ****** Размер файла= ',FSize,' Жми Enter ***********');
Repeat
write(' Введи номер записи для поиска (1..',FSize,') -> '); readln(Nomer);
seek(FA,Nomer-1);
until (Nomer > 0) and (nomer <= FSize);
read(FA,ank1);
me1: textattr:= $1e; clrscr;
writeln(' ***** Анкета N: ',Nomer,' *********');
with ank1 do
begin
writeln(' Фамилия : '+FIO);
writeln(' Дата рожден : ', dat_r);
writeln(' Адрес : ',adres);
writeln(' Группа : ',gruppa);
writeln(' Курс : ',curs);
end;
writeln; writeln(' Для редактирования жми клавишу:');
writeln (' ----------------------');
writeln(' F - Фамилия');
writeln(' D - Дата рожд');
writeln(' A - Адрес');
writeln(' G - Группа');
writeln(' K - Курс');
writeln(' E - ВЫХОД');
ss:= readkey;
ta := textattr; textattr:= $72;
me2: case ss of
'F','f': begin
write(' Введи FIO -> ');
textattr:= $0a; xx:= whereX; write(' ');
gotoxy(xx,whereY);
readln(ank1.FIO);
end;
'D','d': begin
write(' Введи дату рожден -> ');
textattr:= $0a; xx:= whereX; write(' ');
gotoxy(xx,whereY);
readln(ank1.dat_r);
end;
'A','a': begin
write(' Введи адрес -> ');
textattr:= $0a; xx:= whereX; write(' ');
gotoxy(xx,whereY);
readln(ank1.adres);
end;
'G','g': begin
write(' Введи группу -> ');
textattr:= $0a; xx:= whereX; write(' ');
gotoxy(xx,whereY);
readln(ank1.gruppa);
end;
'K','k': begin
write(' Введи курс (1..5) -> ');
textattr:= $0a; xx:= whereX; write(' ');
gotoxy(xx,whereY);
readln(busik);
val(busik,kk,ii); if ii<>0 then
begin textattr:= $7C;
writeln(' Error!');
goto me2;
end;
if (kk>0) and (kk<6) then
ank1.curs:=kk else
begin writeln(' ',kk,' - неверное значение');
goto me2;
end;
end;
'E','e','у','У': begin textattr:= $1e; clrscr;
end;
end;
if not (ss in ['E','e']) then
begin
clrscr;
goto me1;
end;
seek(FA,Nomer-1);
write(FA,ank1);
textattr:= ta;
Close(FA);
end;
type ts3 = string[3];
Procedure FileList;
var DirInfo : TSearchRec; {Нужно подключить модуль WinDOS в предложении uses}
Begin
FindFirst('*.DAT', faArchive, DirInfo); {Находим 1-й файл с расширением DAT}
{ Аналог команды DIR *.DAT }
While DosError = 0 Do {если больше нет таких файлов, то DosError <> 0 }
Begin
WriteLn(' ',DirInfo.Name); {выводим на экран имя найденного файла}
FindNext(DirInfo); {Находим следующий файл с расширением DAT}
End;
end;
begin { ********** Начало главной программы *************** }
textattr := $1F;
clrscr;
a[1]:=' Ввести с клав,записать в файл ';
a[2]:=' Прочесть из файла на экран ';
a[3]:=' Добавить анкеты к файлу ';
a[4]:=' Редактировать заданную запись ';
a[5]:=' Выход (Esc) ';
a[6]:=' Создать файл ';
a[7]:=' Удалить файл ';
a[8]:=' Показать список файлов .dat ';
yy:= 1;
Repeat
gotoxy(1,1);
For i:=1 to KP do
begin
if i=yy then
textattr:= $F0 else
textattr:= $17;
Writeln (a[i]);
end;
gotoxy(1,yy);
textattr:= $1F;
C := Readkey;
Case C of #0: begin
C1:= readkey;
case c1 of
#72{Up}: begin
if yy > 1 then dec(yy) else
yy:= KP;
end;
#80{Down}: begin
if yy < KP then inc(yy) else
yy:= 1;
end;
end {case C1}
end;
#13{Enter}: begin
textcolor(14);yy:= wherey;
clrscr;
Case yy Of
1: begin
ReadFileName(FName);
WriteToFile(FName,false);
end;
2: begin
ReadFileName(FName);
ReadFromFile(FName);
end;
3: begin
ReadFileName(FName);
WriteToFile(FName,true);
end;
4: begin
ReadFileName(FName);
FindEdit(FName);
end;
5: begin
exit;
end;
6: begin
ReadFileName(FName);
Assign(FA,Fname);
rewrite(FA);
Close(FA);
end;
7: begin
ReadFileName(FName);
Assign(FA,Fname);
erase(FA);
end;
8: begin FileList; writeln;
write(' Для продолжения жмите Enter'); readln;
end;
end;
end;
end;
until c = #27;
end.
