Упорядочивание элементов файла
Содержание
1.
Задание
2.
Блок схема
3.
Листинг исходного
файла программы
4.
Снимки с экрана
при работе программы
1. Задание
Написать программу
упорядочивания элементов файлов.
1)
Описать запись с
именем Bill, содержащую следующие поля:
- расчётный счёт
плательщика;
- расчётный счёт
получателя;
- перечисляемая сумма в
рублях.
2) Написать программу,
выполняющую следующие действий:
- ввод данных с
клавиатуры в массив, состоящий из 8 элементов типа Bill; записи должны быть
упорядочены в алфавитном порядке по расчетным счетам плательщиков;
- вывод на экран
информации о сумме снятой с расчётного счёта плательщика, введённого с
клавиатуры; если такого расчётного счёта нет, вывести на экран соответствующие
сообщение;
- запись массива в файл
под заданным с клавиатуры именем.
2. Блок схема
Рис 1. Блок-схема
алгоритма основной программы
Рис2. Блок-схема
процедуры ввода данных в список
Рис 3. Блок-схема
процедуры вывода данных из списка на дисплей
Рис4. Блок-схема
процедуры ввода данных в список из файла записей
Рис5. Блок-схема
процедуры поиска данных в списке
Рис 6. Блок-схема процедуры записи данных списка в файл
Листинг исходного файла
программы
program Prog1;
uses
Crt;
const
MaxRecCount =
8;
type
TBill = record
ChetPlatel:
string [30];
ChetPoluch:
string [30];
SummaPlateja:
real;
end;
TRecArr =
array [1..MaxRecCount] of TBill;
var
RecArr:
TRecArr;
Bill: TBill;
RecCount:
integer;
FileName:
string [15];
c: char;
procedure
RecArrInit(var RecArr: TRecArr);
var
i: integer;
begin
for i:= 1 to MaxRecCount
do
begin
RecArr[i].ChetPlatel:=
'';
RecArr[i].ChetPoluch:=
'';
RecArr[i].SummaPlateja:=
0
end
end;
function
FillRecArr(var RecArr: TRecArr): integer;
var
i, n: integer;
c: char;
begin
FillRecArr:=
0;
i:= 0;
while i <
MaxRecCount do
begin
c:= #0;
WriteLn('Do
you want insert new record in list?(y/n)');
c:= ReadKey;
ClrScr;
Inc(i);
Write('Please
get Pay #', i, ' :');
ReadLn(RecArr[i].ChetPlatel);
Write('Please
get Dest #', i, ' :');
ReadLn(RecArr[i].ChetPoluch);
repeat
Write('Please
get summ :');
{$I-}
ReadLn(RecArr[i].SummaPlateja);
{$I+}
n:= IOResult;
if n <>
0 then
WriteLn('The
summ is fault.Try again.');
until n = 0;
ClrScr
end;
FillRecArr:=
i;
end;
procedure
PrintRecArr(RecArr: TRecArr);
var
i: integer;
begin
ClrScr;
for i:= 1 to
MaxRecCount do
if
RecArr[i].ChetPlatel <> '' then
begin
WriteLn('Pay
#', i, ' : ', RecArr[i].ChetPlatel);
WriteLn('Dest
#', i, ' : ', RecArr[i].ChetPoluch);
WriteLn('Pay
summ', i, ' : ', RecArr[i].SummaPlateja:8:2);
WriteLn('--------------------------');
end
end;
procedure
FindInRecArr(RecArr: TRecArr);
var
i: integer;
isFind:
boolean;
s: string
[30];
summ: real;
begin
isFind:=
false;
summ:= 0;
ClrScr;
Write('Get
payment num(q for quit):');
ReadLn(s);
if s = 'q'
then Exit;
for i:= 1 to
MaxRecCount do
if
Pos(RecArr[i].ChetPlatel, s) <> 0 then
begin
summ:= summ +
RecArr[i].SummaPlateja;
isFind:= true
end;
if not isFind
then
begin
WriteLn('Current
record not found. Try again.');
ReadLn;
FindInRecArr(RecArr)
end;
WriteLn('Summa
= ',summ:8:2)
end;
procedure
SortRecArr(var RecArr: TRecArr);
var
i, j: integer;
TmpRec: TBill;
begin
for i:= 1 to MaxRecCount
do
for j:= 1 to
MaxRecCount - 1 do
if
RecArr[j].ChetPlatel[1] > RecArr[j + 1].ChetPlatel[1] then
begin
TmpRec:=
RecArr[j];
RecArr[j +
1]:= TmpRec
end
end;
function
RecArrSaveToFile(FileName: string; RecArr: TRecArr): integer;
var
TmpFile: file
of TBill;
i, n: integer;
begin
RecArrSaveToFile:=
0;
Assign(TmpFile,
FileName);
{$I-}
Rewrite(TmpFile);
{$I+}
if IOResult
<> 0 then
begin
WriteLn('File
', FileName, ' create error.');
Exit
end;
n:= 0;
for i:= 1 to
MaxRecCount do
if
RecArr[i].ChetPlatel <> '' then
begin
Inc(n);
Write(TmpFile,
RecArr[i])
end;
Close(TmpFile);
RecArrSaveToFile:=
n
end;
function
RecArrLoadFromFile(FileName:string; var RecArr: TRecArr): integer;
var
TmpFile: file
of TBill;
i: integer;
begin
RecArrLoadFromFile:=
0;
Assign(TmpFile,
FileName);
{$I-}
Reset(TmpFile);
{$I+}
if IOResult
<> 0 then
begin
WriteLn('File
', FileName, ' open error.');
Exit
end;
i:= 1;
Seek(TmpFile,
0);
while (not
Eof(TmpFile)) and (i <= MaxRecCount) do
begin
Read(TmpFile,
RecArr[i]);
Inc(i)
end;
Close(TmpFile);
RecArrLoadFromFile:=
i
end;
function
ViewMenu: char;
var
c: char;
begin
ViewMenu:=
'0';
ClrScr;
WriteLn;
WriteLn;
WriteLn('_________________________________');
WriteLn('| Menu
|');
WriteLn('---------------------------------');
WriteLn('| 1.
Input records to list |');
WriteLn('| |');
WriteLn('| 2.
Load list from file |');
WriteLn('| |');
WriteLn('| 3.
Find need records in list |');
WriteLn('| |');
WriteLn('| |');
WriteLn('| 5.
Print list |');
WriteLn('| |');
WriteLn('| 6.
Quit |');
WriteLn('---------------------------------');
repeat
c:= ReadKey;
until (c in
['1', '2','3', '4', '5', '6', #27]) ;
ViewMenu:= c
end;
begin
c:= #0;
RecCount:= 0;
FileName:= '';
ClrScr;
Window(23,15,75,30);
while true do
begin
c:= ViewMenu;
ClrScr;
case c of
'1': begin
RecArrInit(RecArr);
RecCount:=
FillRecArr(RecArr);
SortRecArr(RecArr);
WriteLn('Input
', RecCount, ' records in list.')
end;
'2': begin
Write('Get
file name :');
ReadLn(FileName);
FileName:=
'.\' + FileName;
RecArrInit(RecArr);
RecCount:=
RecArrLoadFromFile(FileName, RecArr);
WriteLn('Load
', RecCount, ' records in list.')
end;
'3': begin
if RecCount
> 0 then
FindInRecArr(RecArr)
else
WriteLn('List
is empty.')
end;
'4': begin
if RecCount
> 0 then
begin
Write('Input
file name :');
ReadLn(FileName);
FileName:=
'.\' + FileName;
RecCount:=
RecArrSaveToFile(FileName, RecArr);
WriteLn('Save
', RecCount, ' records from file ', FileName, '.')
end
else
WriteLn('List
is empty.')
end;
'5': begin
if RecCount
> 0 then
PrintRecArr(RecArr)
else
WriteLn('List
is empty.')
end;
'6', #27:
Break;
end;
WriteLn;
WriteLn('Please
press any key and go to menu>');
repeat until
KeyPressed
end;
end.
Снимки с экрана при
работе программы
Рис 7. Главное меню
программы
Рис 9. Окно ввода
значений в элемент списка
Рис 10. Запрос на ввод
имени файла для загрузки данных в список
Рис 11. Окно вывода
элементов списка
Рис 12. Окно поиска
элемента списка по значению его поля
Рис 13. Сообщение об
отсутствии искомого элемента в списке
Рис 14. Запись списка в
файл