program Lab3 один параметр имя текстового файла APPTYPE CONSOLE uses S

  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
program Lab3; // один параметр - имя текстового файла
{$APPTYPE CONSOLE}
uses
//SysUtils,
// Windows,
UnList in 'UnList.pas', // подключаем модули с типами и процедурами, а затем и с переменными
UnVar in 'UnVar.pas';
// добавить элемент со значением R в соответствии с заданным порядком в список
procedure AddR(var ListN, ListK: PElem; r: TInfo); // адреса начала и конца списка и R
begin
if ListN = nil then CreateList(ListN, ListK, r) // если список пуст
else
if (UpCase(r) = 'A') or (UpCase(r) = 'E') or (UpCase(r) = 'I') or (UpCase(r) = 'O') or (UpCase(r) = 'U') or (UpCase(r) = 'Y') then
AddFirst(ListN, ListK, r) // добавить в начало
else
AddLast(ListN, ListK, r); // добавить в конец
end;
// "Добавить псевдослучайные N элементов" в текущий список
procedure AddN;
var n,i: integer; s:string; r: TInfo;
begin
write('Сколько N=?'); readln(s);
if not TryStrToInt(s,n) then n:=1;
for i:=1 to n do
begin
r := chr(33 + Random(32));
AddR(NachaloSpiska, KonecSpiska, r);
end;
end;
// Добавление всех данных из текстового файла в текущий список
procedure AddFromTextFile;
var
f: TextFile;
r: TInfo;
begin
if ParamCount=1 then writeln('Введите элементы и Ctrl+Z') ;
AssignFile(f, ParamStr(1));
try
Reset(f);
try
try
while not eof(f) do
begin
readln(f, r);
AddR(NachaloSpiska, KonecSpiska,r);
end;
writeln('Список создан');
except
writeln('Некорректные данные в текстовом файле '+ ParamStr(1));
end;
finally
CloseFile(f);
end;
except
writeln('Не удалось открыть текстовый файл '+ ParamStr(1));
end;
end;
// Добавить один элемент в текущий список
procedure Add1;
var
r: TInfo;
begin
try
write('введите символ (знак препинания или латиницы) R=?'); readln(r);
AddR(NachaloSpiska, KonecSpiska, r);
except
writeln('Некорректный символ или ошибка добавления');
end;
end;
// "Найти в списке"
procedure SearchIt;
var
ListC: PElem;
count: integer;
flag: boolean;
begin
count := 0;
flag := false;
ListC:=NachaloSpiska;
while (ListC<>nil) and not flag do // или while (ListC<>nil) and not flag do
begin
Inc(count);
if ListC^.info = '.' then
flag := true;
ListC:=ListC^.next;
end;
if flag then
writeln('Номер первого символа "." в списке: ', count)
else
writeln('Символ "." не найден в списке');
end;
// "Что сейчас в списке?" - вывод на экран консоли
procedure ViewList;
var
ListC: PElem;
begin
writeln('Список:');
ListC:=NachaloSpiska;
if ListC=nil then writeln('Пустой');
while ListC<>nil do
begin
writeln(ListC^.info:5);
ListC:=ListC^.next;
end;
end;
//--------------------главная программа-------------------------
var
ch: char;
begin
//SetConsoleCP(1251); // из модуля Windows
//SetConsoleOutputCP(1251);
{ Для того, чтобы каждый раз при запуске программы генерировалась
НОВАЯ последовательность псевдослучайных чисел.
Одна и та же последовательность удобна для отладки программы. }
Randomize;
repeat
writeln('--------------------------------------');
writeln('Q - добавить в список из текстового файла; ');
writeln('W - сгенерировать и добавить в список; ');
writeln('E - добавить в список; ');
writeln('R - найти в списке;');
writeln('T - удалить(очистить) список;');
writeln('Y - просмотр;');
writeln('U - конец.');
write('Ваш выбор?'); readln(ch);
writeln('--------------------------------------');
ch:= UpCase(ch);
case ch of
//----------создать список из текстового файла------------------
'Q': AddFromTextFile;
//----------сгенерировать список -------------------------------
'W': AddN;
//----------добавить в список ----------------------------------
'E': Add1;
//-----------поиск----------------------------------------------
'R': SearchIt;
//-----------освобождение памяти--------------------------------
'T': FreeList(NachaloSpiska, KonecSpiska);
//-----------просмотр----------------------------------------------
'Y': ViewList;
//-----------выход----------------------------------------------
'U': exit;
//--------------------------------------------------------------
else
begin
writeln('Нет такой команды');
write('Press ENTER'); readln;
end;
end;
until ch='U';
end.
Код (Модуль UnList):
unit UnList;
interface
type
TInfo = char;
PElem = ^TElem;
TElem = record
info: TInfo;
next: PElem;
end;
// создать список из одного элемента
procedure CreateList(var ListN, ListK: PElem; r: TInfo);
// добавить новый элемент перед первым
procedure AddFirst(var ListN: PElem; ListK: PElem; r: TInfo);
// добавить новый элемент в конец списка
procedure AddLast(ListN: PElem; var ListK: PElem; r: TInfo);
// добавить новый элемент в середину после ListC (не в конец)
procedure AddMedium(ListN,ListC,ListK: PElem; r: TInfo);
// очистить список
procedure FreeList(var ListN, ListK: PElem);
implementation
// создать список из одного элемента
procedure CreateList(var ListN, ListK: PElem; r: TInfo);
begin
New(ListN);
ListK:=ListN; // конец и начало совпадают
ListN^.info:=r;
ListN^.next:=nil;
end;
// добавить новый элемент перед первым
procedure AddFirst(var ListN: PElem; ListK: PElem; r: TInfo);
var Elem: PElem;
begin
new(Elem);
Elem^.info:=r;
Elem^.next:=ListN;
ListN:=Elem; // теперь он 1-ый
end;
// добавить новый элемент в конец
procedure AddLast(ListN: PElem; var ListK: PElem; r: TInfo);
begin
new(ListK^.next);
ListK^.next^.info:=r;
ListK^.next^.next:=nil;
ListK:= ListK^.next;
end;
// добавить новый элемент в середину после ListC (не в конец)
procedure AddMedium(ListN,ListC,ListK: PElem; r: TInfo);
var Elem: PElem;
begin
new(Elem);
Elem^.info:=r;
Elem^.next:=ListC^.next; // после него то, что было после ListC
ListC^.next:=Elem; // а он сам после ListC
end;
// очистить список
procedure FreeList(var ListN, ListK: PElem);
var Elem: PElem;
begin
Elem:=ListN;
while Elem<>nil do
begin
ListN:=ListN^.next;
Dispose(Elem);
Elem:=ListN;
end;
ListK:=nil;
end;
end.
Код (Модуль UnVar):
unit UnVar;
interface
uses UnList; // описание типа и все процедуры
var NachaloSpiska, KonecSpiska: PElem; // начало и конец списка
implementation
// пусто
initialization
NachaloSpiska:=nil; // инициализация переменных
KonecSpiska:=nil;
finalization
FreeList(NachaloSpiska, KonecSpiska); // освобождение памяти
end.