Главная Случайная страница Контакты | Мы поможем в написании вашей работы! | ||
|
Program TextFile;
{Сортировка слов в строках текстового файла по алфавиту.
Дан текст. Словом является любая последовательность букв
алфавита. Перед первым словом, после последнего слова и
между словами произвольное число пробелов.
Переставить в каждой строке слова таким образом,
чтобы они были упорядочены по алфавиту.}
Uses Crt; {подключение стандартного модуля Crt}
Procedure Exist(Var nameFT:String);
{Проверка существования файла с указанным именем}
Var
ch:Char;
FT:Text;
Begin
Assign(FT,nameFT);
{$I-} {отключение контроля ошибок ввода-вывода}
Reset(FT);
{$I+} {включение контроля ошибок ввода-вывода}
If IOResult=0
Then Begin
WriteLn('Файл с таким именем уже существует!');
Write('Хотите его уничтожить? Y/N ->');
ReadLn(ch);
If ch In ['n','N','т','Т']
Then Repeat
WriteLn('Введите другое имя:');
ReadLn(nameFT);
Assign(FT,nameFT);
{$I-}
Reset(FT);
{$I+}
If IOResult=0
Then Begin
WriteLn('Файл с таким именем уже существует!');
Write('Хотите его уничтожить? Y/N ->');
ReadLn(ch);
End;
Until (IOResult<>0)Or(ch In['y','Y','н','Н']);
End;
End;
Procedure SozdFT(Const nameFT:String);
{Создание исходного текстового файла}
Var
FT:Text;
i:Byte;
st:String;
Begin
Assign(FT,nameFT);
ReWrite(FT); {открытие файла для записи}
Write('Начинаем ввод. ');
WriteLn('Признак окончания ввода - пустая строка.');
i:=0;
WriteLn('Введите ',i+1,'-ую строку создаваемого файла:');
ReadLn(st); {ввод строки с клавиатуры}
While st<>'' {пока строка не пустая}
Do Begin
WriteLn(FT,st); {запись строки в файл}
Inc(i);
WriteLn('Введите ',i+1,'-ую строку создаваемого файла:');
ReadLn(st);
End;
WriteLn('Введено ',i,' строк');
Close(FT); {закрытие файла}
End;
Procedure ProsmFT(Const nameFT:String);
{Процедура просмотра текстового файла}
Var
st:String;
FT:Text;
Begin
Assign(FT,nameFT);
Reset(FT); {открытие файла для чтения}
If Eof(FT)
Then Begin
Writeln('Файл пуст!');
WriteLn('Нажмите Enter ->');
ReadLn;
Halt;
End;
Writeln(' содержимое файла:'); Writeln;
While Not Eof(FT) {пока не конец файла:}
Do Begin
Readln(FT,st); {чтение строки из файла}
Writeln(st); {вывод строки на экран}
End;
Writeln;
Close(FT); {закрытие файла}
End; {ProsmFT}
Function NovSt(st:String):string;
{Удаление лишних пробелов.
Входное данное: st-строка из слов, разделенных пробелами.
Выходное данное: NovSt-строка без лишних пробелов.}
Var
L,i:Byte;
Begin
L:=Length(st); {текущая длина строки}
i:=1; {текущий номер символа строки}
While i<=L {пока текущий номер в пределах строки}
Do Begin
If st[i]=' ' {если текущий символ - пробел}
Then Begin
If (i=1) Or (i=L) {пробел в начале или конце строки}
Then Delete(st,i,1) {удаление пробела}
Else If (i<L) And (st[i+1]=' ') {второй пробел подряд}
Then Delete(st,i+1,1) {удаление пробела}
Else i:=i+1; {текущий номер символа}
L:=Length(st); {текущая длина строки}
End
Else i:=i+1; {новый текущий номер символа}
End;
NovSt:=st;
End; {UdalLP}
Function Slovo(pn:Byte; st:String):String;
{Выделение очередного слова строки.
Входные данные: pn - начальная позиция слова в строке,
st - строка из слов.
Выходное данное: Slovo - очередное слово строки.}
Var
L,p:Byte;
Begin
L:=Length(st); {длина строки}
p:=pn;
{Цикл поиска очередного пробела}
While (p<=L)And(st[p]<>' ') {Пока не конец слова}
Do p:=p+1; {изменение позиции в строке}
Slovo:=Copy(st,pn,p-pn); {Выделение слова}
End;{Slovo}
Function LexSort(st:String):String;
{Сортировка слов строки по алфавиту.
Входное данное: st-строка из слов, разделенных пробелами.
Выходное данное: LexSort-строка из слов по алфавиту.}
Var
L, {длина строки}
p1,p2:Byte; {начальные позиции соседних слов в строке}
sl1,sl2:String; {соседние слова в строке}
flag:Boolean; {флаг перестановки слов}
Begin
L:=Length(st); {определение длины строки}
Repeat
flag:=FALSE; {отсутствие перестановки}
p1:=1; sl1:=Slovo(p1,st); {первое слово}
While p1+Length(sl1)<L {пока sl1 не последнее}
Do Begin
p2:=p1+Length(sl1)+1;{позиция 2-го слова}
sl2:=Slovo(p2,st); {второе слово}
If sl2<sl1
Then Begin {обмен соседних слов}
Delete(st,p1,p2+Length(sl2)-p1);
Insert(sl2+' '+sl1,st,p1);
p1:=p1+Length(sl2)+1;
flag:=TRUE; {есть перестановка}
End
Else Begin {переход к очередной паре слов}
sl1:=sl2; {новое первое слово}
p1:=p2; {новая позиция слова}
End;
End;
Until Not flag; {до отсутствия перестановок}
LexSort:=st;
End; {LexSort}
Procedure RedaktFT(Const nameF1,nameF2:String);
{Процедура редактирования текстового файла.
Входные данные: F1 - исходный текстовый файл.
Выходные данные: F2 - отредактированный текстовый файл.}
Var
F1,F2:Text;
st:String; {редактируемая строка}
Begin
Assign(F1,nameF1); Assign(F2,nameF2);
Reset(F1); Rewrite(F2); {открытие файлов}
While Not Eof(F1) {пока не конец входного файла}
Do Begin
ReadLn(F1,st); {чтение очередной строки}
st:=NovSt(st); {удаление лишних пробелов}
st:=LexSort(st); {сортировка слов строки по алфавиту}
WriteLn(F2,st); {запись строки в новый файл}
End;
Close(F1); Close(F2); {закрытие файлов}
End; {RedaktFT}
{Основная программа}
Var
nameF1,nameF2:String; {имена текстовых файлов}
Begin
ClrScr; {очистка экрана}
Write('Введите имя исходного файла: ');
ReadLn(nameF1);
Exist(nameF1);
SozdFT(nameF1); {создание исходного файла}
Write('После создания');
ProsmFT(nameF1);
Write('Введите имя результирующего файла: ');
ReadLn(nameF2);
Exist(nameF2);
RedaktFT(nameF1,nameF2); {редактирование файла}
Write('После редактирования');
ProsmFT(nameF2);
ReadLn;
End. {FileText}
Дата публикования: 2014-11-03; Прочитано: 413 | Нарушение авторского права страницы | Мы поможем в написании вашей работы!