Работа с записями. Описания выделены в модуль un3.pas
Программа вводит список анкет, сохраняет его в файле, читает список анкет из файла,
позволяет добавить анкету к списку, редактировать заданную номером анкету.
Программа использует очень простое и понятное меню.
Чтобы компилировать модуль un3.pas загружаем текст модуля в среду IDE, выполним "Compile".
Чтобы среда нашла откомпилированный модуль (un3.tpu) можно настроить в опциях среды: Options |
Directories | Unit directories (добавить в окошко имя папки, где находится un3.tpu).
Если в этом окошке уже есть имена папок (обычно: units), то добавлять новую папку нужно
после разделителя точка с запятой.
---- Исходный текст программы ----
Program menu1;
Uses un3,crt;
begin {********** BEGIN of MAIN *************** }
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.
{ ************** модуль un3.pas ************************ }
Unit un3;
interface
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);
Procedure WriteToFile(FN:string; App: Boolean);
procedure ReadFromFile(FN:string);
procedure FindEdit(FN:string);
Procedure FileList;
implementation uses crt, WinDOS;
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;
Procedure FileList;
var DirInfo : TSearchRec; eee: PChar;
Begin
eee:= '*.DAT';
FindFirst(eee, faArchive, DirInfo);
{ Аналог команды DIR *.PAS }
While DosError = 0 Do
Begin
WriteLn(' ',DirInfo.Name);
FindNext(DirInfo);
End;
end;
end.
