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

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)

else write_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);

Дата добавления: 2014-01-04