Программа состоит из главной программы и трех модулей: модуль работы с файлами UFile, модуль работы с одним элементом UElem и модуль вспомогательных процедур HelpUtils (рис.6.1).

Размещено на http://www.allbest.ru/

Рис.6.1 Структура программы

Модуль для работы с файлами отвечает за создание нового файла, открытие уже существующего типизированного файла, загрузку данные из текстового файла в типизированный, печатать содержимого типизированного файла на экран и сохранение его в текстовый файл. Кроме того, модуль отвечает за добавление элемента в типизированный файл, изменение элемента и его удаление.

Модуль для работы с одним элементом отвечает за ввод данных об одной записи, печать одной записи, загрузку записи из типизированного файла, изменение записи и сохранение в типизированный файл.

Модуль вспомогательных процедур отвечает за проверку корректности имен файлов, вывод на экран информационных сообщений и вопросов.

а). Модуль вспомогательных процедур

Модуль HelpUtils содержит следующие вспомогательные процедуры:

· ShowMessage (txt: string) - вывод информационного сообщения;

· InputQuery (txt: string): Boolean - вывод вопроса, подразумевающий положительный или отрицательный ответ;

· InputFileName (txt: string; var FileName: string; MustExists: boolean): Boolean - ввод имени файла с проверкой на его существование.

б). Модуль для работы с одним элементом

Модуль UElem отвечает за работу с одной записью.

Структура записи:

TCatalog = record

name: string [8]; // имя файла

special: string [3]; // спецификация

сreate: TDate; // дата создания

blocks: integer; // количество блоков

end;

Тест 1. Тест функции "Создать файл".

Цель. Проверка корректной работы функции создания при работе с типизированным файлом.

Порядок проведения. В меню программы выбрать пункт "1 - Создать файл". После запроса программы ввести имя нового файла. Если на диске уже существует файл с заданным именем, будет выведено информационное сообщение с предложением заменить существующий файл. При утвердительном ответе пользователя существующий файл будет удален с диска, и создан новый. Если на диске не существовало файла с заданным именем, то он будет создан.

Результат. На диске должен быть создан типизированный файл с заданным именем. В окне программы должно быть выведено сообщение об успешном создании.

Тест 2. Тест функции "Открыть файл".

Цель. Проверка корректной работы функции открытия при работе с типизированным файлом.

Порядок проведения. В меню программы выбрать пункт "2 - Открыть файл". После запроса программы ввести имя существующего файла. Если файл не найден на диске, об этом будет выведено информационное сообщение. Если файл найден, он станет доступным для чтения и записи.

Результат. Типизированный файл должен стать доступным для записи и чтения. В окне программы должно быть выведено сообщение об успешном открытии файла.

Тест 3. Тест функции "Загрузить данные из текстового файла".

Цель. Проверка корректной работы функции загрузки данных из текстового файла в типизированный.

Порядок проведения. В меню программы выбрать пункт "3 - Загрузить данные из текстового файла". После запроса программы ввести имя текстового файла. Если данный файл не существует на диске, об этом сразу будет выведено информационное сообщение. Если текстовый файл найден, программа запросит имя типизированного файла. При существовании файла с заданным именем пользователю будет предложено заменить существующий файл. При утвердительном ответе будет создан новый типизированный файл, в который скопированы данные из текстового.

Результат. Все данные текстового файла должны быть скопированы в типизированный. В окне программы должно быть выведено сообщение об успешной загрузке данных.

Тест 4. Тест функции "Сохранить в текстовый файл".

Цель. Проверка корректной работы функции сохранения данных из типизированного файла в текстовый.

Порядок проведения. В меню программы выбрать пункт "5 - Сохранить в текстовый файл". После запроса программы ввести имя нового текстового файла. При существовании файла с заданным именем пользователю будет предложено заменить существующий файл. При утвердительном ответе будет создан новый текстовый файл, в который скопированы данные из типизированного.

Результат. На диске должен быть создан текстовый файл с заданным именем, в который скопированы все данные из типизированного файла. В окне программы должно быть выведено сообщение об успешном создании текстового файла.

Тест 5. Тест функции "Добавить запись".

Цель. Проверка корректной работы функции добавления новой записи в типизированный файл.

Порядок проведения. В меню программы выбрать пункт "6 - Добавить запись". Далее программа будет запрашивать информацию по полям записи. При некорректном вводе любого из полей будет выведено информационное сообщение. После корректного ввода записи будет запрос "Добавить ещё запись?". При утвердительном ответе пользователя процедура добавления начнется заново, при отрицательном будет выведено сообщение об успешном добавлении данных.

Результат. В конец типизированного файла должна быть добавлена новая запись. В окне программы должно быть выведено сообщение об успешном добавлении.

Тест 6. Тест функции "Редактировать запись".

Цель. Проверка корректной работы функции редактирования в типизированном файле.

Порядок проведения. В меню программы выбрать пункт "7 - Редактировать запись". После запроса программы ввести номер нужной записи. При некорректном вводе номера будет выведено сообщение об ошибке. При корректном вводе номера данная запись будет напечатана, появится запрос на утверждение редактирования. Далее программа будет редактировать запись по полям, предварительно уточняя: желает ли пользователь изменить данное поле. При некорректном вводе любого из полей будет выведено информационное сообщение. После корректного изменения записи будет выведено сообщение об успешном редактировании данных.

Результат. Выбранная пользователем запись должна быть изменена. В окне программы должно быть выведено сообщение об успешном изменении записи.

Тест 7. Тест функции "Удалить запись".

Цель. Проверка корректной работы функции удаления указанной записи в типизированном файле.

Порядок проведения. В меню программы выбрать пункт "8 - Удалить запись". После запроса программы ввести номер нужной записи. При некорректном вводе номера будет выведено сообщение об ошибке. При корректном вводе номера данная запись будет напечатана, появится запрос на утверждение удаления. При утвердительном ответе пользователя выбранная запись будет удалена из типизированного файла. На экран будет выведено сообщение об успешном удалении записи.

Результат. Выбранная пользователем запись должна быть удалена из типизированного файла. В окне программы должно быть выведено сообщение об успешном удалении.

Тест 8. Тест функции "Занести в отдельный файл записи с заданной спецификацией".

Цель. Проверка корректной работы функции создания нового типизированного файла, содержимом которого должны быть выбранные с учетом условий записи из открытого типизированного файла.

Порядок проведения. В меню программы выбрать пункт "9 - Занести в отдельный файл записи с заданной спецификацией". После запроса программы "Введите имя файла-отчета" ввести имя нового типизированного файла-отчета. При существовании файла с заданным именем пользователю будет предложено заменить существующий файл. При утвердительном ответе будет создан новый типизированный файл, и программа выдаст запрос на ввод искомой спецификации. В новый типизированный файл будут скопированы все записи с заданной спецификацией, и выведено сообщение "Отчёт сформирован. Напечатать отчет?". При утвердительном ответе будет напечатано содержимое файла-отчёта. Если данный файл пуст, появится информационное сообщение "Файл пуст".

Результат. На диске должен быть создан новый типизированный файл с заданным именем, содержащий записи, удовлетворяющие условию поиска. В окне программы должно быть выведено сообщение об успешном создании файла-отчета.

Заключение

const

Yes = ['Y','y','Н','н'];

No = ['N','n','Т','т'];

YesOrNo = Yes + No;

// вывод сообщения

procedure ShowMessage (txt: string);

// вывод вопроса

function InputQuery (txt: string): Boolean;

// ввод имени файла

function InputFileName (txt: string; var FileName: string;

MustExists: boolean): Boolean;

implementation

// вывод сообщения

procedure ShowMessage (txt: string);

begin

Writeln (txt);

readln;

end;

// вывод вопроса

function InputQuery (txt: string): Boolean;

var ch: Char;

begin

Writeln (txt);

repeat

Readln (ch);

until ch in YesOrNo;

Result: = ch in Yes;

end;

// проверка на корректность имени файла

function CheckFileName (FileName: string): Boolean;

const Banned = ['\','/',': ','*','? ','"','<','>','|'];

var i: Integer;

begin

Result: =True;

i: =1;

while Result and (i<=Length (FileName)) do

begin

Result: = not (FileName [i] in Banned);

Inc (i);

end;

end;

// ввод имени файла

function InputFileName (txt: string; var FileName: string;

MustExists: boolean): Boolean;

var name: string;

begin

Result: =True;

Writeln (txt,' (пустая строка - отмена) ');

Readln (name);

if name='' then Result: =False

else

if not CheckFileName (name)

then

begin

ShowMessage ('Имя введено некорректно! ');

Result: =False;

end

else

if MustExists

then

if FileExists (name) then FileName: =name

else

begin

ShowMessage ('Файл не найден! ');

Result: =false

end

else

if not FileExists (name) then FileName: =name

else

if InputQuery ('Файл существует. Заменить? ')

then FileName: =name

else Result: =false;

end;

end. // HelpUtils

Приложение 2. Модуль UElem

SysUtils,windows,

HelpUtils;

type

TDate = record

day,month,year: Integer;

end;

TCatalog = record

name: string [8];

special: string [3];

Create: TDate;

blocks: integer;

end;

// ввод даты создания

procedure InputDate (var d: TDate);

// ввод данных о файле

procedure InputCatalog (var f: TCatalog);

// перевод даты в строку

function DateToStr (d: TDate): string;

// печать информации о файле

procedure PrintCatalog (f: TCatalog);

// сохранить информацию о файле

procedure SaveCatalog (var t: TextFile; f: TCatalog);

// загрузить информацию о файле

function LoadCatalog (var t: TextFile; var f: TCatalog): Boolean;

// перевод строки в формат даты

function TryStrToDate (s: string; var d: TDate): Boolean;

// изменение информации о файле

procedure EditCatalog (var f: TCatalog);

implementation

// поиск количества дней в месяце

function CountDaysInMonth (m, g: integer): integer;

begin

case m of

2: if (g mod 4) =0 then CountDaysInMonth: =29

else CountDaysInMonth: =28;

4,6,9,11: CountDaysInMonth: =30;

else CountDaysInMonth: =31;

end;

end;

// ввод даты создания

procedure InputDate (var d: TDate);

begin

repeat

Writeln ('Введите последние две цифры года создания файла');

Readln (d. year);

if not (d. year in [00.99])

then ShowMessage ('Ошибка! Повторите ввод! ');

until d. year in [00.99];

repeat

Writeln ('Введите месяц создания файла');

Readln (d. month);

if not (d. month in [1.12])

then ShowMessage ('Ошибка! Повторите ввод! ');

until d. month in [1.12];

repeat

Writeln ('Введите день создания файла');

Readln (d. day);

if not (d. day in [1. CountDaysInMonth (d. month,d. year)])

then ShowMessage ('Ошибка! Повторите ввод! ');

until d. day in [1. CountDaysInMonth (d. month,d. year)];

end;

// ввод данных о файле

procedure InputCatalog (var f: TCatalog);

begin

repeat

writeln ('Введите имя файла');

Readln (f. name);

if f. name=''

then ShowMessage ('Ошибка! Имя не должно быть пустым! Повторите ввод! ');

until f. name<>'';

Writeln ('Введите специализацию');

Readln (f. special);

InputDate (f. create);

repeat

Writeln ('Введите количество блоков');

Readln (f. blocks);

if f. blocks<0 then

ShowMessage ('Ошибка! Размер файла должен быть положительным! Повторите ввод! ');

until f. blocks>=0;

end;

// перевод даты в строку

function DateToStr (d: TDate): string;

begin

Result: ='';

if d. day<10 then Result: ='0';

Result: =Result+IntToStr (d. day) +'. ';

if d. month<10 then Result: =Result+'0';

Result: =Result+IntToStr (d. month) +'. ';

if d. year<10 then Result: =Result+'0';

Result: =Result+IntToStr (d. year);

end;

// печать информации о файле

procedure PrintCatalog (f: TCatalog);

begin

SaveCatalog (output, f);

end;

// сохранить информацию о файле

procedure SaveCatalog (var t: TextFile; f: TCatalog);

begin

Writeln (t,'Имя файла: ',f. name);

Writeln (t,'Спецификация: ',f. special);

Writeln (t,'Дата создания: ',DateToStr (f. Create));

Writeln (t,'Количество блоков: ',f. blocks);

Writeln (t);

end;

// проверка корректности содержимого файла

function GetValueFromFile (var t: TextFile; var s: string): Boolean;

var p: Integer;

begin

if Eof (t) then Result: =False

else

begin

Readln (t,s);

p: =Pos (': ',s);

if p=0 then Result: =False

else

begin

delete (s,1,p);

s: =Trim (s);

Result: =True;

end;

end;

end;

// проверка корректности даты

function CheckDate (d: TDate): boolean;

begin

Result: = (d. year in [00.99]) and (d. month in [1.12]) and

(d. day in [1. CountDaysInMonth (d. month,d. year)]);

end;

// загрузка информации о файле

function LoadCatalog (var t: TextFile; var f: TCatalog): Boolean;

var s: string; d: TDate; num: integer;

begin

Result: =True;

if GetValueFromFile (t,s) and (s<>'') then f. name: =s

else Result: =False;

if Result and GetValueFromFile (t,s) then f. special: =s

else Result: =False;

if Result and GetValueFromFile (t,s) and TryStrToDate (s,d) andCheckDate (d)

then f. Create: =d

else Result: =False;

if Result and GetValueFromFile (t,s) and TryStrToInt (s, num) and (num>=0)

then f. blocks: =num

else Result: =False;

if Result and not Eof (t)

then Readln (t);

end;

// перевод строки в формат даты

function TryStrToDate (s: string; var d: TDate): Boolean;

var p: integer;

begin

p: =pos ('. ', s);

Result: = p>0;

if not (Result and TryStrToInt (Copy (s,1,p-1),d. Day) and (d. day in [1.31]))

then Result: =False;

delete (s,1,p);

p: =pos ('. ', s);

if not (Result and (p>0) and TryStrToInt (Copy (s,1,2),d. month) and (d. month in [1.12]))

then Result: =False;

delete (s,1,p);

if not (Result and TryStrToInt (s,d. year) and (d. year in [00.99]))

then Result: =False;

Result: = Result and (d. day in [1. CountDaysInMonth (d. month,d. year)])

end;

// изменение информации о файле

procedure EditCatalog (var f: TCatalog);

begin

if InputQuery ('Изменить имя файла? ') then

repeat

Writeln ('Введите новое имя');

Readln (f. name);

if f. name='' then

ShowMessage ('Ошибка! Имя не должно быть пустым! Повторите ввод! '); until f. name<>'';

if InputQuery ('Изменить специализацию файла? ') then

begin

Writeln ('Введите новую специализацию');

Readln (f. special);

end;

if InputQuery ('Изменить дату создания файла? ')

then InputDate (f. create);

if InputQuery ('Изменить количество блоков? ') then

repeat

Writeln ('Введите новое количество блоков');

Readln (f. blocks);

if f. blocks<0 then

ShowMessage ('Размер файла должен быть положительным! Повторите ввод! '); until f. blocks>=0;

end;

end. // UElem

Приложение 3. Модуль UFile

type

TFile = file of TCatalog;

// создание файла

procedure NewFile (var f: TFile; var FileName: string);

// открытие файла

procedure OpenFile (var f: TFile; var FileName: string);

// загрузка из файла

procedure LoadFromText (var f: TFile; var FileName: string);

// печать файла

procedure PrintFile (var f: TFile);

// сохранение в текстовый файл

procedure SaveToText (var f: TFile; FileName: string);

// добавление элемента

procedure AddElems (var f: TFile);

// измненение элемента

procedure EditElems (var f: TFile);

// удаление элемента

procedure DeleteElems (var f: TFile);

// вывод файлов с заданной спецификацией

procedure Task (var f: TFile);

implementation

// добавление нескольких элементов в файл

function AddSomeElems (var f: TFile): Integer;

var el: TCatalog;

begin

Result: =0;

repeat

InputCatalog (el);

write (f,el);

Inc (Result);

until not InputQuery ('Ещё? ');

end;

// создание файла

procedure NewFile (var f: TFile; var FileName: string);

begin

if InputFileName ('Введите имя нового файла', FileName,False) then

begin

AssignFile (f, FileName);

Rewrite (f);

if InputQuery ('Добавить данные? ') then AddSomeElems (f);

CloseFile (f);

ShowMessage ('Файл создан');

end;

end;

// открытие файла

procedure OpenFile (var f: TFile; var FileName: string);

begin

if InputFileName ('Введите имя существующего файла', FileName,true) then

begin

AssignFile (f, FileName);

ShowMessage ('Файл открыт');

end;

end;

// загрузка из файла

procedure LoadFromText (var f: TFile; var FileName: string);

var name: string; tf: TextFile; el: TCatalog; ok: Boolean;

begin

if InputFileName ('Введите имя текстового файла', name,true) and

InputFileName ('Введите имя типизированного файла', FileName, false)

then

if name=FileName then ShowMessage ('Имена должны быть разными! ')

else

begin

AssignFile (tf,name);

Reset (tf);

AssignFile (f, FileName);

Rewrite (f);

ok: =True;

while not Eof (tf) and ok do

if LoadCatalog (tf,el) then write (f,el) else ok: =False;

CloseFile (f);

CloseFile (tf);

if ok then ShowMessage ('Данные загружены')

else ShowMessage ('Ошибка при загрузке');

end;

end;

// печать файла

procedure PrintFile (var f: TFile);

var el: TCatalog; i: Integer;

begin

Reset (f);

if Eof (f) then ShowMessage ('Файл пуст')

else

begin

i: =0;

while not Eof (f) do

begin

read (f,el);

Inc (i);

Writeln ('Файл №', i);

PrintCatalog (el);

end;

end;

CloseFile (f);

end;

// сохранение в текстовый файл

procedure SaveToText (var f: TFile; FileName: string);

var name: string; tf: TextFile; el: TCatalog;

begin

if InputFileName ('Введите имя текстового файла', name,false)

then

if name=FileName then ShowMessage ('Имена должны быть разные! ')

else

begin

Reset (f);

AssignFile (tf, name);

Rewrite (tf);

while not Eof (f) do

begin

read (f,el);

SaveCatalog (tf,el);

end;

CloseFile (f);

CloseFile (tf);

ShowMessage ('Текстовый файл создан');

end;

end;

// добавление элемента

procedure AddElems (var f: TFile);

var n: Integer;

begin

Reset (f);

n: =FileSize (f);

Seek (f,n);

AddSomeElems (f);

CloseFile (f);

ShowMessage ('Данные добавлены');

end;

// Выбор элемента

function SelectNum (var f: TFile; n: Integer; var num: Integer; var el: TCatalog): Boolean;

begin

if n=1 then num: =0

else

begin

Writeln ('Введите номер элемента');

Readln (num);

while (num<1) or (num>n) do

begin

Writeln ('Ошибка! Повторите ввод');

Readln (num);

end;

dec (num);

end;

Seek (f,num);

read (f,el);

PrintCatalog (el);

Result: = InputQuery ('Этот элемент? ');

end;

// измненение элемента

procedure EditElems (var f: TFile);

var n,num: Integer; el: TCatalog;

begin

Reset (f);

if Eof (f) then ShowMessage ('Файл пуст')

else

if SelectNum (f, FileSize (f), num,el)

then

begin

EditCatalog (el);

Seek (f,num);

write (f,el);

ShowMessage ('Данные изменены');

end;

CloseFile (f);

end;

// удаление элемента

procedure DeleteElems (var f: TFile);

var num,n: Integer; el: TCatalog;

begin

Reset (f);

n: =FileSize (f);

if n=0 then ShowMessage ('Файл пуст')

else

if SelectNum (f,n,num,el)

then

begin

if n=1

then

begin

CloseFile (f);

Rewrite (f);

end

else

if num=n-1

then

begin

Seek (f, num);

Truncate (f);

end

else

begin

Seek (f,n-1);

read (f,el);

Seek (f,num);

write (f,el);

Seek (f,n-1);

Truncate (f);

end;

ShowMessage ('Данные удалены');

end;

CloseFile (f);

end;

// вывод файлов с заданной спецификацией

procedure Task (var f: TFile);

var el: TCatalog; name: string; ok: Boolean; fout: TFile; s: string [3];

begin

Reset (f);

if Eof (f) then ShowMessage ('Файл пуст')

else

if InputFileName ('Введите имя нового файла-отчета', name,False)

then

begin

Writeln ('Введите искомую спецификацию');

Readln (s);

AssignFile (fout, name);

Rewrite (fout);

while not Eof (f) do

begin

read (f,el);

if el. special=s

then

begin

write (fout,el);

ok: =True;

end;

end;

CloseFile (fout);

if ok

then

begin

ShowMessage ('Отчет сформирован');

if InputQuery ('Напечатать отчет? ') then PrintFile (fout);

end

else

ShowMessage ('Не найден ни один файл с заданной спецификацией');

end

else ShowMessage ('Прервано пользователем');

CloseFile (f);

end;

end. // UFile

Приложение 4. Главная программа

Program MainProgram; // главная программа

uses

SysUtils, windows,

HelpUtils in 'HelpUtils. pas',

UElem in 'UElem. pas',

UFile in 'UFile. pas';

Var

f: TFile; item: Integer; FileName: string;

// выбор действия

function SelectItem: Integer;

var MaxItem: Integer;

begin

writeln ('1 - Создать файл');

writeln ('2 - Открыть файл ');

writeln ('3 - Загрузить данные из текстового файла');

MaxItem: =3;

if FileName<>'' then

begin

writeln ('4 - Печать файла');

writeln ('5 - Сохранить в текстовый файл');

writeln ('6 - Добавить запись');

writeln ('7 - Редактировать запись');

writeln ('8 - Удалить запись');

writeln ('9 - Занести в файл-отчёт записи о файлах с заданной спецификацией');

MaxItem: =9;

end;

writeln ('0 - Выход');

repeat

write ('Ваш выбор: ');

Readln (Result);

until Result in [0. MaxItem];

end;

begin

SetConsoleCP (1251);

SetConsoleOutputCP (1251);

FileName: ='';

repeat

item: =SelectItem;

case item of // вызов соответствующих подпрограмм

1: NewFile (f,FileName);

2: OpenFile (f,FileName);

3: LoadFromText (f,FileName);

4: PrintFile (f);

5: SaveToText (f,FileName);

6: AddElems (f);

7: EditElems (f);

8: DeleteElems (f);

9: Task (f);

end;

until item=0;

end. // MainProgram

Размещено на Allbest.ru