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

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;
	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
	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;

procedure ShowFile(f1:string);
var
	inF: TText;
	Str: string;
begin
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);
		writeln ('1: ',str);
	end;
close(inF);
end;


Procedure Sort(var f1:string);
var
	inF: TText;
	Str,max,StrTmp:string;
	SortList,SortListTmp:TFIFO;
	imax,j,i: Longint;
	Tmp:PListItem;
begin
	imax:=0;
	SortList.init;
	SortListTmp.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);
		SortList.Put(Str);
		inc(imax);
	end;
	if SortList.AList=nil then exit;
	for i:=1 to imax do
	begin
		max:=SortList.Get;
		Tmp:=SortList.AList;
		for j:=i to imax do
		begin
			if Tmp^.Data>max then
			begin
				StrTmp:=max;
				max:=Tmp^.Data;
				Tmp^.Data:=StrTmp;
				Tmp:=Tmp^.Next;
			end
			else Tmp:=Tmp^.Next;
		end;
		SortListTmp.Put(max);
	end;
{$I-} {
	reWrite(inF);
	if ioresult<>0 then begin write('Can not create file!'); exit; end;
{$I+}
	for i:=1 to imax do writeln(SortListTmp.Get);
{close(inF);}
SortList.Done;
SortListTmp.Done;
end;

var
	List:TFIFO;
	i:byte;
	a:string;

begin
	clrscr;
	a:='ex1801.txt';
	List.init;
	Sort(a);
{	ShowFile(a);}
	List.Done;
end.