lab1sem2

Program Lab1;
{$AppType CONSOLE}

uses
  Windows,
  Unit1 in 'Unit1.pas';

Var
    S, S1, S2: ANSIString;
    Nom: Byte;
Begin

 // сменим кодовые страницы  для консольного ввода и вывода
  setConsoleCP(1251); // для ввода
  setConsoleOutputCP(1251); // для вывода

  Writeln('Введите строку (смените шрифт на Lucida Console)');
  readln(S); // ввод

 S1:=Copy(S, 1, Length(S)); S2:=Copy(S, 1, Length(S)); // создание копий дин.строки

  // без своей таблицы символов (со сложным условием обмена)
  Writeln(#13#10, 'Строка до сортировки'#13#10, S1);
  Nom:= Prov1(s1); // проверка
  Case Nom of
    1: writeln('Пустая строка');
    2: writeln('Некорректные символы');
    else
     begin // сортировка
       Sort1(s1);
       Writeln('Отсортированная строка 1'#13#10,'[', S1, ']');  // вывод строки S1
     end; {else}
  End; {case}

  // со своей таблицей символов
  Writeln(#13#10'Строка до сортировки'#13#10, S2);
  Nom:= Prov2(s2); // проверка
  Case Nom of
    1: writeln('Пустая строка');
    2: writeln('Некорректные символы');
    else
     begin // сортировка
       Sort2(s2);
       Writeln('Отсортированная строка 2'#13#10,'[', S2,']');  // вывод строки S2
     end; {else}
  End; {case}

  writeln(#13#10'Press ENTER to exit');
  readln
End.


Код модуля.

Unit Unit1;      // имя модуля – меняется при сохранении File  Save As…
Interface       // раздел описания межмодульного интерфейса

Uses
  SysUtils;

Const
  SymbTable = 'абвгдеёжзийклмнопрстуфхцчшщъыбэюяАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ ';

Const
  prob : set of char = [' '];
  big: set of char = ['А'.. 'Я', 'Ё'];
  small: set of char = ['а'.. 'я', 'ё'];

Function Prov1(const s: ANSIString): Byte; // проверка без SymbTable
Function Prov2(const s: ANSIString): Byte; // проверка с SymbTable
Procedure Sort1(var s: ANSIString);  // сортировка без SymbTable
Procedure Sort2(var s: ANSIString);  // сортировка с SymbTable

Implementation  // раздел реализации и описания закрытых процедур

Function Prov1; // проверка без SymbTable
Var
  Nom: byte; // номер аномалии
  i,Len: word; // текущий символ и длина строки
begin
  Nom:=0; len:= Length(S);
  If Len=0 then Nom:=1
  Else
    Begin
      i:=1;
      while (i<=Len) and (Nom=0) do
      begin
        if Not ((S[i] in prob) or (S[i] in big) or (S[i] in small)) then Nom:=2;
        Inc(i);
      end;
    End;
  Prov1:=Nom;
end;

Function Prov2; // проверка с SymbTable
Var
  Nom: byte; // номер аномалии
  i,Len: word; // текущий символ и длина строки
Begin
  Nom:=0; len:= Length(S);
  If Len=0 then Nom:=1
  Else
    Begin
      i:=1;
      while (i<=Len) and (Nom=0) do
      begin
        if Not (Pos(S[i], SymbTable)>0) then Nom:=2;
        Inc(i);
      end;
    End;
  Prov2:=Nom;
End;

procedure Sort1;  // сортировка без SymbTable
var
  i, z, len: Word; // номер текущего символа, номер итерации (шага), длина строки
  flag: Boolean; // упорядочено? (нет обменов?)
  ch: ansichar; // для обмена
begin
  Z:=1;  len:=length(s);
  Repeat // пузырёк
    flag:=true;
    for i:=1 to len-z do
      if (s[i] in prob) and ((s[i+1] in small) or (s[i+1] in big)) or    //кириллицы строчные легче
         (s[i] in big) and (s[i+1] in small) or       // кириллица стр «легче» заглавных – всплывает
         (s[i] in big) and (s[i+1] in big) and (s[i]>s[i+1])     // обе строчные кириллицы – по убыванию
      then
      begin // обмен
        ch:=s[i]; s[i]:=s[i+1]; s[i+1]:=ch; flag:= false;
      end;
    inc(z);
  Until flag or (z=len);
end;
Procedure Sort2;  // сортировка с SymbTable
Var
  i, z, len: Word; // номер текущего символа, номер итерации (шага), длина строки
  flag: Boolean; // упорядочено? (нет обменов?)
  ch: ansichar; // для обмена
Begin
  z:=1;  len:=length(s);
  Repeat // пузырёк
    flag:=true;
    for i:=1 to len-z do
      if (Pos(s[i], SymbTable) > Pos(s[i+1], SymbTable))  // неправильный порядок по своей «таблице»
        and not ((s[i] in small) and (s[i+1] in small)) // но маленькие не упорядочивать
      then
      begin // обмен
        ch:=s[i]; s[i]:=s[i+1]; s[i+1]:=ch; flag:= false;
      end;
    inc(z);
  Until flag or (z=len);
End;

end.