Interface

Const Listok=0; {успешное завершение операции}

Listnotmem=1; {нет памяти}

Listunder=2; {список полон}

Listend=3; {конец списка}

ListEmpty=4;

Type BaseType=string[30];

PtrEl=^Element;

Element=record

Data:BaseType;

Next:PtrEl;

end;

PList=^List;

List=object

private

Start:PtrEl;

Ptr:PtrEl;

public

constructor Init; {инициализация объекта}

destructor Done; virtual; {уничтожение объекта}

procedure DoneList; {сделать список пустым}

procedure GetPtr(var P:PtrEl); {возвращает Ptr}

procedure GetStart(var P:PtrEl); {возвращает Start}

procedure Put(e:BaseType); virtual; {поместить в список}

procedure Get(var e:BaseType); virtual; {взять из списка}

procedure MovePtr; {перемещение указателя}

procedure BeginPtr; {поместить указатель в начало списка}

procedure EndPtr; {поместить указатель в конец списка}

function Empty:Boolean; {список пуст?}

end;

var ListError:0..4;

Implementation

Constructor List.Init;

Begin

new(Start);

if Start=nil then

begin

ListError:=ListNotMem;

List.Done;

fail

end

else

begin

Start^.Next:=nil;

Ptr:=Start;

ListError:=ListOk

end

End;

Destructor List.Done;

Begin

DoneList;

Dispose(Start)

End;

Procedure List.GetPtr;

Begin

P:=Ptr;

ListError:=ListOk

End;

Procedure List.GetStart;

Begin

P:=Start;

ListError:=ListOk

End;

Procedure List.DoneList;

var p1,p2:ptrel;

Begin

BeginPtr;

GetPtr(p1);

p1:=p1^.Next;

while p1<>nil do

begin

p2:=p1;

p1:=p1^.Next;

Dispose(p2)

end

End;

Procedure List.Put;

var p:PtrEl;

Begin

if SizeOf(list)<MaxAvail then

begin

New(p);p^.data:=E;

p^.Next:=Ptr^.Next;

Ptr^.Next:=P;

ListError:=ListOk

end

else ListError:=ListNotMem

End;

Procedure List.Get;

var p:PtrEl;

Begin

if Ptr^.Next<>nil then

if Ptr<>Start then

begin

p:=Ptr^.Next;

Ptr^.Next:=p^.Next;

dispose(p)

end

else ListError:=ListUnder

else ListError:=ListEnd

End;

Function List.Empty;

Begin

Empty:=Start^.Next=nil;

ListError:=ListOk

End;

Procedure List.MovePtr;

Begin

if Ptr^.Next<>nil then

begin

Ptr:=Ptr^.Next;

ListError:=ListOk

end

else ListError:=ListEnd

End;

Procedure List.BeginPtr;

Begin

Ptr:=Start;

ListError:=ListOk

End;

Procedure List.EndPtr;

Begin

BeginPtr;

while Ptr^.Next<>nil do Ptr:=Ptr^.Next

End;

Function HeapFunc(size:word):integer;far; {обработка ошибки динамической памяти}

Begin

HeapFunc:=1

End;

Begin

HeapError:=@HeapFunc

End.