Упорядочивание элементов файла
Контрольная работа - Компьютеры, программирование
Другие контрольные работы по предмету Компьютеры, программирование
Содержание
- Задание
- Блок схема
- Листинг исходного файла программы
- Снимки с экрана при работе программы
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;
if (c in [n, N, #27]) then Break;
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]:= RecArr[j + 1];
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(| 4. Save list to file |);
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. Г