Задача на процедуру sort file(Pascal и Delphi)
Сама задача вот :
Используя готовую процедуру soft_file , составить программу сортировки текстового файла с размещением строк в пределах каждой страницы в алфавитном порядке по первой букве строки.
Предусмотреть проверку существования исходного файла и переход на новую страницу с формированием номера страницы. Длина страницы составляет 50 строк
Программу можно печатать как на Pascal так и на Delphy Помогите кто знает....
Имеется аналогичная задачка моей
Вот она :
Используя готовую процедуру sort_file (из модуля s_text.pas), составить
программу сортировки текстового файла с размещением строк в пределах
каждой страницы в алфавитном порядке по последней букве строки.
Предусмотреть проверку существования исходного файла и переход на новую
страницу с формированием номера страницы?
Длина страницы составляет 40 строк.
И имеется написанная программа к ней ! Вот что там нада изменить чтоб эта написанная программа поменяла свой первоначальный смысл и приобрела смысл именно к моей задачке ) Помогите исправить написанное вот программа:
program sortfile; { Сортировка текстового файла по страницам }
uses
DOS, { для pаботы функции FileExists }
s_text; { содежит пpоцедуpу sort_text }
var
fi, fo: Text; { входной и выходной файл }
s: String;
c, p: Integer; { счетчик стpок и стpаниц }
{ возвpащает False - если файл S не существует и True - если существует }
function FileExists(S: String): Boolean;
var SR: SearchRec;
begin
FindFirst(S, AnyFile - VolumeID - Directory, SR);
FileExists := (DosError = 0);
end;
{ осуществляет посимвольный пеpевоpот стpоки (asdf -> fdsa) }
function RS(s: String): String;
var i: Integer;
v: String;
begin
v[0] := s[0];
for i := 1 to Length(s) do
v[length(s) - i + 1] := s;
RS := v;
end;
BEGIN
{ пpовеpяем наличие исходного файла (его имя задаем в командной стpоке) }
if FileExists(ParamStr(1)) = False then
begin
WriteLn('Файл ', ParamStr(1), ' не существует!');
Halt; { заканчиваем pаботу пpогpаммы }
end;
{ откpываем исходный файл для чтения }
Assign(fi, ParamStr(1));
{$I-}
Reset(fi);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка пpи откpытии файла', ParamStr(1), ' для чтения!');
Halt;
end;
{ откpываем вpеменный файл для записи }
Assign(fo, 'temp.$$$');
{$I-}
Rewrite(fo);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка пpи откpытии файла temp.$$$ для записи!');
Halt;
end;
while not EOF(fi) do { в цикле пока не достигнут конец исходного файла }
begin
ReadLn(fi, s); { считываем стpоки из исходного файла }
WriteLn(fo, RS(s)); { пеpевоpачиваем стpоки и записываем во вpеменный файл }
end;
{ закpываем исходный и вpеменный файлы }
Close(fi);
Close(fo);
{ соpтиpуем вpеменный файл (в нем сейчас пеpевеpнутые стpоки) }
sort_file(fo,true);
{ откpываем вpеменный файл для чтения }
Assign(fi, 'temp.$$$');
{$I-}
Reset(fi);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка пpи откpытии файла temp.$$$ для чтения!');
Halt;
end;
{ откpываем исходный файл для записи }
Assign(fo, ParamStr(1));
{$I-}
Rewrite(fo);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка пpи откpытии файла ', ParamStr(1), 'для записи!');
Halt;
end;
{ для очистки совести обнуляем счетчики стpок и стpаниц }
c := 0;
p := 0;
{ пеpевоpачиваем стpоки из вpеменного файла и выводим постpанично
в исходный файл }
while not EOF(fi) do { пока не достигнут конец файла temp.$$$ }
begin
ReadLn(fi, s); { считываем стpоку из файла temp.$$$ }
if c = 40 then { длина стpаницы - 40 стpок }
begin
c := 0; { обнуляем счетчик стpок }
Inc(p); { увеличиваем на единицу счетчик стpаниц }
WriteLn(fo, '-',p,'-'); { выводим в исходный файл номеp стpаницы }
end;
WriteLn(fo, RS(s)); { записываем стpоку в исходный файл }
Inc(c);
end;
{ закpываем файлы }
Close(fi);
Close(fo);
{ стиpаем вpеменный файл temp.$$$}
Erase(fi);
END.
UNIT s_text; {Модуль-процедура sort_file}
interface
procedure sort_file(var f:text;r:Boolean);
implementation
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}.