Программа


PROGRAM SortText;
Const MaxLenText=100; { Максимальная длина текста в строках }
TYPE TextArray=array [1..MaxLenText] of string; { Тип - массив текста }
     TypeText=record  { Тип - представление текста }
                Len:0..MaxLenText; { Фактическая длина текста }
                Text:TextArray; { Текст }
              end;
PROCEDURE ReadString(var F:text; var S:string; var Error:string);
{ Процедура чтения строки из текстового файла.
  F - файловая переменная (указатель)
  S - результат чтения строки
  Error - сообщение об ошибке при чтении строки }
  Var Ch:char; { Переменная для чтения символа из файла }
  Begin
    S:=''; { Сброс строки }
    while (Error='') and not EOLn(F) do { Цикл чтения строки }
      if (Length(S)=255) { Проверка достижения максимально допустимой длины строки }
      then Error:='ОШИБКА: Превышение допустимой длины строки! ' { Определение ошибки }
      else begin
             Read(F,Ch); { Чтение символа }
             S:=S+Ch     { Набор строки }
           end;
    if not EOF(F) then ReadLn(F); { Если не достигнут конец файла, то пропуск маркера конца строки }
  End;
PROCEDURE ReadText(InFileName:string; var T:TypeText; var Error:string);
{ Процедура чтения текста из файла
  InFileName - имя файла; T - текст; Error - сообщение об ошибке }
  Var F:text; { Файловая переменная для ввода текста }
  Begin
    Assign(F,InFileName); { Связывание файловой переменной с именем файла }
    Reset(F); { Открытие файла для чтения }
    T.Len:=0; { Сброс количества строк текста }
    while (Error='') and not EOF(F) do  { Цикл чтения файла }
    begin
      T.Len:=T.Len+1; { Набор количества строк }
      ReadString(F,T.Text[T.Len],Error); { Чтение строки текста }
      if (T.Len=MaxLenText) and not EOF(F)
        { Проверка превышения длины файла над максимально допустимым значением }
        then Error:='ОШИБКА: Слишком большой файл!'; { Определение ошибки }
    end;
    Close(F)  { Закрытие файла }
  End;
PROCEDURE WriteText(OutFileName:string; var T:TypeText);
{ Процедура записи текста в файл
  OutFileName - имя файла; T - текст }
  Var F:text; { Файловая переменная для вывода текста }
      i:0..MaxLenText; { Счетчик строк текста }
  Begin
    Assign(F,OutFileName); { Связывание файловой переменной с именем файла }
    Rewrite(F); { Открытие файла для записи }
    WriteLn(F,'Количество строк текста ',T.Len); { Вывод количества строк текста в файл }
    for i:=1 to T.Len do { Цикл вывода текста в файл }
      WriteLn(F,T.Text[i]); { Вывод строки в файл }
    Close(F)  { Закрытие файла }
  End;
PROCEDURE Sort(var T:TypeText); { Процедура сортировки текста. T - текст }
  Var i,j:1..MaxLenText; { Счетчики строк }
      Min:1..MaxLenText; { Указатель на минимальный элемент в неотсортированной части массива }
      S:string; { Вспомогательная переменная для перестановки строк текста }
  Begin
    if T.Len<>0 then
      for i:=1 to T.Len-1 do { Цикл сортировки текста }
      begin
        Min:=i; { Начальное определение номера минимального элемента
                  в неотсортированной части массива }
        for j:=i+1 to T.Len do { Цикл перебора неотсортированной части массива
                                 с поиском минимального элемента }
          if T.Text[Min]>T.Text[j] { Сравнение минимального элемента с текущим }
          then Min:=j;  { Переопределение минимального элемента }
        if Min<>i then { Проверка необходимости перестановки элементов }
        begin { Перестановка первого элемента с минимальным из
                неотсортированной части массива: }
          S:=T.Text[Min];
          T.Text[Min]:=T.Text[i];
          T.Text[i]:=S
        end;
      end;
  End;
VAR InFileName, OutFileName:string; { Имена входного и выходного файлов }
    T:TypeText; { Представление текста в программе }
    Error:string; { Сообщение об ошибке }
BEGIN
  WriteLn; { Пропуск строки }
  Write('Введите имя исходного файла текста '); { Вывод приглашения }
  ReadLn(InFileName); { Чтение имени исходного файла }
  Error:=''; { Сброс сообщения об ошибке }
  ReadText(InFileName,T,Error); { Чтение текста }
  if Error<>'' { Выбор при обнаружении ошибки }
  then WriteLn(Error) { Вывод сообщения об ошибке }
  else begin
         Sort(T); { Сортировка текста }
         Write('Введите имя файла результата сортировки текста '); { Вывод приглашения }
         ReadLn(OutFileName); { Чтение имени файла }
         WriteText(OutFileName,T); { Вывод файла }
       end
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию