Как показано в процедуре DisposeRec можно перебрать список, дойдя до каждого элемента и освободив его.
{Процедура освобождения памяти}
procedure DisposeRec;
var Temp: PPerson;
begin
{ указывает на первую запись }
CurrentRec := List;
while CurrentRec <> nil do
begin
{ сохранить указатель Next }
Temp := CurrentRec^.Next;
{ освобождение текущей записи }
Dispose(CurrentRec);
{ сделать сохраненную запись текущей }
CurrentRec:= Temp;
end;
end;
{Программа создает односвязный список записей телефонной
книжки и выводит сначала все нечетные записи в прямом порядке,
а затем нечетные - в обратном}
uses crt;
type Pperson = ^person;
person = record
Name: string;
phone: string;
Next: Pperson; { указывает на следующую запись }
end;
const n=8;
var List, {адрес (уазатель) начала списка}
CurrentRec: Pperson; {указатель текущей записи}
s:string;
i:integer;
{Процедура создания списка записей}
procedure NewListRec;
var i:integer;
begin
New(List); {выделить память для первой записи }
List^.Name:=concat('person1'); {заполнить информационные поля}
List^.phone:='01';
CurrentRec := List; {сделать первую запись текущей }
for i:=2 to n do
begin
New(CurrentRec^.Next);{ выделить память для следующей записи }
str(i,s);
CurrentRec^.Next^.Name:=concat('person',s);
CurrentRec^.Next^.phone:=concat('0',s);
CurrentRec := CurrentRec^.Next; { сделать следующую запись текущей }
end;
CurrentRec^.Next := nil; { после последней записи следующей нет }
end;
{Процедура поиска записи по имени персоны}
function FindRec(FindName: string): PPerson;
var Pers: PPerson;
begin
Pers := List; { указывает на первую запись }
while (Pers^.Name <> FindName) and (Pers^.Next <> nil) do
Pers := Pers^.Next;
if pers^.Name = FindName then
FindRec := Pers { возвращает указатель на найденную запись }
else
FindRec := nil; { или nil, если та-ких записей нет }
end;
{Процедура освобождения памяти}
procedure DisposeRec;
var Temp: PPerson;
begin
{ указывает на первую запись }
CurrentRec := List;
while CurrentRec <> nil do
begin
{ сохранить указатель Next }
Temp := CurrentRec^.Next;
{ освобождение текущей записи }
Dispose(CurrentRec);
{ сделать сохраненную запись текущей }
CurrentRec:= Temp;
end;
end;
begin
clrscr;
writeln('Свободной памяти ', memavail);
NewListRec;
writeln('нечетные записи в прямом порядке');
i:=1;
while i<=n do
begin
str(i,s);
CurrentRec:=FindRec(concat('person',s));
if CurrentRec <> nil then
writeln(CurrentRec^.Name,' ',CurrentRec^.Phone)
else
writeln ('Запись не найдена');
inc(i,2)
end;
i:=n;
writeln;
writeln('четные записи в обратном порядке');
while i>=1 do
begin
str(i,s);
CurrentRec:=FindRec(concat('person',s));
if CurrentRec <> nil then
writeln(CurrentRec^.Name,' ',CurrentRec^.Phone)
else
writeln ('Запись не найдена');
dec(i,2)
end;
writeln('Свободной памяти ', memavail);
disposerec;
writeln('Свободной памяти ', memavail);
end.
|
Главная
Каталог файлов
