IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> сортировка текста, нужна помощь
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Женский
Реальное имя: Анна

Репутация: -  0  +


есть текстовый файл-список вида:
....
*:OMAA = Abu Dhabi
*:BIAR = Акорейри
*:DABB = Аннаба
*:EHAM = Amsterdam
*:LTAC = Ankara
*:LIPY = Ancona
*:LGAT = Athens-H
*:EKBI = Billund
*:EDKB = Bon
.....
и так далее.
в списке города и их коды.
нужно упорчдочить список в алфавитном порядке A..YZАБ..Я
оставив при этом такую же систему с кодом....

вот что я тут понапыталась написать....что-то не оч получилось
begin
assign(ffirst,E1);
assign(f2,E2);
assign(fnew1,E3);
assign(fnew2,E4);
{$I-}Reset(ffirst);{$I+}
If IOResult<>0 then
Writeln ('Fajl ne moget byt otkryt...') ;
{$I-}Reset(f2);{$I+}
If IOResult<>0 then
Writeln ('Fajl ne moget byt otkryt...') ;
rewrite(fnew1);
rewrite(fnew2);
p:=0; q:=0;
while not Eof(ffirst) do
begin
read(ffirst,snew);
p:=p+1;
sm:=snew;
Delete(sm, 1, 9);
while not eof(f2) do
begin
read(ffirst,snew1);
q:=q+1;
sb:=snew1;
delete(sb,1,9);
if p<>q then
if (sb<sm)and(sb[1]<>' ')and(sm[1]<>' ') then
begin
sm:=sb;
snew:=snew1;
end;
writeln(fnew1,snew);
end;
writeln(fnew1,snew);
end;
close(ffirst);
close(f2);
close(fnew1);
close(fnew2);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Вот тут: В текстовом файле упорядочить строки в пределах каждой страницы лежит процедура сортировки текстового файла слиянием. Чуть-чуть видоизменяем ее (упрощаем и добавляем нужную тебе функциональность), и получаем:

procedure sort_file(var f: text);

var
f1, f2: text;
b, b1, b2: string;
i, i1, i2, p: Boolean;
k: integer;

function split(s: string): string;
begin
split := copy(s, pos('=', s) + 2, 255);
end;

function more_less(const x,y: string; ord: Boolean):Boolean;
begin
more_less := ord = (split(x) < split(y));
end { more_less};

function read_str(var t: text; var buf: string): boolean;
var s: string;
begin
s := buf; readln(t, buf);
read_str := (buf <> s) and more_less(buf, s, true);
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};

procedure get_s(var f: text; var s: string; var b: boolean);
begin

if not eof(f) then begin
if read_str(f, s) then p := not p; b := false
end
else p:=not p

end;


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

if read_str(f,b) then inc(k);
if odd(k) then writeln(f1,b) else writeln(f2,b)

end;{ конец разделения }

p := true; 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
get_s(f1, b1, i1)
else get_s(f2, b2, i2);

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; { разделения на 2 файла }

close(f); close(f1); close(f2);
erase(f1); erase(f2);
END{sort_file};

var
f: text;
begin
assign(f,'D:\mom\ishodnik.txt');
sort_file(f);
end.

Это все, что нужно сделать... Файл будет отсортирован по названиям городов...
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 9.09.2025 20:02
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name