Получение нового текстового файла, в котором все слова во всех предложениях записаны в обратном порядке

uses crt;
const
  MaxStek = 10;
var
  a: array[1..MaxStek] of string;
  t, g: text;
  i, n, k, q, st: integer;
  s, m: string;
 
procedure POP;
begin
  write(g, a[q], ' ');
  a[q] := '';
  q := q - 1;
  writeln ('Из стека убрано значение. Текущее количество элементов в стеке: ',q)
end;
 
procedure PUSH(str: string);
begin
  q := q + 1;
  a[q] := str;
  writeln ('В стек помещено значение. Текущее количество элементов в стеке:',q)
end;
 
begin
  assign(g, 'g.txt');
  rewrite(g);
  assign(t, 'k.txt'); {исходный файл}
  reset(t);
 
  m:= '';
 
  while not EOF(t) do begin
    readln(t, s);
    if (Length(s)>0) and (s[Length(s)]<>' ') then s := s + ' ';
    k:= 0;
    n:= 1;
    i:= 0;
    for n:= 1 to length(s) do begin
      i:= n - k; 
 
      if (s[n] = ' ') then begin 
        m := copy(s, k, i);
        k := n; 
      end;
 
      if (m <> '') and (q <= MaxStek) then begin 
        PUSH(m);
        m:= '';
      end;
 
      if q = MaxStek then begin
        for st := 1 to q do
          POP;
        writeln(g);
      end;
 
    end;
 
  end;
 
if q<>0 then begin
for i:=1 to q do
POP()
end;
 
  close(g);
  close(t);
end.

const
  aStackMaxSize = 10; {Наибольшая глубина стека.}

  Data := #10 + #13; {Перевёрнутый перенос строки.}

program Project1;
 
const
  aStackMaxSize = 10; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае функция
возвращает значение True. Если стек пуст, то операция отменяется и функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(var aF : Text; var aStW, aStBw : TStack; const aIsWord : Boolean);
var
  St1, St2 : TStack;
  Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsData1, IsData2 : Boolean;
begin
  {Переливаем междусловия в стек St1 и выполняем переворачивания.}
  Init(St1);
  while Pop(aStBw, Data) do {Берём междусловие из стека междусловий.}
  begin
    {Переворачиваем междусловие.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    Push(St1, Data); {Записываем междусловие в стек St1.}
  end;
  {Переливаем междусловия обратно - в стек междусловий.}
  while Pop(St1, Data) do
    Push(aStBw, Data);
 
  {Выбираем очерёдность стеков.}
  if aIsWord then
  begin
    St1 := aStW;
    St2 := aStBw;
  end
  else
  begin
    St1 := aStBw;
    St2 := aStW;
  end;
 
  {Извлекаем из стеков слова и междусловия и записываем их в выходной файл.}
  repeat
    IsData1 := Pop(St1, Data);
    if IsData1 then
      Write(aF, Data);
    IsData2 := Pop(St2, Data);
    if IsData2 then
      Write(aF, Data);
  until not (IsData1 or IsData2);
  {Теперь стеки пусты, выполняем инициализацию представляющих их параметров.}
  Init(aStW);
  Init(aStBw);
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  StW, StBw : TStack; {Стек слов и стек междусловий.}
  Data, DataTmp : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord = True - последний записанный в стек элемент является словом,
    False - последний записанный в стек элемент является междусловием.
  IsDataW = True - слово успешно добавлено в стек слов. Иначе - False.
  IsDataBw = True - междусловие успешно добавлено в стек междусловий. Иначе - False.}
  IsWord, IsDataW, IsDataBw : Boolean;
begin
  {Начальная инициализация стеков.}
  Init(StW);
  Init(StBw);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    IsDataW := True;
    IsDataBw := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            if IsDataBw then
            begin
              Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки междусловие.}
              {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
              if not IsWord and Pop(StBw, DataTmp) then
                Data := DataTmp + Data;
              IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
              if IsDataBw then
                IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            end;
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            if IsDataW then
            begin
              IsDataW := Push(StW, Copy(S, i - LenW + 1, LenW)); {Добавление слова в стек.}
              if IsDataBw then
                IsWord := True; {Флаг: последний добавленный элемент - слово.}
            end;
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          StWrite(FOut, StW, StBw, IsWord); {Запись содержимого стека в файл.}
          IsDataW := True;
          IsDataBw := True;
        end;
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        {Если в стеке междусловий есть свободное место, то добавляем в него
        перевёрнутый перенос строки.}
        if IsDataBw then
        begin
          Data := #10#13; {Перевёрнутый перенос строки.}
          {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
          if not IsWord and Pop(StBw, DataTmp) then
            Data := DataTmp + Data;
          IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
          if IsDataBw then
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        end;
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, StW, StBw, IsWord);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(StW);
    StFree(StBw);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  aStackMaxSize = 10; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае функция
возвращает значение True. Если стек пуст, то операция отменяется и функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Функция формирует из содержимого стека aStW часть предложения и записывает
его в стек aStP.}
function PushPart(var aStP, aStW : TStack; const aIsWord : Boolean) : Boolean;
var
  S, Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsWord : Boolean;
begin
  {Извлекаем из стека aStW слова и междусловия и формируем из них часть предложения.}
  S := '';
  IsWord := aIsWord;
  while Pop(aStW, Data) do
  begin
    if not IsWord then {Если элемент является междусловием.}
    begin
      {Переворачиваем междусловие.}
      Len := Length(Data);
      for i := 1 to Len div 2 do
      begin
        Ch := Data[i];
        Data[i] := Data[Len - i + 1];
        Data[Len - i + 1] := Ch;
      end;
    end;
    S := S + Data;
    IsWord := not IsWord;
  end;
  {Записываем часть предложения в стек aStP.}
  PushPart := True;
  if S <> '' then
    PushPart := Push(aStP, S);
end;
 
{Добавление слова или междусловия в стек.}
procedure PushE(var aStP, aStW : TStack; aData : TData; const aIsWordPred, aIsWord : Boolean);
var
  DataTmp : TData;
begin
  {Если текущий и предыдущий элементы являлся междусловиями, то выполняем склейку.}
  if not aIsWord and not aIsWordPred and Pop(aStW, DataTmp) then
      aData := DataTmp + aData;
  {Добавляем в стек элемент (слово или междусловие.}
  if not Push(aStW, aData) then {Если в стеке aStW нет свободного места, то...}
  begin
    PushPart(aStP, aStW, aIsWordPred); {Формируем часть предложения и записываем эту часть в стек aStP.}
    Push(aStW, aData); {Повторная попытка записи элемента в стек.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  StW, StP : TStack; {Стек слов и междусловий и стек частей предложения.}
  Data : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord =
  True - последний записанный в стек элемент является словом,
  False - последний записанный в стек элемент является междусловием.}
  IsWord : Boolean;
begin
  {Начальная инициализация стеков.}
  Init(StW);
  Init(StP);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            PushE(StP, StW, Copy(S, i - LenBw + 1, LenBw), IsWord, False); {Добавление междусловия в стек.}
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            PushE(StP, StW, Copy(S, i - LenW + 1, LenW), IsWord, True); {Добавление слова в стек.}
            IsWord := True; {Флаг: последний добавленный элемент - слово.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          {Запись содержимого стека в файл.}
          PushPart(StP, StW, IsWord);
          while Pop(StP, Data) do
            Write(FOut, Data);
        end;
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        PushE(StP, StW, #10#13, IsWord, False); {Добавляем в стек перевёрнутый перенос строки.}
        IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    PushPart(StP, StW, IsWord);
    while Pop(StP, Data) do
      Write(FOut, Data);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(StW);
    StFree(StP);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

{Функция формирует из содержимого стека aStW часть предложения и записывает
его в стек aStP.}
function PushPart(var aStP, aStW : TStack) : Boolean;
var
  S, Data : TData;
  Ch : Char;
  i, Len : Integer;
begin
  {Извлекаем из стека aStW слова и междусловия и формируем из них часть предложения.}
  S := '';
  while Pop(aStW, Data) do
  begin
    {Переворачиваем текст элемента.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    S := S + Data;
  end;
  {Записываем часть предложения в стек aStP.}
  PushPart := True;
  if S <> '' then
    PushPart := Push(aStP, S);
end;

program Project1;
 
const
  aStackMaxSize = 10; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае функция
возвращает значение True. Если стек пуст, то операция отменяется и функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Функция формирует из содержимого стека aStW часть предложения и записывает
его в стек aStP.}
function PushPart(var aStP, aStW : TStack) : Boolean;
var
  S, Data : TData;
  Ch : Char;
  i, Len : Integer;
begin
  {Извлекаем из стека aStW слова и междусловия и формируем из них часть предложения.}
  S := '';
  while Pop(aStW, Data) do
  begin
    {Переворачиваем текст элемента.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    S := S + Data;
  end;
  {Записываем часть предложения в стек aStP.}
  PushPart := True;
  if S <> '' then
    PushPart := Push(aStP, S);
end;
 
{Добавление слова или междусловия в стек.}
procedure PushE(var aStP, aStW : TStack; aData : TData; const aIsWordPred, aIsWord : Boolean);
var
  DataTmp : TData;
begin
  {Если текущий и предыдущий элементы являлся междусловиями, то выполняем склейку.}
  if not aIsWord and not aIsWordPred and Pop(aStW, DataTmp) then
      aData := DataTmp + aData;
  {Добавляем в стек элемент (слово или междусловие.}
  if not Push(aStW, aData) then {Если в стеке aStW нет свободного места, то...}
  begin
    PushPart(aStP, aStW); {Формируем часть предложения и записываем эту часть в стек aStP.}
    Push(aStW, aData); {Повторная попытка записи междусловия в стек.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  StW, StP : TStack; {Стек слов и междусловий и стек частей предложения.}
  Data : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord =
  True - последний записанный в стек элемент является словом,
  False - последний записанный в стек элемент является междусловием.}
  IsWord : Boolean;
begin
  {Начальная инициализация стеков.}
  Init(StW);
  Init(StP);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            PushE(StP, StW, Copy(S, i - LenBw + 1, LenBw), IsWord, False); {Добавление междусловия в стек.}
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            PushE(StP, StW, Copy(S, i - LenW + 1, LenW), IsWord, True); {Добавление слова в стек.}
            IsWord := True; {Флаг: последний добавленный элемент - слово.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          {Запись содержимого стека в файл.}
          PushPart(StP, StW);
          while Pop(StP, Data) do
            Write(FOut, Data);
        end;
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        PushE(StP, StW, #10#13, IsWord, False); {Добавляем в стек перевёрнутый перенос строки.}
        IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    PushPart(StP, StW);
    while Pop(StP, Data) do
      Write(FOut, Data);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(StW);
    StFree(StP);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

{Добавление слова или междусловия в стек.}
procedure PushE(var aStP, aStW : TStack; aData : TData; const aIsWordPred, aIsWord : Boolean);
var
  DataTmp : TData;
begin
  {Если текущий и предыдущий элементы являлся междусловиями, то выполняем склейку.}
  if not aIsWord and not aIsWordPred and Pop(aStW, DataTmp) then
      aData := DataTmp + aData;
  {Добавляем в стек элемент (слово или междусловие.}
  if not Push(aStW, aData) then {Если в стеке aStW нет свободного места, то...}
  begin
    PushPart(aStP, aStW); {Формируем часть предложения и записываем эту часть в стек aStP.}
    Push(aStW, aData); {Повторная попытка записи междусловия в стек.}
  end;
end;

  {Добавляем в стек элемент (слово или междусловие.}
  if not Push(aStW, aData) then {Если в стеке aStW нет свободного места, то...}
  begin
    PushPart(aStP, aStW); {Формируем часть предложения и записываем эту часть в стек aStP.}
    Push(aStW, aData); {Повторная попытка записи междусловия в стек.}
  end;

if not Push(aStW, aData) then {Если в стеке aStW нет свободного места, то...}

PushPart(aStP, aStW); {Формируем часть предложения и записываем эту часть в стек aStP.}
Push(aStW, aData); {Повторная попытка записи междусловия в стек.}

Push(aStW, aData); {Повторная попытка записи междусловия в стек.}