Дан файл, содержащий текст на русском языке. Перечислить в алфавитном порядке все слова, встречающиеся в этом тексте — Pascal(Паскаль)

{Дан файл, содержащий текст на русском языке.
Перечислить в алфавитном порядке все слова,
встречающиеся в этом тексте.}

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.

Leave a Comment

3 + 1 =