1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
| uses crt;
const nmax=25;
zag='Поставки';
line='----------------------------------------------------------------------';
shap='| Наименование | Страна-импортер | Стоимость | Объем |';
type postavki = record
n: string[20];
c: string[15];
z: real;
v: integer;
end;
ap=array [1..nmax] of postavki;
fp=file of postavki;
var pos: ap;
f: fp;
r: integer;
rr: byte;
procedure Obmen(var p1: postavki; var p2: postavki);
var t: postavki;
begin
t:=p1;
p1:=p2;
p2:=t;
end;
procedure VvodToFile (var ff: fp);
var i: byte; n: integer; p: postavki;
begin
clrscr;
assign(ff,'C:\BD.dta');
rewrite(ff);
repeat
write('Количество товаров, не более ',nmax,', n='); readln(n);
until n in [1..nmax];
writeln('Внесите данные о поставках: ');
for i:=1 to n do
with p do
begin
write('Наименование ',i,' продукции: '); readln(n);
write('Страна-импортер: '); readln(c);
write('Стоимость: '); readln(z);
write('Объем: '); readln(v);
write(ff,p);
end;
close(ff);
writeln('Данные внесены. Enter, чтобы продолжить...');
readln;
end;
procedure VyvodFromFile (ff: fp);
var p: postavki;
begin
clrscr;
assign(ff,'C:\BD.dta');
reset(ff);
writeln(zag);
writeln(line);
writeln(shap);
writeln(line);
while not (eof(ff)) do
with p do
begin
read(ff,p);
writeln('|',n:20,'|':3,c:15,'|':3,z:10:1,'|':4,v:8,'|':6);
writeln(line);
end;
close(ff);
writeln('Enter, чтобы продолжить...');
readln;
end;
procedure FileToArr (ff: fp; var post: ap; var ri: integer);
var p: postavki;
begin
assign(ff,'C:\BD.dta');
reset(ff);
ri:=0;
while not (eof(ff)) do
with p do
begin
inc(ri);
read(ff,p);
post[ri]:=p;
end;
close(ff);
end;
procedure ArrToFile (var ff: fp; post: ap; ri: integer);
var i: byte;
begin
assign(ff,'C:\BD.dta');
rewrite(ff);
for i:=1 to ri do
write(ff,post[i]);
close(ff);
end;
procedure SortArr (var post: ap;ri: integer);
var i,j: integer;
begin
j:=0;
while j<=ri do
begin
for i:=1 to ri-1 do
if post[i].v<post[i+1].v
then Obmen(post[i],post[i+1]);
inc(j);
end;
end;
begin
rr:=1;
repeat
writeln('0-завершение работы');
writeln('1-ввод данных');
writeln('2-вывод данных');
writeln('3-вывод сортированных данных');
readln(rr);
case rr of
1: VvodToFile (f);
2: VyvodFromFile (f);
3:
begin
FileToArr (f,pos,r);
SortArr (pos,r);
ArrToFile (f,pos,r);
VyvodFromFile (f);
end;
else rr:=0;
end;
until rr=0;
end. |
(
