3053 / 1672 / 657
Регистрация: 19.03.2019
Сообщений: 5,380
|
|
02.07.2020, 15:50
|
|
Сообщение было отмечено ZX Spectrum-128 как решение
Решение
ЙЪЦХУЩКШЕГН,
ты, может, так хотел написать?
| Pascal | 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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
| program mailing_list;
type
str80 = string[80];
addrinfo = record
name: string[30];
street: string[40];
city: string[20];
state: string[2];
zip: string[9];
end;
AddrPointer = ^address;
address = record
name: string[30];
street: string[40];
city: string[20];
state: string[2];
zip: string[9];
next: AddrPointer; { указатель на следующую запись }
prior: AddrPointer; { указатель на предыдущую запись }
end;
DataItem = address;
filtype = file of addrinfo;
{ вызов меню }
function MenuSelect: char;
var
ch: char;
begin
Writeln('1. Enter names');
Writeln('2. Delete a name');
Writeln('3. Display the list');
Writeln('4. Search for a name');
Writeln('5. Save the list');
Writeln('6. Load the list');
Writeln('7. Quit');
repeat
Writeln;
Write('Enter your choice: ');
Readln(ch);
ch := UpCase(ch);
until (ch>='1') and (ch<='7');
MenuSelect := ch;
end;{ конец выбора по меню }
{ упорядоченная установка элементов в список с двойной связью }
function DSL_Store(info, start: AddrPointer; var last: AddrPointer): AddrPointer;
{ вставка элементов в соответствующее место с сохранением порядка }
var
old, top: AddrPointer;
done: boolean;
begin
top := start;
old := nil;
done := FALSE;
if start = nil then begin { первый элемент списка }
info^.next := nil;
last := info;
info^.prior :=nil;
DSL_Store := info;
end else
begin
while (start<>nil) and (not done) do
begin
if start^.name < info^.name then
begin
old := start;
start := start^.next;
end else
begin { вставка в середину }
if old <>nil then
begin
old^.next := info;
info^.next := start;
start^.prior := info;
info^.prior := old;
DSL_Store := top; { сохранение начала }
done := TRUE;
end else
begin
info^.next := start;{новый первый элемент }
info^.prior := nil;
DSL_Store := info;
done := TRUE;
end;
end;
end; { конец цикла }
if not done then begin
last^.next := info;
info^.next := nil;
info^.prior := last;
last := info;
DSL_Store := top; { сохранение начала }
end;
end;
end; { конец функции DSL_Store }
{ удалить элемент из списка с двойной связью }
function DL_Delete(start: AddrPointer; key: str80): AddrPointer;
var
temp, temp2: AddrPointer;
done: boolean;
begin
if start^.name = key then begin { первый элемент списка }
DL_Delete := start^.next;
if temp^.next <> nil then
begin
temp := start^.next;
temp^.prior := nil;
end;
dispose(start);
end else
begin
done := FALSE;
temp := start^.next;
temp2 := start;
while (temp <> nil) and (not done) do
begin
if temp^.next <> nil then begin
temp^.next^.prior := temp2;
done := TRUE;
dispose(temp);
end
else begin
temp2 := temp;
temp := temp^.next;
end;
end;
DL_Delete := start; { начало не изменяется }
if not done then Writeln('not found');
end;
end; { конец функции DL_Delete }
{ удаление адреса из списка }
procedure remove(var start : AddrPointer);
var
name:str80;
begin
Writeln('Enter name to delete: ');
Readln(name);
start := DL_Delete(start,name);
end; { конец процедуры удаления адреса из списка }
procedure Enter(var start, last : AddrPointer);
var
info: AddrPointer;
done: boolean;
begin
done := FALSE;
repeat
new(info); { получить новую запись }
Write('Enter name: ');
Readln(info^.name);
if Length(info^.name)=0 then done := TRUE
else
begin
Write('Enter street: ');
Readln(info^.street);
Write('Enter city: ');
Readln(info^.city);
Write('Enter state: ');
Readln(info^.state);
Write('Enter zip: ');
Readln(info^.zip);
start := DSL_Store(info, start, last); { вставить запись }
end;
until done;
end; { конец ввода }
{ вывести список }
procedure Display(start:AddrPointer);
begin
while start <> nil do begin
Writeln(start^.name);
Writeln(start^.street);
Writeln(start^.city);
Writeln(start^.state);
Writeln(start^.zip);
start := start^.next;
Writeln;
end;
end;
{ найти элемент с адресом }
function Search(start: AddrPointer; name: str80):
AddrPointer;
var
done: boolean;
begin
done := FALSE;
while (start <> nil) and (not done) do begin
if name = start^.name then begin
search := start;
done := TRUE;
end
else
start := start^.next;
end;
if start = nil then search := nil; { нет в списке }
end; { конец поиска }
{ найти адрес по фамилии }
procedure Find(start : AddrPointer);
var
loc: Addrpointer;
name: str80;
begin
Write('Enter name to find: ');
Readln(name);
loc := Search(start, name);
if loc <> nil then
begin
Writeln(loc^.name);
Writeln(loc^.street);
Writeln(loc^.city);
Writeln(loc^.state);
Writeln(loc^.zip);
end
else Writeln('not in list');
Writeln;
end; { Find }
{ записать список на диск }
procedure Save(var f:FilType; start: AddrPointer);
var t : addrinfo;
begin
Writeln('saving file');
Rewrite(f);
while start <> nil do begin
t.city := start^.city;
t.name := start^.name;
t.state := start^.state;
t.street := start^.street;
t.zip := start^.zip;
write(f, t);
start := start^.next;
end;
end;
{ загрузить список с файла }
procedure Load(var f:FilType; var start, last: AddrPointer);
var
temp: AddrPointer;
t : addrinfo;
begin
Writeln('load file');
Reset(f);
while start <> nil do begin { освобождение памяти при необходимости }
temp := start^.next;
dispose(start);
start := temp;
end;
start := nil; last := nil;
while not eof(f) do begin
New(temp);
Read(f, t);
temp^.city := t.city;
temp^.name := t.name;
temp^.state := t.state;
temp^.street := t.street;
temp^.zip := t.zip;
temp^.next := nil; temp^.prior:= nil;
start := DSL_Store(temp, start, last); { вставить запись }
end;
end; { конец загрузки }
var
t, t2: integer;
mlist: FilType;
start, last: AddrPointer;
done: boolean;
begin
start := nil; { сначала список пустой }
last := nil;
done := FALSE;
Assign(mlist, 'mlistd.dat');
repeat
case MenuSelect of
'1': Enter(start, last);
'2': Remove(start);
'3': Display(start);
'4': Find(start);
'5': Save(mlist, start);
'6': Load(mlist, start, last);
'7': done := TRUE;
end;
until done=TRUE;
end. { конец программы } |
|
Добавлено через 16 минут
переработал чуть код
| Pascal | 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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
| program mailing_list;
type
addrinfo = record
name: string[30];
street: string[40];
city: string[20];
state: string[2];
zip: string[9];
end;
AddrPointer = ^address;
address = record
data : addrinfo;
next: AddrPointer; { указатель на следующую запись }
prior: AddrPointer; { указатель на предыдущую запись }
end;
DataItem = address;
filtype = file of addrinfo;
{ вызов меню }
function MenuSelect: char;
var
ch: char;
begin
Writeln('1. Enter names');
Writeln('2. Delete a name');
Writeln('3. Display the list');
Writeln('4. Search for a name');
Writeln('5. Save the list');
Writeln('6. Load the list');
Writeln('7. Quit');
repeat
Writeln;
Write('Enter your choice: ');
Readln(ch);
ch := UpCase(ch);
until (ch>='1') and (ch<='7');
MenuSelect := ch;
end;{ конец выбора по меню }
{ упорядоченная установка элементов в список с двойной связью }
function DSL_Store(info, start: AddrPointer; var last: AddrPointer): AddrPointer;
{ вставка элементов в соответствующее место с сохранением порядка }
var
old, top: AddrPointer;
done: boolean;
begin
top := start;
old := nil;
done := FALSE;
if start = nil then begin { первый элемент списка }
info^.next := nil;
last := info;
info^.prior :=nil;
DSL_Store := info;
end else
begin
while (start<>nil) and (not done) do
begin
if start^.data.name < info^.data.name then
begin
old := start;
start := start^.next;
end else
begin { вставка в середину }
if old <>nil then
begin
old^.next := info;
info^.next := start;
start^.prior := info;
info^.prior := old;
DSL_Store := top; { сохранение начала }
done := TRUE;
end else
begin
info^.next := start;{новый первый элемент }
info^.prior := nil;
DSL_Store := info;
done := TRUE;
end;
end;
end; { конец цикла }
if not done then begin
last^.next := info;
info^.next := nil;
info^.prior := last;
last := info;
DSL_Store := top; { сохранение начала }
end;
end;
end; { конец функции DSL_Store }
{ удалить элемент из списка с двойной связью }
function DL_Delete(start: AddrPointer; key: string): AddrPointer;
var
temp, temp2: AddrPointer;
done: boolean;
begin
if start^.data.name = key then begin { первый элемент списка }
DL_Delete := start^.next;
if temp^.next <> nil then
begin
temp := start^.next;
temp^.prior := nil;
end;
dispose(start);
end else
begin
done := FALSE;
temp := start^.next;
temp2 := start;
while (temp <> nil) and (not done) do
begin
if temp^.next <> nil then begin
temp^.next^.prior := temp2;
done := TRUE;
dispose(temp);
end
else begin
temp2 := temp;
temp := temp^.next;
end;
end;
DL_Delete := start; { начало не изменяется }
if not done then Writeln('not found');
end;
end; { конец функции DL_Delete }
{ удаление адреса из списка }
procedure remove(var start : AddrPointer);
var
name:string;
begin
Writeln('Enter name to delete: ');
Readln(name);
start := DL_Delete(start,name);
end; { конец процедуры удаления адреса из списка }
procedure Enter(var start, last : AddrPointer);
var
info: AddrPointer;
done: boolean;
begin
done := FALSE;
repeat
new(info); { получить новую запись }
Write('Enter name: ');
with info^.data do begin
Readln(name);
if Length(name)=0 then done := TRUE
else
begin
Write('Enter street: ');
Readln(street);
Write('Enter city: ');
Readln(city);
Write('Enter state: ');
Readln(state);
Write('Enter zip: ');
Readln(zip);
start := DSL_Store(info, start, last); { вставить запись }
end;
end;
until done;
end; { конец ввода }
{ вывести список }
procedure Display(start:AddrPointer);
begin
while start <> nil do begin
with start^.data do begin
Writeln(name);
Writeln(street);
Writeln(city);
Writeln(state);
Writeln(zip);
end;
start := start^.next;
Writeln;
end;
end;
{ найти элемент с адресом }
function Search(start: AddrPointer; name: string):AddrPointer;
var
done: boolean;
begin
done := FALSE;
while (start <> nil) and (not done) do begin
if name = start^.data.name then begin
search := start;
done := TRUE;
end
else
start := start^.next;
end;
if start = nil then search := nil; { нет в списке }
end; { конец поиска }
{ найти адрес по фамилии }
procedure Find(start : AddrPointer);
var
loc: Addrpointer;
name: string;
begin
Write('Enter name to find: ');
Readln(name);
loc := Search(start, name);
if loc <> nil then
begin
with loc^.data do begin
Writeln(name);
Writeln(street);
Writeln(city);
Writeln(state);
Writeln(zip);
end;
end
else Writeln('not in list');
Writeln;
end; { Find }
{ записать список на диск }
procedure Save(var f:FilType; start: AddrPointer);
begin
if start=nil then
begin
WriteLn('List is empty. Nothing to do! Exit from saving.');
Exit;
end;
Writeln('saving file');
Rewrite(f);
while start <> nil do begin
write(f, start^.data);
start := start^.next;
end;
Close(f)
end;
{ загрузить список с файла }
procedure Load(var f:FilType; var start, last: AddrPointer);
var
temp: AddrPointer;
count: integer;
begin
Writeln('load file');
Reset(f);
while start <> nil do begin { освобождение памяти при необходимости }
temp := start^.next;
dispose(start);
start := temp;
end;
start := nil; last := nil;
count:=0;
while not eof(f) do begin
inc(count);
New(temp);
Read(f, temp^.data);
temp^.next := nil; temp^.prior:= nil;
start := DSL_Store(temp, start, last); { вставить запись }
end;
Close(f);
WriteLn('Loading ',count,' records from file');
WriteLn
end; { конец загрузки }
var
mlist: FilType;
start, last: AddrPointer;
done: boolean;
begin
start := nil; { сначала список пустой }
last := nil;
done := FALSE;
Assign(mlist, 'mlistd.dat');
repeat
case MenuSelect of
'1': Enter(start, last);
'2': Remove(start);
'3': Display(start);
'4': Find(start);
'5': Save(mlist, start);
'6': Load(mlist, start, last);
'7': done := TRUE;
end;
until done=TRUE;
end. { конец программы } |
|
0
|