В текстовом файле упорядочить строки в пределах каждой страницы, по кол-ву пробелов. Пожалуйста помогите Опции

[fctn]

Добрый вечер. Помогите пожалуйста с задачей...
Задание:
Используя готовую процедуру 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 - 17.12.2007 16:08