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 FindAndReplace();
//-------------- просмотр типизированного файла ----
Procedure ViewFile();
Function subjToString(subj : TSubj) : string; // преобразование TSubj в строку
Function markToString(mark : TMark) : string; // преобразование TMark в строку
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('Кол-во студентов с оценкой ', markToString(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 FindAndReplace();
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,', предмет: ', subjToString(Group.subj),', оценка: ', markToString(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,', предмет: ', subjToString(Group.subj),', оценка: ', markToString(Group.mark), ', кол-во студентов: ', Group.amount);
inc(kol);
end;
if kol=0 then
writeln('Данные не найдены')
else
writeln('Найдено ',kol, ' записей');
CloseFile(fr);
write('Press ENTER'); readln;
end;
function subjToString(subj : TSubj) : string;
begin
case Ord(subj) of //(Физика, Матан, Линал, Инжграф, Программирование);
0: subjToString := 'Физика';
1: subjToString := 'Матан';
2: subjToString := 'Линал';
3: subjToString := 'Инжграф';
4: subjToString := 'Программирование';
end;
end;
function markToString(mark : TMark) : string;
begin
case Ord(mark) of // (Отлично, Хорошо, Удовл, Неуд);
0: markToString := 'Отлично';
1: markToString := 'Хорошо';
2: markToString := 'Удовл';
3: markToString := 'Неуд';
end;
end;
End.