Приложения. 1.Листинг программы

1.Листинг программы

uses crt;

type din=^rec;

rec= record

x:byte;

next:din;

pred:din;

end;

var f:text;

pris:boolean;

procedure massiv;

const n=10;

var mas: array [1..n] of integer;

mn: set of byte;

i,nom,j,k,first:byte;

b:boolean;

st: set of byte;

Begin

Writeln('Обработка с помощью массивов');

assign(f,'vvod.txt');

reset(f);

while not seekeof(f) do begin

inc(i);

read(f,mas[i]);

end;

for i:=1 to n do write(mas[i],' ');

writeln;

nom:=1;

for i:=1 to n-1 do begin

b:=true;

if (mas[i] in st) then b:=false

else st:= st + [mas[i]];

for j:=i+1 to n do begin

if mas[i]=mas[j] then b:=false;

end;

if b then begin

mas[nom]:=mas[i];

inc(nom);

end;

end;

for i:=nom to n do mas[i]:=0;

dec(nom);

first:=mas[1];

i:=2;

while i<=nom do begin

b:=false;

j:=3;

while j<=nom do begin

if mas[i]+mas[j]=first then begin

for k:=j to nom-1 do mas[k]:=mas[k+1];

mas[nom]:=0;

dec(nom);

for k:=i to nom-1 do mas[k]:=mas[k+1];

mas[nom]:=0;

dec(nom);

b:=true;

end;

if b then break else inc(j);

end;

if b=false then inc(i);

end;

for i:=1 to nom do write(mas[i],' ');

close(f);

i:=0;

writeln;

writeln;

readkey

end;

Procedure tfile;

var f2: file of byte;

i,position,buf,buf2,buf3,lastN,first:byte;

st: set of byte;

b:boolean;

Begin

Writeln('Обработка с помощью типизированных файлов');

assign(f, 'vvod.txt');

reset(f);

assign(f2, 'out.txt');

rewrite(f2);

while not eof(f) do begin

read(f,buf);

write(buf,' ');

write(f2, buf);

end;

writeln;

close(f);

close(f2);

reset(f2);

lastN:=0;

while not eof(f2) do begin

b:=true;

read(f2, buf);

position:= filepos(f2);

if (buf in st) then b:=false

else st:= st + [buf];

while (not eof(f2)) do begin

read(f2, buf2);

if (buf2 = buf) then b:=false;

end;

if b then begin

seek(f2,lastN);

write(f2, buf);

inc(lastN);

end;

seek(f2, position);

end;

seek(f2, lastN);

Truncate(f2);

close(f2);

reset(f2);

read(f2,first);

while not eof(f2) do begin

b:=false;

read(f2,buf);

position:=filepos(f2);

while not eof(f2) do begin

read(f2,buf2);

if buf+buf2=first then begin

while not eof(f2) do begin

read(f2,buf3);

seek(f2,filepos(f2)-2);

write(f2,buf3);

seek(f2,filepos(f2)+1);

end;

seek(f2,filepos(f2)-1);

truncate(f2);

seek(f2,position);

while not eof(f2) do begin

read(f2,buf3);

seek(f2,filepos(f2)-2);

write(f2,buf3);

seek(f2,filepos(f2)+1);

end;

seek(f2,filepos(f2)-1);

truncate(f2);

b:=true;

end;

if b then begin

seek(f2,position-1);

break;

end;

if eof(f2) then begin

seek(f2,position);

break;

end;

end;

end;

close(f2);

reset(f2);

while not eof(f2) do begin

read(f2, buf);

write(buf,' ');

end;

close(f2);

writeln;

writeln;

readkey

end;

procedure ds;

var first,last,p1,p2,lastN,position1,position2,buf:din;

b:boolean;

st: set of byte;

BEGIN

Writeln('Обработка с помощью динамических списков');

assign(f, 'vvod.txt');

reset(f);

first:=nil;

last:=nil;

while not eof(f) do begin

new (p1);

read(f,p1^.x);

write(p1^.x,' ');

p1^.next:=nil;

p1^.pred:=nil;

if first=nil then first:=p1

Дата добавления: 2015-09-01