Вопросы к экзамену с ответами и демо-программами на Паскале / ex19-23

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T+,V+,X+,Y+}
{$M 16384,0,655360}
program GalkaVV;
uses crt;
type
TText=text;
PListItem=^TListItem;
TListItem=record
Data:string;
Next:PListItem;
end;

PFIFO=^TFIFO;
TFIFO=object
private
AList,BList:PListItem;
public
constructor Init;
destructor Done;
procedure Put(Element: string);
function Get:string;
function NotEmpty:boolean;
function Count:longint;
end;

PChildFIFO=^TChildFIFO;
TChildFIFO=object (TFIFO)
procedure PutFirst(Str:string);
procedure PutInOrder(Str:string);
end;

constructor TFIFO.Init;
begin
AList:=Nil;
BList:=Nil;
end;

destructor TFIFO.Done;
var
P:PListItem;
begin

while AList<>Nil do
begin
P:=AList^.Next;
Dispose(AList);
AList:=P;
end;
end;


function TFIFO.Get:string;
var
P:PListItem;
GetData: string;
begin
if AList=Nil then begin Get:=''; exit; end;
P:=AList^.Next;
GetData:=AList^.Data;
Dispose(AList);
AList:=P;
if AList=nil then BList:=AList;
Get:=GetData;
end;

Procedure TFIFO.Put(Element: string);
var
P: PListItem;
begin
if MaxAvail<SizeOf(TListItem) then Exit; { Проверка на возможность выделения памяти. }
New(P);
P^.Data:=Element;
if (BList=nil) and (AList=nil) then
begin
P^.Next:=nil;
AList:=P;
BList:=P;
end
else
begin
BList^.Next:=P;
P^.Next:=nil;
BList:=P;
end;
end;

function TFIFO.NotEmpty;
begin
NotEmpty:=AList<>nil;
end;

function TFIFO.Count;
var
Tmp:PListItem;
i:longint;
begin
i:=0;
Tmp:=AList;
while Tmp<>nil do begin Tmp:=Tmp^.Next; inc(i); end;
Count:=i;
end;

procedure TChildFIFO.PutFirst;
var
Tmp: PListItem;
begin
if MaxAvail<SizeOf(TListItem) then Exit; { Проверка на возможность выделения памяти. }
if (AList=nil) and (BList=nil) then Put(Str)
else
begin
New(Tmp);
Tmp^.Next:=AList;
AList:=Tmp;
end;
end;

procedure TChildFIFO.PutInOrder;
var
Tmp,TmpPrev,TmpBetween: PListItem;
begin
if (AList=nil) and (BList=nil) then Put(Str)
else
begin
Tmp:=AList;
TmpPrev:=nil;
{$B-}
while (Tmp<>nil) and (Str>=Tmp^.Data) do
begin
TmpPrev:=Tmp;
Tmp:=Tmp^.Next;
end;
if TmpPrev=nil then putFirst(Str);
if Tmp=nil then Put(Str)
else
begin
New(TmpBetween);
TmpBetween^.Data:=Str;
TmpPrev^.Next:=TmpBetween;
TmpBetween^.Next:=Tmp;
end;
end;
end;

function Count(AList: PFIFO):longint;
var
Tmp:PListItem;
i:longint;
begin
i:=0;
Tmp:=AList^.AList;
while Tmp<>nil do begin Tmp:=Tmp^.Next; inc(i); end;
Count:=i;
end;

function ex22(f1: string; litera:char):pointer;
var
inF: text;
str:string;
TmpList:PFIFO;
begin
new(TmpList,Init);
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
while not EOF(inF) do
begin
readln(inF,str);
if str<>'' then
if str[1]=litera then TmpList^.Put(str);
end;
close(inF);
ex22:=TmpList;
end;

function ex23(P: PFIFO; litera:char):pointer;
var
str:string;
TmpList:PFIFO;
Tmp:PListItem;
begin
New(TmpList, Init);
Tmp:=P^.AList;
while Tmp<>nil do
begin
str:=Tmp^.Data;
if str<>'' then
if str[1]=litera then TmpList^.Put(str);
Tmp:=Tmp^.Next;
end;
ex23:=TmpList;
end;

var
List:TChildFIFO;
p:PFIFO;
a:string;
Tmp:PListItem;
begin
clrscr;
List.init;
List.Put('akuxcfjyfg');
List.Put('ajh');
List.Put('butf');
List.Put('byr');
List.Put('dkiuh');
List.Put('afbgfddte');
{List.PutInOrder('c');
writeln(List.Count);
writeln(Count(@List));
while List.NotEmpty do writeln(List.Get); }
p:=ex23(@List,'a');
tmp:=p^.AList;
while tmp<>nil do begin writeln(Tmp^.Data); tmp:=tmp^.Next; end;
Dispose(p,Done);
List.Done;
end.