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

Содержание

1. Задание

2. Блок схема

3. Листинг исходного файла программы

4. Снимки с экрана при работе программы

1. Задание

Написать программу упорядочивания элементов файлов.

1) Описать запись с именем Bill, содержащую следующие поля:

- расчётный счёт плательщика;

- расчётный счёт получателя;

- перечисляемая сумма в рублях.

2) Написать программу, выполняющую следующие действий:

- ввод данных с клавиатуры в массив, состоящий из 8 элементов типа Bill; записи должны быть упорядочены в алфавитном порядке по расчетным счетам плательщиков;

- вывод на экран информации о сумме снятой с расчётного счёта плательщика, введённого с клавиатуры; если такого расчётного счёта нет, вывести на экран соответствующие сообщение;

- запись массива в файл под заданным с клавиатуры именем.

2. Блок схема

Рис 1. Блок-схема алгоритма основной программы

Рис2. Блок-схема процедуры ввода данных в список

Рис 3. Блок-схема процедуры вывода данных из списка на дисплей

Рис4. Блок-схема процедуры ввода данных в список из файла записей

Рис5. Блок-схема процедуры поиска данных в списке

Рис6. Блок-схема процедуры записи данных списка в файл

Листинг исходного файла программы

programProg1;

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('Fil

Внимание, отключите Adblock

Вы посетили наш сайт со включенным блокировщиком рекламы!
Ссылка для скачивания станет доступной сразу после отключения Adblock!

Скачать