Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Delphi / Лаба 1 / B

.PAS
Скачиваний:
25
Добавлен:
01.05.2014
Размер:
3.85 Кб
Скачать
program laba;
uses crt;
const maxl=60;
type
strltype=record
l:byte;
strl:array[1..maxl] of char
end;
strmtype=record
mk:char;
strm:array[1..maxl+1] of char
end;


procedure inputstrl(var f:text;var str1:strltype);
var i:byte;
begin
i:=0;
while not eof(f) and (i<maxl) do
begin
i:=i+1;
read(f,str1.strl[i]);
end;
str1.l:=i;
end;



procedure inputstrm(var f:text;var str1:strmtype);
var i:byte;
begin
i:=1;
str1.mk:=#13;
while not eoln(f) and (i<=maxl) do
begin
read (f,str1.strm[i]);
i:=i+1;
end;
str1.strm[i]:=str1.mk;
end;

procedure calcwl(str1:strltype;var n:byte);
var i:byte;
ch:char;
begin
n:=0;{kolichestvo slov}
for i:=1 to str1.l do
begin
if ((i=1)or(str1.strl[i-1]=' '))and(str1.strl[i]<>' ') then {nachalo slova}
ch:=str1.strl[i];{nachalnbi simvol}
if (str1.strl[i]<>' ')and((str1.strl[i+1]=' ')or(i=str1.l)) then {konec slova}
if str1.strl[i]=ch then {nachalnbi simvol raven kone4nomy}
inc(n)
end
end;


procedure calcwm(str1:strmtype;var n:byte);
var i:byte;
ch:char;
begin
n:=0;
i:=1;
while str1.strm[i]<>str1.mk do
begin
if ((i=1)or(str1.strm[i-1]=' '))and(str1.strm[i]<>' ') then {nachalo slova}
ch:=str1.strm[i];{nachalnbi simvol}
if (str1.strm[i]<>' ')and((str1.strm[i+1]=' ')or(str1.strm[i+1]=str1.mk)) then {konec slova}
if str1.strm[i]=ch then {nachalnbi simvol raven kone4nomy}
inc(n);
inc(i);
end;

end;

procedure outputstrl(var str1:strltype;var n:byte;var f:text);
var k:byte;
begin
writeln('Ishodnaja stroka');
writeln(f,'ishodnaja stroka');
for k:=1 to str1.l do
begin
write(str1.strl[k]);
write(f,str1.strl[k]);{posimvolnbi vbvod massiva}
end;
writeln('');
writeln(f);
writeln('kolichestvo slov v stroke s odinakovbmi perv6m i poslednim simvolami:',n);
writeln(f,'kolichestvo slov v stroke s odinakovbmi perv6m i poslednim simvolami:',n);

end;


procedure outputstrm(var str1:strmtype;var n:byte;var f:text);
var k:byte;
begin
writeln('Ishodnaja stroka');
writeln(f,'Ishodnaja stroka');
k:=1;
while str1.strm[k]<>str1.mk do
begin
write(str1.strm[k]);
write(f,str1.strm[k]);{posimvolnbi vbvod massiva}
inc(k);
end;
writeln('');
writeln(f);
writeln('kolichestvo slov v stroke s odinakovbmi perv6m i poslednim simvolami:',n);
writeln(f,'kolichestvo slov v stroke s odinakovbmi perv6m i poslednim simvolami:',n);

end;



var
name_in,name_out:string;
f_in,f_out:text;
n:byte;
ch:char;
strl:strltype;
strm:strmtype;
begin{main}
clrscr;
write('vvedite imja faila s ishodnoi strokoi:');
readln(name_in);
name_in:=name_in+'.txt';
assign(f_in,name_in);
reset(f_in);
if ioresult<>0 then writeln('fail nee naiden')
else
begin
if eof(f_in) then
begin{if1}
writeln('fail pystoi');
close(f_in);
readln;
exit;
end{if1}
else
write('vvedite imja vBvodnogo faila:');
end;
readln(name_out);
name_out:=name_out+'.txt';
assign(f_out,name_out);
rewrite(f_out);
if ioresult<>0 then write('fail nensozdan')
else
begin
writeln('vbBerite tip vbvoda stroki:');
writeln('L-tip s izvestnoi dlinnoi.');
writeln('M-tip s izvestnoi dlinnoi.');
readln(ch);
end;
if (ch='L') or (ch='l') then
begin
inputstrl(f_in,strl);
calcwl(strl,n);
outputstrl(strl,n,f_out);
readln;
end
else
begin
inputstrm(f_in,strm);
calcwm(strm,n);
outputstrm(strm,n,f_out);
readln;
end;
close(f_in);
close(f_out);
end.









Соседние файлы в папке Лаба 1