Задачи на строковые и символьные массивы.

Сильно большая программа получается!
Ну да ладно.. .
~~~~~~~~~~~~~~~~~~
const
MaxSlov = 20;
SimSize = 5;
Sim : array [1..SimSize] of Char =
('.', ',', '(', ')', '"');

var
mSlov : array [1..MaxSlov] of String;
kSlov : Integer;

procedure SlovoVMassiv(S : String);
begin
if kSlov < MaxSlov then
begin
Inc(kSlov);
mSlov[kSlov] := S;
end;
end;

procedure RazborNaSlova(S : String);
var
Slovo : String;
Probel : Integer;
Simvol : Integer;
N : Integer;
begin
Slovo := '';
while Length(S) > 0 do
begin
Probel := Pos(' ', S);
case Probel of
0 : // осталось слово целиком
begin
Slovo := S;
S := '';
end;
1 : // в начале строки пробел
S := Copy(S, 2, Length(S) - 1)
else // выделяем слово из строки
begin
Slovo := Copy(S, 1, Probel - 1);
S := Copy(S, Probel + 1, Length(S) - Probel);
end;
end; // Case

if Length(Slovo) > 0 then
// Выделенное слово
begin
// Уберём не относящиеся к словам символы
for N := 1 to SimSize do
begin
Simvol := Pos(Sim[N], Slovo);
while Simvol > 0 do
begin
if Simvol = 1 then
// Символ в начале слова
Slovo := Copy(Slovo, 2, Length(S) - 1)
else if Simvol = Length(S) then
// Символ в конце слова
Slovo := Copy(Slovo, 1, Length(S) - 1)
else // Символ в середине слова
Slovo := Copy(Slovo, 1, Simvol - 1) + Copy(Slovo, Simvol + 1, Length(Slovo) - Simvol - 1);
Simvol := Pos(Sim[N], Slovo);
end;
end;

if Length(Slovo) > 0 then
SlovoVMassiv(Slovo);
end;
end;
end; // RazborNaSlova

var
S : String;
Dl, Kor : Integer;
N : Integer;

begin
kSlov := 0;
WriteLn('Введите предложение: ');
ReadLn(S);
RazborNaSlova(S);

if kSlov = 0 then Halt; // Ни одного слова не занесли в массив

// Самое длинное и самое короткое
Dl := 1;
Kor := 1;
for N := 2 to kSlov do
begin
if Length(mSlov[N]) > Length(mSlov[Dl]) then Dl := N;
if Length(mSlov[N]) < Length(mSlov[Kor]) then Kor := N;
end;
WriteLn('Самое длинное слово: ', mSlov[Dl]);
WriteLn('Самое короткое слово: ', mSlov[Kor]);

// Предложение в обратном порядке
WriteLn('Предложение в обратном порядке: ');
for N := kSlov downto 1 do
Write(mSlov[N], ' ');
WriteLn;

// Поменяем 1 и 2 слова
S := mSlov[1];
mSlov[1] := mSlov[2];
mSlov[2] := S;
WriteLn('Поменяли 1 и 2 слово: ');
for N := 1 to kSlov do
Write(mSlov[N], ' ');
WriteLn;
end.
~~~~~~~~~~~~~~~~~~
результаты выполнения:
Введите предложение:
о1лвраплв в2аорпвалопр в3алорпвалопр в4апорва орл5 рлрлолрл6
Самое длинное слово: в3алорпвалопр
Самое короткое слово: орл5
Предложение в обратном порядке:
рлрлолрл6 орл5 в4апорва в3алорпвалопр в2аорпвалопр о1лвраплв
Поменяли 1 и 2 слово:
в2аорпвалопр о1лвраплв в3алорпвалопр в4апорва орл5 рлрлолрл6