program ex18;
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.
{**********************************}
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T+,V+,X+,Y+}
{$M 16384,0,655360}
program ex19-23;
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.
{***************************************}
program ex24;
uses AbsObj,crt;
type
PParamItem=^TParamItem;
TParamItem=record
Name,Value:string;
end;
PParamFifo=^TParamFifo;
TParamFifo=object (TFifo)
{ private
AList,BList:PListItem;
public
constructor Init;
destructor Done;
procedure Put(Element: pointer);
function Get:pointer;}
procedure SetParam(AName,AValue:string);
function GetParam(AName:string):string;
procedure FreeItem(AItem: pointer); virtual;
end;
procedure TParamFifo.FreeItem(AItem: pointer);
var
Tmp:PParamItem;
begin
Tmp:=AItem;
Dispose(Tmp);
end;
procedure TParamFifo.SetParam(AName,AValue:string);
var
Tmp:PParamItem;
begin
New(Tmp);
Tmp^.Name:=AName;
Tmp^.Value:=AValue;
Put(Tmp);
end;
function TParamFifo.GetParam(AName:string):string;
var
TmpList:PListItem;
Tmp:PParamItem;
Str:string;
begin
Tmplist:=AList;
while TmpList<>nil do
begin
Tmp:=TmpList^.Data;
if Tmp=nil then TmpList:=TmpList^.Next
else
if AName<>Tmp^.Name then TmpList:=TmpList^.Next
else
begin
GetParam:=Tmp^.Value;
exit;
end;
end;
if TmpList=nil then GetParam:='';
end;
var
List:PParamFifo;
begin
New(List,Init);
with List^ do
begin
SetParam('Name1','Value4');
SetParam('Name2','Value3');
SetParam('Name3','Value2');
SetParam('Name4','Value1');
writeln(Getparam('Name8'));
writeln(Getparam('Name1'));
writeln(Getparam('Name3'));
end;
Dispose(List,Done);
end.
{******************************}
Unit AbsObj;
Interface
type
PListItem=^TListItem;
TListItem=record
Data:pointer;
Next:PListItem;
end;
PFIFO=^TFIFO;
TFIFO=object
AList,BList:PListItem;
constructor Init;
destructor Done;
procedure Put(Element: pointer);
function Get:pointer;
procedure FreeItem(AItem: pointer); virtual;
end;
Implementation
constructor TFIFO.Init;
begin
AList:=Nil;
BList:=Nil;
end;
destructor TFIFO.Done;
var
P:PListItem;
begin
while AList<>Nil do
begin
P:=AList^.Next;
FreeItem(AList^.Data);
Dispose(AList);
AList:=P;
end;
end;
function TFIFO.Get:pointer;
var
P:PListItem;
GetData: pointer;
begin
if AList=Nil then begin Get:=nil; 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: pointer);
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;
procedure TFifo.FreeItem;
begin
end;
begin
end.
{//////////////////////////}
type
TIterator=procedure (AItem:pointer);
PListItem=^TListItem;
TListItem=record
Data:pointer;
Next:PListItem;
end;
PFIFO=^TFIFO;
TFIFO=object
AList,BList:PListItem;
constructor Init;
destructor Done;
procedure Put(Element: pointer);
function Get:pointer;
procedure FreeItem(AItem: pointer); virtual;
procedure ForEach(AIterator:TIterator);
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;
FreeItem(AList^.Data);
Dispose(AList);
AList:=P;
end;
end;
function TFIFO.Get:pointer;
var
P:PListItem;
GetData: pointer;
begin
if AList=Nil then begin Get:=nil; 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: pointer);
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;
procedure TFifo.FreeItem;
begin
end;
procedure ForEach(AIterator:TIterator);
var
Tmp:PListItem;
begin
Tmp:=AList;
while Tmp<>nil do
begin
AIterator(Tmp);
Tmp:=Tmp^.Next;
end;
end;
begin
end.
{***********************}
Program GalkaVV;
uses crt;
const MaxCollectionSize = 65520 div SizeOf(Pointer);
type
{*****************************************************}
PStr=^TStr;
TSrt=string;
{*****************************************************}
PObject=^TObject;
TObject=object
constructor Init;
destructor Done; virtual;
end;
{******************************************************}
TIterator=procedure (AItem: Pointer);
{******************************************************}
PItemList=^TItemList;
TItemList=array[0..MaxCollectionSize-1] of pointer;
{******************************************************}
PCollection=^TCollection;
TCollection=object
Items:PItemList;
Delta,Count,Limit: Integer;
constructor Init(ALimit, ADelta: Integer);
destructor Done;
procedure Insert(AItem: Pointer);
procedure AtInsert(AIndex: Integer; AItem: Pointer);
procedure Delete(AItem: pointer);
procedure AtDelete(AIndex: Integer);
function At(AIndex: Integer): Pointer;
procedure ForEach(Iterator:TIterator);
procedure FreeItem(AItem: Pointer); virtual;
end;
{******************************************************}
PObjCollection=^TObjCollection;
TObjCollection=object (TCollection)
procedure FreeItem(AItem: Pointer); virtual;
end;
{******************************************************}
PStrCollection=^TStrCollection;
TStrCollection=object (TCollection)
procedure FreeItem(AItem: Pointer); virtual;
procedure PutInOrder(AItem: string);
end;
{*****************************************************}
constructor TObject.Init;
begin
end;
destructor TObject.Done;
begin
end;
procedure TObjCollection.FreeItem(AItem: Pointer);
var
Tmp:PObject;
begin
Tmp:=AItem;
Dispose(Tmp,Done);
end;
constructor TCollection.Init(ALimit, ADelta: Integer);
var
i:integer;
begin
Limit:=ALimit;
Delta:=ADelta;
Count:=0;
GetMem(Items,SizeOf(Pointer)*Limit);
for i:=0 to Limit do Items^[i]:=nil;
end;
destructor TCollection.Done;
var
i:integer;
begin
for i:=0 to Limit do FreeItem(Items^[i]);
FreeMem(Items,SizeOf(Pointer)*Limit);
end;
procedure TCollection.Insert(AItem: Pointer);
var
i:integer;
Tmp:PItemList;
begin
if Count-1>=Limit then
begin
GetMem(Tmp,SizeOf(Pointer)*(Limit+Delta));
for i:=0 to Count-1 do
begin
Tmp^[i]:=Items^[i];
end;
FreeMem(Items,SizeOf(Pointer)*Limit);
Items:=Tmp;
Limit:=Limit+Delta;
end
else
begin
Items^[Count]:=AItem;
inc(Count);
end;
end;
procedure TCollection.AtInsert(AIndex: Integer; AItem: Pointer);
var
i:integer;
Tmp:PItemList;
begin
if Count-1>=Limit then
begin
GetMem(Tmp,SizeOf(Pointer)*(Limit+Delta));
for i:=0 to Count-1 do
begin
Tmp^[i]:=Items^[i];
end;
FreeMem(Items,SizeOf(Pointer)*Limit);
Items:=Tmp;
Limit:=Limit+Delta;
end
else
begin
inc(Count);
for i:=AIndex to Count-1 do Items^[Count-1-i]:=Items^[Count-i];
Items^[AIndex]:=AItem;
end;
end;
procedure TCollection.Delete(AItem: pointer);
var
i:integer;
begin
for i:=0 to Count-1 do
if AItem=Items^[i] then AtDelete(i);
end;
procedure TCollection.AtDelete(AIndex: Integer);
var
i:integer;
begin
FreeItem(Items^[AIndex]);
for i:=AIndex to Count-2 do
begin
Items^[i]:=Items^[i+1];
end;
dec(Count);
end;
function TCollection.At(AIndex: Integer): Pointer;
begin
At:=Items^[AIndex];
end;
procedure TCollection.FreeItem;
begin
end;
procedure TCollection.ForEach(Iterator:TIterator);
var
i:integer;
begin
for i:=0 to Count-1 do Iterator(Items^[i]);
end;
begin
end.
{*************************************}
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T+,V+,X+,Y+}
{$M 16384,0,655360}
program ex34;
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 Change(s1,s2:string; var AFIFO:PFIFO);
var
Tmp:PListItem;
p:byte;
begin
Tmp:=AFIFO^.AList;
while Tmp<>nil do
begin
p:=pos(s1,Tmp^.Data);
while p<>0 do
begin
delete(Tmp^.Data,p,length(s1));
insert(s2,Tmp^.Data,p);
p:=pos(s1,Tmp^.Data);
end;
Tmp:=Tmp^.Next;
end;
end;
var
FiFo:PFIFO;
Tmp:PListItem;
str1,str2: string;
begin
clrscr;
New(FiFo,Init);
str1:='g';
str2:='BB';
Tmp:=FiFo^.AList;
FIFO^.put('sggasrger');
FIFO^.put('lksjrgla');
FIFO^.put('aoirugj');
FIFO^.put('ksagjh8848ujh');
Change(str1,str2,FiFo);
while Fifo^.AList<>nil do
begin
writeln(FiFo^.Get);
end;
Dispose(FiFo,Done);
end.