Правила форума
Прочтите прежде чем задавать вопрос!
Задание:
Используя готовую процедуру sort_file, составить программу сортировки текстового файла с размещением строк в пределах каждой страницы в возрастающем порядке по числу пробелов в строке. Предусмотреть проверку существования исходного файла и переход на новую страницу с формированием номера страницы. Длина страницы составляет 50 строк.
вот часть программы (не уверена что правильно...):
program text_file;
uses crt;
var tf, f_page,outf,f1,f2:text; s,buf:string;
k1,k2:byte; name:string; p,pg,count,j:byte;
procedure sort_file(var f:text;r:Boolean);
{r=false - по убыванию, true - по возрастанию}
var 1,f2:text; b,b1,b2:string; i,i1,i2,p:Boolean; k:integer;
function more_less(x,y:string; ord:Boolean):Boolean;
begin
if ord then more_less:=(x<y)
else more_less:=(x>=y)
end { more_less};
procedure read_str(var t:text; var buf:string; var big:Boolean);
var s:string;
begin
s:=buf; readln(t,buf); if (buf=s) then big:=false
else big:=more_less(buf,s,r);
end {read_str};
procedure write_str(var t:text;buf:string;var int:Boolean);
begin
if not int then writeln(f,buf);
if eof(t) then int:=true
end { write_str};
BEGIN {sort_file}
assign(f1,'F1'); assign(f2,'F2');
repeat {разделение на 2 файлала}
reset(f); rewrite(f1); rewrite(f2);
k:=1; readln(f,b); writeln(f1,b); while not eof(f) do
begin read_str(f,b,i); if i then k:=k+1; if odd(k)
then writeln(f1,b) else writeln(f2,b)
end;{конец разделения}
p:=r; i1:=false; i2:=false; if k>1 then
begin {слияние файлов}
rewrite(f); reset(f1); reset(f2);
readln(f1,b1); readln(f2,b2);
if more_less(b1,b2,p) then write_str(f1,b1,i1)
else write_str(f2,b2,i2);
repeat
if more_less(b1,b2,p) then if not eof(f1)
then begin read_str(f1,b1,i1);
if i1 then p:=not p; i1:=false end
else p:=not p else if not eof(f2) then
begin read_str(f2,b2,i2); if i2 then
p:=not p; i2:=false end
else p:=not p;
if more_less(b1,b2,p) then write_str(f1,b1,i1)
else write_str(f2,b2,i2);
until (i1 and i2);
end{конец слияния файлов};
until{разделениz на 2 файлала}
(k<=2); close(f); lose(f1); close(f2); erase(f1); erase(f2);
END{sort_file};
procedure kol_prob(s1:string, var kp:integer);
var i,dl:integer;
begin
dl:=length(s1);
kp:=0;
for i:=dl downto 1 do
if s1[i]=' ' then kp:=kp+1;
end;
BEGIN {ocновной программы}
ClrScr;
writeln('Введите имя файла');
readln(name); if name='' then halt;
assign(tf,'name');
{$I-}
reset(tf);
{$I+}
if IOResult<>0 then writeln ('Файл с таким именем не существует.') ;
begin
{разделить файл на страницы (?)}
assign(f_page,'F_P'); assign(outf,'OUTF');
rewrite(outf); pg:=0;
repeat rewrite(f_page); p:=0;
{Формирование страницы}
repeat readln(tf,s);
writeln(f_page,s); inc(p);
until (p=50) or eof(tf);
inc(pg);
writeln(outf,'-',pg,'-');
sort_file(f_page,true)
{! внутри sort_file сортировать по количеству пробелов????}
{Конец формирования страницы};
reset(f_page); {Перепись страницы в outf}
repeat readln(f_page,s); elete(s,1,2);
writeln(outf,s); until eof(f_page);
writeln(outf,#12){ Конец переписи};
until eof(tf); close(outf); close(f_page);
erase(f_page);
end;{раздел-е на страницы}
END.{ocновной программы}
Сообщение отредактировано: fctn -
