Почему ошибка в простой программе для паскаля?

Question

[недопрогер]

Изменить текст, удалив из него все повторные вхождения слов.
компилятор выдаёт ошибку в строке которая немного ниже бегина #$A0..#$AF: Res[i] := Char( Ord(aStr[i]) - $20 );
Неожиданный символ '#'

program Project1;

const
//Максимальное количество слов в тексте.
M = 20;

type
//Сведения о слове.
TWord = record
//Само слово.
sWord : String;
//Количество обнаружений слова в тексте.
Cnt : Integer;
end;

//Хранилище уникальных слов.
TVault = record
//Количество слов в хранилище. - Количество значимых элементов массива.
Len : Integer;
//Массив сведений о словах.
Arr : array[1..M] of TWord;
end;

//Преобразование букв строки в верхний регистр
//для кодовой страницы CP866 (DOS, OEM).
function UpperCase866(const aStr : String) : String;
var
i, Len : Integer;
Res : String;
begin
Len := Length(aStr);
SetLength(Res, Len);
for i := 1 to Len do begin
case aStr[i] of
//а..п -> А..П.
#$A0..#$AF: Res[i] := Char( Ord(aStr[i]) - $20 );
//р..я -> Р..Я.
#$E0..#$EF: Res[i] := Char( Ord(aStr[i]) - $50 );
//ё -> Ё.
#$F1: Res[i] := #$F0;
//Все остальные буквы.
else
Res[i] := UpCase(aStr[i]);
end;
end;

UpperCase866 := Res;
end;

//Добавляет слово в массив хранилища Vault. При этом, если добавляемое
//слово уже присутствует в массиве, тогда счётчик этого слова увеличивается
//на единицу. Если добавляемое слово пока не присутствует в массиве, тогда
//это слово записывается в массив и его счётчик устанавливается равным единице.
procedure AddToVault(var aVault : TVault; const aWord : String);
var
i : Integer;
b : Boolean;
begin
//Просматриваем массив - проверяем,
//есть ли уже в нём такое слово.
b := False;
for i := 1 to aVault.Len do begin
//Если такое же слово найдено, то увеличиваем
//его счётчик на единицу и выходим из цикла.
if aVault.Arr[i].SWord = aWord then begin
Inc( aVault.Arr[i].Cnt );
b := True;
Break;
end;
end;
//Если в предыдущем цикле слово не найдено, то
//добавляем слово в массив и устанавливаем счётчик этого
//слова равным единице.
if not b then begin
//Так как мы добавляем в массив новое слово, то количество значимых
//элементов массива становится на единицу больше.
Inc(aVault.Len);
//Записываем в массив данные нового элемента (слова).
aVault.Arr[aVault.Len].SWord := aWord;
aVault.Arr[aVault.Len].Cnt := 1;
end;
end;

//Проверяет - есть ли в хранилище заданное слово.
//Возвращаемое значение:
//0 - слова нет.
//1.. - индекс найденного слова.
function InVault(const aVault : TVault; aWord : String) : Integer;
var
i, Res : Integer;
begin
Res := 0;
for i := 1 to aVault.Len do begin
if aWord = aVault.Arr[i].SWord then begin
Res := i;
Break;
end;
end;
InVault := Res;
end;

const
//Разделители слов.
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
S, sWord : String;
i, j, Pos1, Len, LenW : Integer;
Vault : TVault;
begin
repeat
Writeln('Введите текст:');
Readln(S);

Vault.Len := 0;

//Извлекаем слова и добавляем их в хранилище Vault.
Len := Length(S);
Pos1 := 0;
for i := 1 to Len do begin
//Пропускаем разделители.
if S[i] in D then Continue;
//Отслеживаем начало слова.
if (i = 1) or (S[i - 1] in D) then Pos1 := i;
//Отслеживаем конец слова.
if (i = Len) or (S[i + 1] in D) then begin
//Добавляем слово в массив.
LenW := i - Pos1 + 1;
//Если требуется независимость от регистра букв.
//sWord := UpperCase866( Copy(S, Pos1, LenW) );
sWord := Copy(S, Pos1, LenW);
AddToVault(Vault, sWord);
end;
end;

//Переформировываем массив Vault так, чтобы в нём остались
//только те слова, которые в тексте присутствуют два и более раз.
j := 0;
for i := 1 to Vault.Len do begin
if Vault.Arr[i].Cnt > 1 then begin
Inc(j);
Vault.Arr[j] := Vault.Arr[i];
end;
end;
Vault.Len := j;

if Vault.Len = 0 then begin
Writeln('В тексте нет слов, которые присутствуют более одного раза.');
end else begin
Writeln('Перечень слов, которые присутствуют более одного раза:');
for i := 1 to Vault.Len do begin
if i > 1 then Write(', ');
Write(Vault.Arr[i].sWord);
end;
Writeln;
end;

//Удаляем из текста повторные вхождения слов.
Len := Length(S);
Pos1 := 0;
for i := Len downto 1 do begin
//Пропускаем разделители.
if S[i] in D then Continue;
//Отслеживаем конец слова.
if (i = Len) or (S[i + 1] in D) then Pos1 := i;
//Отслеживаем начало слова.
if (i = 1) or (S[i - 1] in D) then begin
//Удаляем искомые слова.
LenW := Pos1 - i + 1;
//Если требуется независимость от регистра букв.
//sWord := UpperCase866( Copy(S, i, LenW) );
sWord := Copy(S, i, LenW);
j := InVault(Vault, sWord);
if (j > 0) and (Vault.Arr[j].Cnt > 1) then begin
Delete(S, i, LenW);
Dec(Vault.Arr[j].Cnt);
end;
end;
end;

Writeln('Строка после обработки:');
Writeln(S);

Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end.

Comments

[Dimonchik]

мало кода

Answer 1

[Alexyz Canson]

function uCase(S :string):string;
const
  lStr = 'abcdefghijklmnopqrstuvwxyz';
  uStr = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  I, N :Integer;
  Buf :string;
begin
 uCase := S;
 if Length(S) > 0 then
 begin
   Buf := '';
   for I := 1 to Length(S) do
   begin
     N := Pos(S[I], lStr);
     if N > 0  then
      Buf := Buf + uStr[N]
     else
      Buf := Buf + S[I];
   end;
   uCase := Buf;
 end;
end;