Скачиваний:
7
Добавлен:
01.05.2014
Размер:
102.4 Кб
Скачать

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.

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