Упорядочивание элементов файла

Содержание

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;

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. Главное меню программы

Рис 8. Запрос на добавление нового элемента в список

Рис 9. Окно ввода значений в элемент списка

Рис 10. Запрос на ввод имени файла для загрузки данных в список

Рис 11. Окно вывода элементов списка

Рис 12. Окно поиска элемента списка по значению его поля

Рис 13. Сообщение об отсутствии искомого элемента в списке

Рис 14. Запись списка в файл