|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
06.12.2009, 15:57 | #1 |
Новичок
Джуниор
Регистрация: 06.12.2009
Сообщений: 1
|
переделать программу сортировки текстового файла в паскале
начальный код программы:
Модуль: 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):B oolean; 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);whil e 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);clos e(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,'O UTF');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_pag e,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);writ eln(outf,s); until eof(f_page);writeln(outf,#12){ Конец переписи} ; until eof(f); close(outf);close(f_page);erase(f_p age); end{sort_page}. нужно переделать её так, чтобы Используя готовую процедуру sort_file, составить программу сортировки текстового файла с размещением строк в пределах каждой страницы в алфавитном порядке по последнему слову строки. Предусмотреть проверку существования исходного файла и переход на новую страницу с форматированием номера страницы. Длина страницы составляет 50 строк. а в данной программе сортировка идет по первой букве строки, Заранее большое спасибо |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Считывание текстового файла в паскале | Absent | Помощь студентам | 4 | 31.05.2009 16:00 |
Кодирование текстового файла | milate | Паскаль, Turbo Pascal, PascalABC.NET | 2 | 24.03.2009 13:00 |
Составить программу сортировки | Arsenal777 | Помощь студентам | 1 | 16.06.2008 16:46 |
Составить программу сортировки | Arsenal777 | Помощь студентам | 2 | 05.06.2008 22:18 |