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