{Дан файл, содержащий текст на русском языке.
Перечислить в алфавитном порядке все слова,
встречающиеся в этом тексте.}
Program Alpha_Beta;
Var T : Text;
R : String;
Stroka, Slovo : String;
Sl : File Of String;
N : Integer;
{Процедура преобразования заглавных букв в слове в маленькие}
Procedure Preobr(Var S : String);
Var I : Byte;
Begin
For I := 1 To Length(S) Do
Begin
If Ord(S[I]) In [128..143]
Then S[I] := Chr(Ord(S[I]) + 32);
If Ord(S[I]) In [144..159]
Then S[I] := Chr(Ord(S[I]) + 80)
End
End;
{Процедура поиска слова в данной строке и занесение его в словарь}
Procedure Find(Var S : String);
Const Mn = ['А'..'Я', 'а'..'п', 'р'..'я'];
Var N, K : Integer;
S1, Slovo, X : String;
B : Boolean;
KK, Poz : Integer;
Begin
N := 1;
{Ищем начало слова}
While Not(S[N] In Mn) And (N <= Length(S)) Do
N := N + 1;
K := N;
{Ищем конец слова}
While (S[K] In Mn) And (K <= Length(S)) Do
K := K + 1;
S1 := Copy(S, N, K - N);
Preobr(S1);
{Ищем начало следующего слова}
While Not(S[K] In Mn) And (K <= Length(S)) Do
K := K + 1;
Delete(S, 1, K - 1); {Удаление найденного слова вместе с пробелами
и знаками препинания }
{Вставляем очередное слово в словарь}
ReSet(Sl);
B := True;
While Not Eof(Sl) And B Do
Begin
Read(Sl, Slovo);
B := S1 > Slovo
End;
If Eof(Sl)
Then Begin If B
Then Write(Sl, S1)
End
Else If S1 <> Slovo
Then
Begin
Poz := FilePos(Sl) - 1;
KK := FileSize(Sl) - 1;
While KK >= Poz Do
Begin
Seek(Sl, KK);
Read(Sl, X);
Write(Sl, X);
KK := KK - 1
End;
Seek(Sl, Poz);
Write(Sl, S1)
End
End;
{Основная программа}
Begin
Write('Введите имя файла: ');
ReadLn(R);
Assign(T, R);
Reset(T);
Assign(Sl, 'c:\tp7\Slovar.dat');
ReWrite(Sl);
Close(Sl);
While Not Eof(T) Do
Begin
ReadLn(T, Stroka);
WriteLn(Stroka);
While Length(Stroka) > 0 Do
Find(Stroka);
End;
Reset(Sl);
While Not Eof(Sl) Do
Begin
Read(Sl, Stroka);
WriteLn(Stroka);
End;
Close(Sl)
End.