Implementation

Interface

procedure sort_file(var f:text;r:Boolean);

procedure sort_file; {Сортировка текстового файла}

{r=false - по убыванию, true - по возрастанию}

var f1,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)

elsewrite_str(f2,b2,i2);

until (i1 and i2);

end{конец слияния файлов};

until(k<=2);close(f);close(f1);close(f2);erase(f1);erase(f2);

END{sort_file};

END{s_text}.

 

program sort_page; { Сортировка текстового файла по страницам}

uses s_text;

var f,f_page,outf:text;{Файлы входной, страница и выходной}

s,c,nm:string; p,pg,count,j:byte;

 

begin {Ввод имени файла и открытие файла f}

repeat writeln('Введите имя исходного файла:');readln(nm);

assign(f,nm);{$I-}reset(f);{$I+}

if IOResult <>0 then

begin writeln('Ошибка в имени файла');nm:='' end;

until not (nm=''){Конец открытия файла f};

assign(f_page,'F_P');assign(outf,'OUTF');rewrite(outf);pg:=0;

repeat rewrite(f_page);p:=0;

{ Формирование страницы}

repeat readln(f,s);count:=0;

for j:=1 to length(s) do

if upcase(s[j]) in ['A'..'Z'] then inc(count);

str(count:2,c);s:=c+s;writeln(f_page,s);inc(p);

until (p=8) or eof(f);

inc(pg); for j:=1 to 30 do write(outf,' ');

writeln(outf,'-',pg,'-');

sort_file(f_page,true) { Конец формирования страницы};

reset(f_page); {Перепись страницы в outf}

repeat readln(f_page,s);delete(s,1,2);writeln(outf,s);

until eof(f_page);writeln(outf,#12){ Конец переписи} ;

until eof(f); close(outf);close(f_page);erase(f_page);

end{sort_page}.

 

5. Коррекция текстовых файлов.

Под коррекцией в широком смысле понимают изменение содержания файла. Можно выделить две группы основных процедур коррекции: обновление записей файла и удаление "лишних" записей. При этом критерии обновления и определения "лишних" записей допускают много возможных трактовок. Так критерием обновления может быть время существования записи, а критерием "лишних" записей - дублирование записей в файле. Разумеется, обе группы процедур коррекции могут взаимодействовать друг с другом, т.е. использоваться совместно. Для текстовых файлов Турбо Паскаля коррекция возможна только путём создания нового файла со скорректированными записями-строками. Ниже приводится пример простой программы коррекции текстового файла, решающей задачу "чистки файла" от записей-дублей и пустых записей (состоящих из пустых строк или строк из одних пробелов):

 

program clean_file;{ Чистка текстового файла от повторяющихся строк}

var f,outf:text; {Входной и выходной файлы}

nm,s,del_s:string; j,k,beg,c:integer; d,d1:Boolean;

BEGIN writeln('ПРОГРАММА ЧИСТКИ ФАЙЛА');writeln;

repeat write('Введите имя файла:');readln(nm);

{ Проверка существования и открытие файла f для чтения}

assign(f,nm);{$I-}reset(f);{$I+}

if IOResult <>0 then begin writeln('Ошибка в имени файла');nm:='' end;

until (nm<>'');k:=0; d:=true;c:=0; assign(outf,'OUTF');rewrite(outf);

 

repeat {основной цикл}

readln(f,s);del_s:=s;reset(f);inc(k);beg:=1;

{ d:=false, если строка s повторяется }

repeat readln(f,s);if (s=del_s) and (beg<k) then d:=false;inc(beg);

until (eof(f) or (beg>k)) {конец d:=false};d1:=false;

{d1:=true, если s cодержит символ-непробел}

for j:=1 to length(del_s) do

if del_s[j]<>' 'then d1:=true {конец d1:=true};

{Вывод неповторяющейся строки, отличной от строки пробелов}

if (d and d1) then writeln(outf,del_s);