Типизированные и текстовые файлы. Создание базы данных склада на основе динамического массива

Балтийский Государственный Технический Университет

«Военмех» им. Д.Ф.Устинова

Лабораторная работа №4

«Типизированные и текстовые файлы.»

                                         Выполнила: Пожарская З.О.

Гр.И-451

Проверил: Козлов В.Р.

Санкт-Петербург

2006

Задание:

Создать базу данных склада на основе динамического массива: наименование товара, номенклатурный номер, номер накладной, дата из накладной, приход, расход. Создать поля: ввод базы, вывод базы, поиск по полю, удаление записи, запись/чтение в типизированный/текстовый файлы.

Текст программы:

Program ex;

uses

Crt, GlobIV, MenuIVQ, IOPutIV, Find, InDelStr, IOFileIV;

begin

clrscr;

New(A);

g:=1;

while g<>10 do

begin

g:=Menu;

case g of

1: begin

clrscr;

writeln(' введите количество записей ');

readln(m);

InputRec(m,A);

end;

2: begin

clrscr;

OutputRec(m,A);

readkey;

end;

3: begin

clrscr;

InputStr(m,A);

readkey;

end;

4: begin

clrscr;

DelStr(m,A);

readkey;

end;

5: begin

clrscr;

Finder(m,A);

end;

6: begin

clrscr;

writetxt(A,m);

readkey;

end;

7: begin

clrscr;

readtxt(A,m);

readkey;

end;

8: begin

clrscr;

writebin(A,m);

end;

9: begin

clrscr;

readbin(A,m)

end;

end;

end;

Dispose(A);

end.

Unit GlobIV;

interface

const

n=25;

type

BillDate=record

Day:1..31;

Month:1..12;

Year:integer

end;

StoreType=record

Name:String;

NomNum:integer;

BillNum:integer;

Date:BillDate;

Income:integer;

Outlay:integer

end;

StoreA = array [1..n] of StoreType;

Store=^StoreA;

var

A:store;

g,i,m:integer;

ch:char;

implementation

end.

Unit IOPutIV;

interface

uses

Crt, GlobIV, Find;

Procedure InputRec(var m:integer; var A:Store);

Procedure OutputRec(var m:integer; var A:store);

implementation

Procedure InputRec(var m:integer; var A:Store);

var

i:integer;

begin

for i:=1 to m do

With A^[i] do

begin

write(' введите наименование товара ');

readln(Name);

write(' введите номер накладной ');

readln(BillNum);

writeln(' введите дату из накладной: ');

write(' день ');

readln(Date.Day);

write(' месяц ');

readln(Date.Month);

write(' год ');

readln(Date.Year);

write(' приход ');

readln(Income);

write(' расход ');

readln(Outlay);

NomNum:=i;

writeln;

end;

end;

Procedure OutputRec(var m:integer; var A:store);

var

i,y:integer;

begin

if m=0 then

begin

writeln(' база пуста ');

exit;

end

else

for i:=1 to m do

begin

clrscr;

writeln(i,'-й элемент базы ');

Infind(i,A);

readkey;

end;

end;

end.

Unit Find;

interface

uses

Crt, GlobIII;

Procedure Finder(m:integer; A:store);

Procedure InFind(k:integer; A:store);

implementation

Procedure InFind(k:integer; A:store);

begin

With A[k] do

begin

writeln('╔══════════════════════╤═════════╗');

writeln('║ порядковый номер:    │    ',NomNum,'    ║');

writeln('╟──────────────────────┼─────────╢');

writeln('║ наименование товара: │   ',Name, '   ║');

writeln('╟──────────────────────┼─────────╢');

writeln('║ номер накладной:     │   ',BillNum,'    ║');

writeln('╟──────────────────────┼─────────╢');

writeln('║ дата из накладной:   │',Date.Day,'.',Date.Month,'.',Date.Year,' ║');

writeln('╟──────────────────────┼─────────╢');

writeln('║ приход/расход:       │ ',Income,'/',Outlay,'   ║');

writeln('╚══════════════════════╧═════════╝');

end;

end;

Procedure Finder(m:integer; A:store);

var

k,ans,i:integer;

begin

clrscr;

if m=0 then writeln(' база пуста, поиск не может быть выполнен ')

else

begin

writeln(' осуществляется поиск по дате ');

writeln(' введите нужный результат ');

readln(ans);

k:=0;

for i:=1 to n do

if A[i].Date.Day=ans then

begin

clrscr;

k:=i;

writeln(' данные по вашему запросу ');

InFind(k,A);

readkey;

end;

if k=0 then write(' таких данных нет ');

end;

readkey;

end;

end.

Unit InDelStr;

interface

uses

Crt, GlobIII, Find;

Procedure InputStr(var m:integer; var A:Store);

Procedure Delete(var k,m:integer; var A:store);

Procedure DelStr(var m:integer; var A:store);

implementation

Procedure InputStr(var m:integer; var A:Store);

begin

m:=m+1;

With A[m] do

begin

writeln(' введите наименование товара ');

readln(Name);

writeln(' введите номер накладной ');

readln(BillNum);

writeln(' введите дату из накладной: ');

writeln(' день ');

readln(Date.Day);

writeln(' месяц ');

readln(Date.Month);

writeln(' год ');

readln(Date.Year);

writeln(' приход ');

readln(Income);

writeln(' расход ');

readln(Outlay);

NomNum:=m;

writeln;

end;

end;

Procedure Delete(var k,m:integer; var A:store);

var

i:integer;

begin

for i:=k to m do

With A[i] do

begin

Name:=A[i+1].Name;

BillNum:=A[i+1].BillNum;

Date.Day:=A[i+1].Date.Day;

Date.Month:=A[i+1].Date.Month;

Date.Year:=A[i+1].Date.Year;

Income:=A[i+1].Income;

Outlay:=A[i+1].Outlay;

end;

m:=m-1;

end;

Procedure DelStr(var m:integer; var A:Store);

var

k,i:integer;

ans:char;

begin

if m=0 then writeln(' база пуста, удаление не может быть выполнено ')

else

begin

writeln(' введите номер удаляемой строки ');

readln(k);

if k>m then

begin