program PrjLAB2; // два параметра – 1) имя типизир. файла, 2) имя текстового файла
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
UnLab2;
// свой модуль с типом и процедурами для решения задачи
//--------------------главная программа - меню -------------------------
var
ch: char;
begin
SetConsoleCP(1251); // из модуля Windows
SetConsoleOutputCP(1251);
repeat
writeln('--------------------------------------');
writeln('D - создать новый тип.файл в диалоге; ');
writeln('N - создать из текстового файла; ');
writeln('F - поиск и изменение; ');
writeln('V - просмотр;');
writeln('E - конец.');
write('Ваш выбор?'); readln(ch);
writeln('--------------------------------------');
ch:= UpCase(ch); // символ в верхний регистр (латиница)
case ch of
//--------------------------------------------------------------
//----------первая часть: создание типизированного в диалоге ---
'D': CreateTypedFile1; // вызов соответствующей процедуры для выбора D
//----------вторая часть: создание типизированного файла из текстового
'N': CreateTypedFile2;
//----------третья часть: поиск и редактирование ---------------
'F': FindIVAN;
//-----------просмотр----------------------------------------------
'V': ViewFile;
//-----------выход----------------------------------------------
'E': exit;
//--------------------------------------------------------------
else
begin
writeln('Нет такой команды');
write('Press ENTER'); readln;
end;
end;
until ch='E';
end.
//MODULE
Unit UnLab2; // файл UnLab2.pas
Interface
//Uses
//SysUtils; // ANSIUpperCase и др. - смена регистра и обработка исключений
Type
TSubj = (Физика, Матан, Линал, Инжграф, Программирование);
TMark = ('Отлично', 'Хорошо', 'Удовл', 'Неуд');
TGroup = record
name: string[15];
subj: TSubj;
mark: TMark;
amount: integer;
end;
//----------первая часть: создание типизированного файла в диалоге
Procedure CreateTypedFile1();
//----------вторая часть: создание типизированного файла из текстового
Procedure CreateTypedFile2();
//-------------- третья часть: поиск в типизированном файле ----
Procedure FindIVAN();
//-------------- просмотр типизированного файла ----
Procedure ViewFile();
Implementation // -----------реализационная часть-----------------
//----------первая часть: создание типизированного файла в диалоге
Procedure CreateTypedFile1();
var
Group: TGroup;
fr: file of TGroup; // типизированный файл - файл записей
n, kol: integer;
ch: char;
FileName:string[80];
begin
if ParamCount<1 then
begin
writeln('Мало параметров '#13#10'Press enter');
readln; exit
end;
FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName);
AssignFile(fr, FileName);
Try ReWrite(fr); // или {$I-} ReWrite(fr); {$I+} и if IOResult<>0 then <ошибка>
Except
writeln('Error: не удалось создать типизированный файл ',FileName);
write('Press ENTER'); readln; exit
end;
kol:=0;
repeat
write('Название группы =?');
readln(Group.name);
write('Предмет (0-физика, 1 - матан, 2 - линал, 3 - инжграф, 4- прог) =?');
readln(n);
Group.subj := TSubj(n);
write('Оценка за предмет:');
readln(n);
Group.mark := TMark(abs(n - 5));
write('Кол-во студентов с оценкой ', Group.mark, ' =?');
readln(Group.amount);
write(fr, Group); // запись записи целиком в файл
inc(kol);
write('Ещё? (y/n)');
readln(ch)
until UpCase(ch)='N';
CloseFile(fr);
writeln('Создан типизированный файл из ',kol,' записей');
write('Press ENTER');
readln;
end;
//---------------------------------------------------------------------------------------
//----------вторая часть: создание типизированного файла из текстового
Procedure CreateTypedFile2();
var
Group: TGroup;
ft: TextFile; // текстовый файл
fr: file of TGroup; // типизированный файл - файл записей
n, kol: integer;
ch: char;
FileName:string[80];
begin
if ParamCount<2 then
begin
writeln('Мало параметров '#13#10'Press enter');
readln; exit
end;
FileName:= Paramstr(2);
AssignFile(ft, FileName);
Try Reset(ft);
Except
writeln('Error: не удалось открыть текстовый файл ',Paramstr(2));
write('Press ENTER'); readln; exit
end;
FileName := ParamStr(1);
AssignFile(fr, FileName);
Try ReWrite(fr); // или {$I-} ReWrite(fr); {$I+} и if IOResult<>0 then <ошибка>
Except
writeln('Error: не удалось создать типизированный файл ',FileName);
write('Press ENTER'); readln; exit
end;
kol := 0;
while not eof(ft) do begin
readln(ft, Group.name);
readln(ft, n);
Group.subj := TSubj(n);
readln(ft, n);
Group.mark := TMark(abs(n - 5));
readln(ft, Group.amount);
write(fr, Group);
inc(kol);
end;
CloseFile(ft);
CloseFile(fr);
writeln('Создан типизированный файл из ',kol,' записей');
write('Press ENTER');
readln;
end;
//--------------------------------------------------------------
//-------------- третья часть: поиск в типизированном файле ----
Procedure FindIVAN();
var
Group, Swap: TGroup;
fr: file of TGroup;
n, kol, p: integer;
FileName:string[80];
buf: string[15];
begin
if ParamCount<1 then
begin
writeln('Мало параметров '#13#10'Press enter');
readln; exit
end;
FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName);
AssignFile(fr, FileName);
Try ReSet(fr); // или {$I-} ReSet(fr); {$I+} if IOResult<>0 then
Except
writeln('Error: не удалось открыть типизированный файл ',FileName);
write('Press ENTER'); readln; exit
end;
kol:=0;
p:= FileSize(fr) - 1;
while (p >= 0) and (kol=0) do begin
seek(fr, p);
read(fr, Group);
n := Pos('1', Group.name);
if (n > 0) and (Group.mark = Отлично) and (Group.amount >= 2) then begin
buf := Group.name;
buf[n] := '0';
n := Pos('1', buf);
if n > 0 then begin
writeln('Найдена группа ', Group.name,', предмет: ', Group.subj,', оценка: ', Group.mark, ', кол-во студентов: ', Group.amount);
inc(kol);
if p = 0 then
writeln('Найденная запись является первой, обмен не требуется')
else begin
Seek(fr, 0);
read(fr, Swap);
Seek(fr, 0);
write(fr, Group);
Seek(fr, p);
write(fr, Swap);
writeln('В файле первая запись обменялась местами с записью номер: ', p+1)
end;
end;
end;
p := p - 1;
end;
if kol=0 then
writeln('Данные, соответствующие запросу, не найдены');
CloseFile(fr);
write('Press ENTER'); readln;
end;
//--------------------------------------------------------------
//-------------- просмотр типизированного файла ----
Procedure ViewFile();
var
Group: TGroup;
fr: file of TGroup;
n, kol: integer;
FileName:string[80];
begin
if ParamCount<1 then
begin
writeln('Мало параметров '#13#10'Press enter');
readln; exit
end;
FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName);
AssignFile(fr, FileName);
Try ReSet(fr); // или {$I-} ReSet(fr); {$I+} if IOResult<>0 then
Except
writeln('Error: не удалось открыть типизированный файл ',FileName);
write('Press ENTER'); readln; exit
end;
kol:=0;
while not eof(fr) do
begin
read(fr, Group); // считывание
writeln('Найдена группа ', Group.name,', предмет: ', Group.subj,', оценка: ', Group.mark, ', кол-во студентов: ', Group.amount);
inc(kol);
end;
if kol=0 then
writeln('Данные не найдены')
else
writeln('Найдено ',kol, ' записей');
CloseFile(fr);
write('Press ENTER'); readln;
end;
End.