Вопросы к экзамену с ответами и демо-программами на Паскале / 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.