МІНІСТЕРСТВО ОСВІТИ УНІВЕРСИТЕТ
СИСТЕМ УПРАВЛІННЯ ТА РАДІОЕЛЕКТРОНІКИ (ТУСУР)
дистанційна форма навчання
Кафедра автоматизованих систем управління (АСУ)
Програмування
Курсовий проект
«Телефонний довідник»
Дата виконання роботи ___________________
І. Б. Прізвище викладача ___________________
Підпис викладача ___________________
Зміст:
Зміст
Введення
Постановка завдання
Використовувані методи
Опис алгоритму програми
Висновок
Список літератури
Додаток 1. Лістинг програми
Введення:
Метою курсової роботи є поглиблення знань і розширення навичок з розробки алгоритмів та їх реалізації на персональному комп'ютері.
Постановка завдання:
Необхідно написати програму, яка буде працювати з базою телефонних номерів. При цьому програма повинна вміти додавати, змінювати, видаляти, шукати запису. Також, для спрощення роботи з програмою, необхідно створити інтуїтивно зрозумілий інтерфейс.
1. Використані методи:
У програмі використовується наступний алгоритм роботи з даними: всі дані зберігаються у файлі phone.dat і завантажуються в програму при виклику тієї чи іншої процедури. При видаленні або зміни запису створюється тимчасовий файл з ім'ям temp.dat, в нього записуються всі дані з файлу phone.dat крім тих які були видалені або записуються вже змінені дані, потім файл phone.dat видаляється, а файл temp.dat перейменовується в phone . dat.
2. Опис алгоритму програми.
Створимо запис Phone, у цьому записі створимо чотири поля з іменами:
· SurnameS - строкового типу довжиною 15 символів, це поле буде містити прізвище;
· NameS - строкового типу довжиною 15 символів, це поле буде містити ім'я;
· PhoneS - строкового типу довжиною 15 символів, це поле буде містити номер телефон.
· AddressS - строкового типу довжиною 50 символів, це поле буде містити адресу.
Створимо змінні:
· PhoneF - файлового типу, для роботи з файлами даних;
· PhoneR - довільного типу (Phone), для роботи з даними.
· А - масив від 1 до 600 типу Phone, даний масив буде необхідний для організації сортування записів.
Процедура WritePhone - дана процедура виводить всі записи з файлу phone.dat на екран. За допомогою оператора Assign встановлюється зв'язок між файлом і змінної файлового типу PhoneF. За допомогою команди Reset відкриваємо файл для читання і переводимо вказівник в першу позицію. Далі створюємо цикл розміром від першої позиції у файлі до останньої, в цьому циклі виводимо на екран значення полів: прізвище, ім'я, номер телефону за допомогою оператора Writeln. Закриваємо файл за допомогою оператора Close, це необхідно для того, щоб інші процедури могли з ним працювати.
procedure WritePhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Всі записи:');
writeln;
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура AddPhone - дана процедура додає запис. За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища, імені, номера телефону з клавіатури і записуємо введені значення у файл. Закриваємо файл.
procedure AddPhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
while not Eof (PhoneF) do Read (PhoneF, PhoneR);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Додавання запису:');
writeln;
Write ('Введіть Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть Ім'я:');
readln (PhoneR.NameS);
write ('Введіть номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть адресу:');
readln (PhoneR.AddressS);
write (PhoneF, PhoneR);
Close (PhoneF);
writeln;
writeln ('Запис успішно додана в базу !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура DeletePhone - видаляє запис. Для роботи даної процедури нам будуть потрібні додаткові змінні:
· Temp - файлового типу, в даній змінній будуть зберігається змінені дані;
· Nazv - строкового типу довжиною 15 символів, в цій змінній буде зберігатися значення поля прізвища запису яку необхідно видалити.
За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Assign і Reset створюємо тимчасовий файл temp.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища (за прізвищем ми будемо шукати у файлі потрібну нам запис) з клавіатури, присвоюємо введене значення змінної Nazv. Далі в циклі за допомогою умовного оператора порівнюємо по черзі значення поля SurnameS змінної PhoneF зі значенням змінної Nazv, якщо значення не збігаються то даний запис записується в файл temp.dat, інакше пропускається. У результаті маємо два файли з віддаленої та не віддаленій записом, закриваємо обидва файли. Видаляємо файл phone.dat за допомогою оператора Erase, а файл temp.dat перейменовуємо в phone.dat за допомогою оператора Rename.
procedure DeletePhone;
var temp: file of Phone;
Nazv: string [15];
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Видалення запису:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно вилучена з бази !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура EditPhone - редагує запис. Робота даної процедури аналогічна роботі процедури DeletePhone. За винятком того, що в тимчасовий файл додається новий запис, отримана за коштами введення з клавіатури прізвища, імені, номера телефону.
procedure EditPhone;
var Nazv: string [15];
temp: file of Phone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Редагування запису:');
writeln;
Write ('Введіть Прізвище, яку хочете змінити:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
writeln;
write ('Введіть нову Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть нове Ім'я:');
readln (PhoneR.NameS);
write ('Введіть новий номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть нову адресу:');
readln (PhoneR.AddressS);
write (temp, PhoneR);
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно змінена !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура FindSurname - пошук за прізвищем. Для роботи даної процедури нам будуть потрібні додаткові змінні:
· K - цілого типу, в даної змінної буде зберігається кількість знайдених записів;
· Nazv - строкового типу довжиною 15 символів, в цій змінній буде зберігатися значення поля прізвища запису яку необхідно знайти.
Змінної k присвоюємо значення рівне 0. За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища (за прізвищем ми будемо шукати у файлі потрібну нам запис) з клавіатури, присвоюємо введене значення змінної Nazv. У циклі при допомоги умовного оператора порівнюємо значення поля SurnameS зі значенням змінної Nazv і при збіг виводимо цю запис на екран, при кожному збігу значення змінної k буде збільшуватися на одиницю. Виводимо значення змінної k на екран. Закриваємо файл.
procedure FindSurname;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за Прізвища:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.SurnameS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура FindPhone - пошук за номером телефону. Робота даної процедури аналогічна роботі процедури FindSurname, за одним лише винятком: порівняння йде по полю PhoneS, а не по полю SurnameS.
procedure FindPhone;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за номером телефону:');
writeln;
Write ('Введіть номер телефону:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.PhoneS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура SortSurname - сортування за прізвищем. Дана процедура відкриває файл phone.dat, далі в циклі переписує всі записи в масив а. Потім за допомогою циклу і умовного оператора порівнює і сортує записи в алфавітному порядку по полю Прізвище. Далі за допомогою циклу виводить на екран вже відсортовані записи з масиву.
procedure SortSurname;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за Прізвища:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. SurnameS> a [j +1]. SurnameS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедури SortAddress і SortPhone - працюють аналогічно процедурі SortSurname, тільки за одним винятком порівнюються і сортуються запису по полях адресу і номер телефону відповідно.
procedure SortAddress;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. AddressS> a [j +1]. AddressS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortPhone;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. PhoneS> a [j +1]. PhoneS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура SortType - підменю сортування. Дана процедура за допомогою операторів Writeln і Readln створює підменю сортування, для зручності роботи з програмою кінцевого користувача. У меню присутні наступні пункти:
· 1. Чи не сортувати - викликає процедуру WritePhone;
· 2. Сортувати за Прізвища - викликає процедуру SortSurname;
· 3. Сортувати за адресою - викликає процедуру SortAddress;
· 4. Сортувати за номером телефону - викликає процедуру SortPhone;
· 5. Повернутись в головне меню - повертається до головного меню;
procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - меню сортування');
writeln;
writeln ('1. Не сортувати ');
writeln ('2. Сортувати за Прізвища ');
writeln ('3. Сортувати по адресу ");
writeln ('4. Сортувати за номером телефону ');
writeln ('----------------------------');
writeln ('5. Повернутись в головне меню ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: WritePhone;
2: SortSurname;
3: SortAddress;
4: SortPhone;
end;
end;
until b = 5;
end;
Процедура PhoneMenu - меню. Дана процедура за допомогою операторів Writeln і Readln створює меню, для зручності роботи з програмою кінцевого користувача. У меню присутні наступні пункти:
· 1. Показати всі записи - викликає процедуру WritePhone;
· 2. Додати запис - викликає процедуру AddPhone;
· 3. Видалити запис - викликає процедуру DeletePhone;
· 4. Редагувати запис - викликає процедуру EditPhone;
· 5. Пошук по Прізвища - викликає процедуру FindSurname;
· 6. Пошук за номером телефону - викликає процедуру FindPhone;
· 7. Вихід - завершує роботу програми;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - Головне меню');
writeln;
writeln ('1. Показати всі записи ');
writeln ('2. Додати запис ');
writeln ('3. Видалити запис ');
writeln ('4. Редагувати запис ');
writeln ('5. Пошук по Прізвища ');
writeln ('6. Пошук за номером телефону ');
writeln ('----------------------------');
writeln ('7. Вихід ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: SortType;
2: AddPhone;
3: DeletePhone;
4: EditPhone;
5: FindSurname;
6: FindPhone;
end;
end;
until b = 7;
end;
В основній програмі відбувається очищення екрана за допомогою оператора ClrScr і викликається процедура PhoneMenu.
begin
ClrScr;
PhoneMenu;
end.
Висновок
Дана програма продемонструвала гарну працездатність. Має інтуїтивно зрозумілий інтерфейс і не повинна викликати труднощів у роботі кінцевого користувача. Для коректної роботи програми файл phone.dat повинен знаходитися в каталозі Phone, який у свою чергу повинен знаходиться в каталозі де встановлений мову програмування Turbo Pascal.
Список літератури.
1. «Основи алгоритмізації та програмування», Є. М. Сап'янові, навчальний посібник, Томськ, 2000 р .
Додаток 1. Лістинг програми.
{Для коректної роботи програми файл phone.dat
повинен знаходитися в каталозі Phone, який у
свою чергу повинен знаходиться в каталозі де
встановлений мову програмування Turbo Pascal}
program Phonebook;
uses Crt;
type Phone = record
SurnameS: string [15];
NameS: string [15];
PhoneS: string [15];
AddressS: string [50];
end;
var PhoneF: file of Phone;
PhoneR: Phone;
a: array [1 .. 600] of Phone;
procedure WritePhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Всі записи:');
writeln;
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure AddPhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
while not Eof (PhoneF) do Read (PhoneF, PhoneR);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Додавання запису:');
writeln;
Write ('Введіть Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть Ім'я:');
readln (PhoneR.NameS);
write ('Введіть номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть адресу:');
readln (PhoneR.AddressS);
write (PhoneF, PhoneR);
Close (PhoneF);
writeln;
writeln ('Запис успішно додана в базу !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure DeletePhone;
var temp: file of Phone;
Nazv: string [15];
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Видалення запису:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно вилучена з бази !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure EditPhone;
var Nazv: string [15];
temp: file of Phone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Редагування запису:');
writeln;
Write ('Введіть Прізвище, яку хочете змінити:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
writeln;
write ('Введіть нову Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть нове Ім'я:');
readln (PhoneR.NameS);
write ('Введіть новий номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть нову адресу:');
readln (PhoneR.AddressS);
write (temp, PhoneR);
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно змінена !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure FindSurname;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за Прізвища:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.SurnameS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure FindPhone;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за номером телефону:');
writeln;
Write ('Введіть номер телефону:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.PhoneS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortSurname;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за Прізвища:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. SurnameS> a [j +1]. SurnameS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortAddress;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. AddressS> a [j +1]. AddressS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortPhone;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. PhoneS> a [j +1]. PhoneS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - меню сортування');
writeln;
writeln ('1. Не сортувати ');
writeln ('2. Сортувати за Прізвища ');
writeln ('3. Сортувати по адресу ");
writeln ('4. Сортувати за номером телефону ');
writeln ('----------------------------');
writeln ('5. Повернутись в головне меню ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: WritePhone;
2: SortSurname;
3: SortAddress;
4: SortPhone;
end;
end;
until b = 5;
end;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - Головне меню');
writeln;
writeln ('1. Показати всі записи ');
writeln ('2. Додати запис ');
writeln ('3. Видалити запис ');
writeln ('4. Редагувати запис ');
writeln ('5. Пошук по Прізвища ');
writeln ('6. Пошук за номером телефону ');
writeln ('----------------------------');
writeln ('7. Вихід ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: SortType;
2: AddPhone;
3: DeletePhone;
4: EditPhone;
5: FindSurname;
6: FindPhone;
end;
end;
until b = 7;
end;
begin
ClrScr;
PhoneMenu;
end.
СИСТЕМ УПРАВЛІННЯ ТА РАДІОЕЛЕКТРОНІКИ (ТУСУР)
дистанційна форма навчання
Кафедра автоматизованих систем управління (АСУ)
Програмування
Курсовий проект
«Телефонний довідник»
Дата виконання роботи ___________________
Дата перевірки ___________________
Оцінка ___________________І. Б. Прізвище викладача ___________________
Підпис викладача ___________________
Зміст:
Зміст
Введення
Постановка завдання
Використовувані методи
Опис алгоритму програми
Висновок
Список літератури
Додаток 1. Лістинг програми
Введення:
Метою курсової роботи є поглиблення знань і розширення навичок з розробки алгоритмів та їх реалізації на персональному комп'ютері.
Постановка завдання:
Необхідно написати програму, яка буде працювати з базою телефонних номерів. При цьому програма повинна вміти додавати, змінювати, видаляти, шукати запису. Також, для спрощення роботи з програмою, необхідно створити інтуїтивно зрозумілий інтерфейс.
1. Використані методи:
У програмі використовується наступний алгоритм роботи з даними: всі дані зберігаються у файлі phone.dat і завантажуються в програму при виклику тієї чи іншої процедури. При видаленні або зміни запису створюється тимчасовий файл з ім'ям temp.dat, в нього записуються всі дані з файлу phone.dat крім тих які були видалені або записуються вже змінені дані, потім файл phone.dat видаляється, а файл temp.dat перейменовується в phone . dat.
2. Опис алгоритму програми.
Створимо запис Phone, у цьому записі створимо чотири поля з іменами:
· SurnameS - строкового типу довжиною 15 символів, це поле буде містити прізвище;
· NameS - строкового типу довжиною 15 символів, це поле буде містити ім'я;
· PhoneS - строкового типу довжиною 15 символів, це поле буде містити номер телефон.
· AddressS - строкового типу довжиною 50 символів, це поле буде містити адресу.
Створимо змінні:
· PhoneF - файлового типу, для роботи з файлами даних;
· PhoneR - довільного типу (Phone), для роботи з даними.
· А - масив від 1 до 600 типу Phone, даний масив буде необхідний для організації сортування записів.
Процедура WritePhone - дана процедура виводить всі записи з файлу phone.dat на екран. За допомогою оператора Assign встановлюється зв'язок між файлом і змінної файлового типу PhoneF. За допомогою команди Reset відкриваємо файл для читання і переводимо вказівник в першу позицію. Далі створюємо цикл розміром від першої позиції у файлі до останньої, в цьому циклі виводимо на екран значення полів: прізвище, ім'я, номер телефону за допомогою оператора Writeln. Закриваємо файл за допомогою оператора Close, це необхідно для того, щоб інші процедури могли з ним працювати.
procedure WritePhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Всі записи:');
writeln;
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура AddPhone - дана процедура додає запис. За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища, імені, номера телефону з клавіатури і записуємо введені значення у файл. Закриваємо файл.
procedure AddPhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
while not Eof (PhoneF) do Read (PhoneF, PhoneR);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Додавання запису:');
writeln;
Write ('Введіть Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть Ім'я:');
readln (PhoneR.NameS);
write ('Введіть номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть адресу:');
readln (PhoneR.AddressS);
write (PhoneF, PhoneR);
Close (PhoneF);
writeln;
writeln ('Запис успішно додана в базу !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура DeletePhone - видаляє запис. Для роботи даної процедури нам будуть потрібні додаткові змінні:
· Temp - файлового типу, в даній змінній будуть зберігається змінені дані;
· Nazv - строкового типу довжиною 15 символів, в цій змінній буде зберігатися значення поля прізвища запису яку необхідно видалити.
За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Assign і Reset створюємо тимчасовий файл temp.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища (за прізвищем ми будемо шукати у файлі потрібну нам запис) з клавіатури, присвоюємо введене значення змінної Nazv. Далі в циклі за допомогою умовного оператора порівнюємо по черзі значення поля SurnameS змінної PhoneF зі значенням змінної Nazv, якщо значення не збігаються то даний запис записується в файл temp.dat, інакше пропускається. У результаті маємо два файли з віддаленої та не віддаленій записом, закриваємо обидва файли. Видаляємо файл phone.dat за допомогою оператора Erase, а файл temp.dat перейменовуємо в phone.dat за допомогою оператора Rename.
procedure DeletePhone;
var temp: file of Phone;
Nazv: string [15];
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Видалення запису:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно вилучена з бази !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура EditPhone - редагує запис. Робота даної процедури аналогічна роботі процедури DeletePhone. За винятком того, що в тимчасовий файл додається новий запис, отримана за коштами введення з клавіатури прізвища, імені, номера телефону.
procedure EditPhone;
var Nazv: string [15];
temp: file of Phone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Редагування запису:');
writeln;
Write ('Введіть Прізвище, яку хочете змінити:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
writeln;
write ('Введіть нову Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть нове Ім'я:');
readln (PhoneR.NameS);
write ('Введіть новий номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть нову адресу:');
readln (PhoneR.AddressS);
write (temp, PhoneR);
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно змінена !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура FindSurname - пошук за прізвищем. Для роботи даної процедури нам будуть потрібні додаткові змінні:
· K - цілого типу, в даної змінної буде зберігається кількість знайдених записів;
· Nazv - строкового типу довжиною 15 символів, в цій змінній буде зберігатися значення поля прізвища запису яку необхідно знайти.
Змінної k присвоюємо значення рівне 0. За допомогою операторів Assign і Reset відкриваємо файл phone.dat і встановлюємо покажчик в першу позицію. За допомогою операторів Writeln і Readln створюємо інтерфейс для введення прізвища (за прізвищем ми будемо шукати у файлі потрібну нам запис) з клавіатури, присвоюємо введене значення змінної Nazv. У циклі при допомоги умовного оператора порівнюємо значення поля SurnameS зі значенням змінної Nazv і при збіг виводимо цю запис на екран, при кожному збігу значення змінної k буде збільшуватися на одиницю. Виводимо значення змінної k на екран. Закриваємо файл.
procedure FindSurname;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за Прізвища:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.SurnameS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура FindPhone - пошук за номером телефону. Робота даної процедури аналогічна роботі процедури FindSurname, за одним лише винятком: порівняння йде по полю PhoneS, а не по полю SurnameS.
procedure FindPhone;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за номером телефону:');
writeln;
Write ('Введіть номер телефону:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.PhoneS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура SortSurname - сортування за прізвищем. Дана процедура відкриває файл phone.dat, далі в циклі переписує всі записи в масив а. Потім за допомогою циклу і умовного оператора порівнює і сортує записи в алфавітному порядку по полю Прізвище. Далі за допомогою циклу виводить на екран вже відсортовані записи з масиву.
procedure SortSurname;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за Прізвища:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. SurnameS> a [j +1]. SurnameS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедури SortAddress і SortPhone - працюють аналогічно процедурі SortSurname, тільки за одним винятком порівнюються і сортуються запису по полях адресу і номер телефону відповідно.
procedure SortAddress;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. AddressS> a [j +1]. AddressS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortPhone;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. PhoneS> a [j +1]. PhoneS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
Процедура SortType - підменю сортування. Дана процедура за допомогою операторів Writeln і Readln створює підменю сортування, для зручності роботи з програмою кінцевого користувача. У меню присутні наступні пункти:
· 1. Чи не сортувати - викликає процедуру WritePhone;
· 2. Сортувати за Прізвища - викликає процедуру SortSurname;
· 3. Сортувати за адресою - викликає процедуру SortAddress;
· 4. Сортувати за номером телефону - викликає процедуру SortPhone;
· 5. Повернутись в головне меню - повертається до головного меню;
procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - меню сортування');
writeln;
writeln ('1. Не сортувати ');
writeln ('2. Сортувати за Прізвища ');
writeln ('3. Сортувати по адресу ");
writeln ('4. Сортувати за номером телефону ');
writeln ('----------------------------');
writeln ('5. Повернутись в головне меню ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: WritePhone;
2: SortSurname;
3: SortAddress;
4: SortPhone;
end;
end;
until b = 5;
end;
Процедура PhoneMenu - меню. Дана процедура за допомогою операторів Writeln і Readln створює меню, для зручності роботи з програмою кінцевого користувача. У меню присутні наступні пункти:
· 1. Показати всі записи - викликає процедуру WritePhone;
· 2. Додати запис - викликає процедуру AddPhone;
· 3. Видалити запис - викликає процедуру DeletePhone;
· 4. Редагувати запис - викликає процедуру EditPhone;
· 5. Пошук по Прізвища - викликає процедуру FindSurname;
· 6. Пошук за номером телефону - викликає процедуру FindPhone;
· 7. Вихід - завершує роботу програми;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - Головне меню');
writeln;
writeln ('1. Показати всі записи ');
writeln ('2. Додати запис ');
writeln ('3. Видалити запис ');
writeln ('4. Редагувати запис ');
writeln ('5. Пошук по Прізвища ');
writeln ('6. Пошук за номером телефону ');
writeln ('----------------------------');
writeln ('7. Вихід ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: SortType;
2: AddPhone;
3: DeletePhone;
4: EditPhone;
5: FindSurname;
6: FindPhone;
end;
end;
until b = 7;
end;
В основній програмі відбувається очищення екрана за допомогою оператора ClrScr і викликається процедура PhoneMenu.
begin
ClrScr;
PhoneMenu;
end.
Висновок
Дана програма продемонструвала гарну працездатність. Має інтуїтивно зрозумілий інтерфейс і не повинна викликати труднощів у роботі кінцевого користувача. Для коректної роботи програми файл phone.dat повинен знаходитися в каталозі Phone, який у свою чергу повинен знаходиться в каталозі де встановлений мову програмування Turbo Pascal.
Список літератури.
1. «Основи алгоритмізації та програмування», Є. М. Сап'янові, навчальний посібник, Томськ,
Додаток 1. Лістинг програми.
{Для коректної роботи програми файл phone.dat
повинен знаходитися в каталозі Phone, який у
свою чергу повинен знаходиться в каталозі де
встановлений мову програмування Turbo Pascal}
program Phonebook;
uses Crt;
type Phone = record
SurnameS: string [15];
NameS: string [15];
PhoneS: string [15];
AddressS: string [50];
end;
var PhoneF: file of Phone;
PhoneR: Phone;
a: array [1 .. 600] of Phone;
procedure WritePhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Всі записи:');
writeln;
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure AddPhone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
while not Eof (PhoneF) do Read (PhoneF, PhoneR);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Додавання запису:');
writeln;
Write ('Введіть Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть Ім'я:');
readln (PhoneR.NameS);
write ('Введіть номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть адресу:');
readln (PhoneR.AddressS);
write (PhoneF, PhoneR);
Close (PhoneF);
writeln;
writeln ('Запис успішно додана в базу !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure DeletePhone;
var temp: file of Phone;
Nazv: string [15];
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Видалення запису:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно вилучена з бази !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure EditPhone;
var Nazv: string [15];
temp: file of Phone;
begin
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
Assign (temp, 'Phone \ temp.dat');
Rewrite (temp);
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
ClrScr;
writeln ('Редагування запису:');
writeln;
Write ('Введіть Прізвище, яку хочете змінити:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
Read (PhoneF, PhoneR);
if PhoneR.SurnameS <> Nazv then Write (temp, PhoneR);
end;
writeln;
write ('Введіть нову Прізвище:');
readln (PhoneR.SurnameS);
write ('Введіть нове Ім'я:');
readln (PhoneR.NameS);
write ('Введіть новий номер телефону:');
readln (PhoneR.PhoneS);
write ('Введіть нову адресу:');
readln (PhoneR.AddressS);
write (temp, PhoneR);
Close (temp);
Close (PhoneF);
Erase (PhoneF);
Rename (temp, 'Phone \ phone.dat');
writeln;
writeln ('Запис успішно змінена !!!');
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure FindSurname;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за Прізвища:');
writeln;
Write ('Введіть Прізвище:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.SurnameS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure FindPhone;
var Nazv: string [15];
k: integer;
begin
k: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Пошук запису за номером телефону:');
writeln;
Write ('Введіть номер телефону:');
readln (Nazv);
while not Eof (PhoneF) do
begin
PhoneR.SurnameS :='';
PhoneR.NameS :='';
PhoneR.PhoneS :='';
PhoneR.AddressS :='';
read (PhoneF, PhoneR);
if PhoneR.PhoneS = Nazv then
begin
writeln;
write (PhoneR.SurnameS);
write ('', PhoneR.NameS);
write ('', PhoneR.PhoneS);
write ('', PhoneR.AddressS);
k: = k +1;
end;
end;
Close (PhoneF);
writeln;
writeln;
writeln ('Пошук завершено, знайдено записів:', k);
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortSurname;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за Прізвища:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. SurnameS> a [j +1]. SurnameS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortAddress;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. AddressS> a [j +1]. AddressS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortPhone;
var i, j, c: integer;
tr: Phone;
begin
c: = 0;
Assign (PhoneF, 'Phone \ phone.dat');
Reset (PhoneF);
ClrScr;
writeln ('Сортування за адресою:');
writeln;
while not Eof (PhoneF) do begin
inc (c, 1);
read (PhoneF, a [c]);
end;
for i: = 1 to c do
for j: = 1 to c-1 do begin
if a [j]. PhoneS> a [j +1]. PhoneS then begin
tr: = a [j +1];
a [j +1]: = a [j];
a [j]: = tr;
end;
end;
for i: = 1 to c do begin
writeln;
write (a [i]. SurnameS);
write ('', a [i]. NameS);
write ('', a [i]. PhoneS);
write ('', a [i]. AddressS);
end;
Close (PhoneF);
writeln;
writeln;
write ('Натисніть будь-яку клавішу ...');
ReadKey;
end;
procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - меню сортування');
writeln;
writeln ('1. Не сортувати ');
writeln ('2. Сортувати за Прізвища ');
writeln ('3. Сортувати по адресу ");
writeln ('4. Сортувати за номером телефону ');
writeln ('----------------------------');
writeln ('5. Повернутись в головне меню ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: WritePhone;
2: SortSurname;
3: SortAddress;
4: SortPhone;
end;
end;
until b = 5;
end;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln ('"Телефонний довідник" - Головне меню');
writeln;
writeln ('1. Показати всі записи ');
writeln ('2. Додати запис ');
writeln ('3. Видалити запис ');
writeln ('4. Редагувати запис ');
writeln ('5. Пошук по Прізвища ');
writeln ('6. Пошук за номером телефону ');
writeln ('----------------------------');
writeln ('7. Вихід ');
writeln;
write ('Виберіть пункт меню:');
readln (b);
case b of
1: SortType;
2: AddPhone;
3: DeletePhone;
4: EditPhone;
5: FindSurname;
6: FindPhone;
end;
end;
until b = 7;
end;
begin
ClrScr;
PhoneMenu;
end.