Строки. Множества.

uses crt;
var str:string;
ch:char;
n:integer;
begin
read(str);
ch:=str[length(str)];
while pos(ch,str)<>0 do begin
n:=pos(ch,str);
delete(str,n,1);
end;
write(str);
end.

Program userabc;
Uses crt;
Const g: array[1..9] of char=('à','å','è','î','ó','û','ý','þ','ÿ');
Var i,j: byte;
s: string;
Begin
j:=1;
writeln('ââåäèòå òåêñò: ');
readln(s);
For j:=1 to 9 do
 For i:=1 to length(s) do
  If s[i]=g[j] then
  Write(s[i],' ');
End.

const sen=['а','е','ё','и','о','у','ы','э','ю','я'];
 
type tset=set of char;
     tarray=array[char] of integer;
 
procedure count(var aset:tset; var amas:tarray;var arg:string);
var i:byte;
begin
  for i:=1 to length(arg) do
    if arg[i] in sen then begin
      aset:=aset+[arg[i]];
      inc(amas[arg[i]]);
    end;
end;
 
procedure writecount(var aset:tset;var amas:tarray);
var ch:char;
begin
  for ch:= char(0) to char(255)  do
    if ch in aset then begin
      write(ch);
      writeln(amas[ch]:4);
    end;
end;
 
var sn:tset;mas:tarray;
    ch:char;s:string;
begin
  sn:=[];s:='';
  while ch<>'.' do begin
    read(ch);
    s:=s+ch;
  end;
  writeln;
  for ch:= char(0) to char(255) do mas[ch]:=0;
  count(sn,mas,s);
  writecount(sn,mas);
  readln;
  readln
end.

var s:string;sn:set of char;
    ch:char;i:integer;
begin
  readln(s);
  sn:=[];
  ch:=s[length(s)];
  include(sn,ch);
  for i:=1 to length(s) do
    if s[i] in sn then
      delete(s,i,1);
  writeln(s);
  readln
end.