U
U
underprogrammer2017-12-17 19:02:03
Pascal
underprogrammer, 2017-12-17 19:02:03

Why is there an error in a simple pascal program?

Change the text by removing all repeated occurrences of words from it.
the compiler throws an error on the line just below the start #$A0..#$AF: Res[i] := Char( Ord(aStr[i]) - $20 );
Unexpected character '#'
program Project1;
const
//Maximum number of words in the text.
M=20;
type
//Information about the word.
TWord = record
//The word itself.
sWord : String;
//Number of occurrences of the word in the text.
Cnt : Integer;
end;
//Storage of unique words.
TVault = record
//Number of words in storage. - The number of significant array elements.
Len : Integer;
//Array of information about words.
Arr : array[1..M] of TWord;
end;
//Convert string letters to uppercase
//for code page CP866 (DOS, OEM).
function UpperCase866(const aStr : String) : String;
var
i, Len : Integer;
Res : String;
begin
Len := Length(aStr);
SetLength(Res, Length);
for i := 1 to Len do begin
case aStr[i] of
//a..p -> A..P.
#$A0..#$AF: Res[i] := Char( Ord(aStr[i]) - $20 );
//r..i -> R..I.
#$E0..#$EF: Res[i] := Char( Ord(aStr[i]) - $50 );
//e -> E.
#$F1: Res[i] := #$F0;
//All other letters.
else
Res[i] := UpCase(aStr[i]);
end;
end;
UpperCase866 := Res;
end;
//Adds a word to the Vault storage array. In this case, if the //word being added
is already present in the array, then the counter of this word is
//increased by one. If the word to be added is not yet in the array, then
//this word is written to the array and its counter is set to one.
procedure AddToVault(var aVault : TVault; const aWord : String);
var
i : Integer;
b : Boolean
begin
//Looking through the array - checking
if //there is already such a word in it.
b := False;
for i := 1 to aVault.Len do begin
//If the same word is found, then
//increment its counter by one and exit the loop.
if aVault.Arr[i].SWord = aWord then begin
Inc( aVault.Arr[i].Cnt );
b := True;
break;
end;
end;
//If the word was not found in the previous loop, then
//add the word to the array and set the counter of this
//word to one.
if not b then begin
//Since we are adding a new word to the array, the number of significant
//elements of the array becomes one more.
Inc(aVault.Len);
//We write the data of the new element (word) to the array.
aVault.Arr[aVault.Len].SWord := aWord;
aVault.Arr[aVault.Len].Cnt := 1;
end;
end;
//Checks if the specified word is in the storage.
//Returned value:
//0 - no word.
//1.. - index of the found word.
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
//Word separators.
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
S, sWord : String;
i, j, Pos1, Len, LenW : Integer;
Vault : TVault;
begin
repeat
Writeln('Enter text:');
readln(S);
vault.Len := 0;
//Retrieve the words and add them to the Vault.
Len := Length(S);
Pos1 := 0;
for i := 1 to Len do begin
//Skip delimiters.
if S[i] in D then Continue;
//Track the beginning of the word.
if (i = 1) or (S[i - 1] in D) then Pos1 := i;
// Track the end of the word.
//Add the word to the array.
LenW := i - Pos1 + 1;
//If you want to be case-insensitive.
//sWord := UpperCase866( Copy(S, Pos1, LenW) );
sWord := Copy(S, Pos1, LenW);
AddToVault(Vault, sWord);
end;
end;
//Reshape the Vault array so that
//only those words that appear in the text two or more times remain in it.
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('There are no words in the text that appear more than once.');
end else begin
Writeln('List of words that appear more than once:');
for i := 1 to Vault.Len do begin
if i > 1 then Write(', ');
Write(Vault.Arr[i].sWord);
end;
Writeln;
end;
//Remove repeated occurrences of words from the text.
Len := Length(S);
Pos1 := 0;
for i := Len downto 1 do begin
//Skip delimiters.
if S[i] in D then Continue;
// Track the end of the word.
if (i = Len) or (S[i + 1] in D) then Pos1 := i;
//Track the beginning of the word.
if (i = 1) or (S[i - 1] in D) then begin
//Delete search words.
LenW := Pos1 - i + 1;
//If you want to be case-insensitive.
//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('String after processing:');
WriteIn(S);
Writeln('Repeat - Enter. Exit - any character + Enter.');
readln(S);
until S <> '';
end.

Answer the question

In order to leave comments, you need to log in

1 answer(s)
A
Alexyz Canson, 2018-12-01
@jone21

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;

Didn't find what you were looking for?

Ask your question

Ask a Question

731 491 924 answers to any question