Определить количество одинаковых подряд стоящих символов строки, и удалить повторяющиеся

var
  i,j:integer;
  s,s1,s2:string;
begin
  repeat
    write('Строка>'); readln(s);s:=s+' ';
  until length(s)>1;  
  j:=0;s2:='';s1:=s[1];
  for i:=2 to length(s) do
      if s[i-1]=s[i] then inc(j) else begin s1:=s1+s[i];s2:=s2+s[i-1]+chr(j);j:=0;end;
  writeln('Исходная строка:',s);
  writeln('Строка без повторов:',s1);
  writeln('Повторяющиеся символы и количество повторов:');
  i:=1;
  while i<length(s2) do begin
     if  ord(s2[i+1])>0 then writeln(s2[i],':',ord(s2[i+1])+1);
    inc(i,2);
  end;
end.

Program test;
uses crt;
VAR
s : string;
i,k : integer;
BEGIN
clrscr;
WriteLn('Введите строку : ');
ReadLn(s);
WriteLn('Исходная строка : ',s);
FOR i:=Length(s)-1 downto 1 do
  if s[i] = s[Succ(i)] then
    begin
      inc(k);
      delete(s,i,1)
    end;
WriteLn('Количество одинаковых символов : ',k);
WriteLn('Результат обработки строки : ',s);
Readkey
END.

Program test;
uses crt; { Нужно для использования процедуры clrscr очистки экрана и функции ReadKey ожидания нажатия клавиши }
VAR
s : string; { Вводим строковую переменную }
i,k : integer; { Вводим числовые переменные для прохода по строке и подсчёта количества одинаковых символов }
BEGIN
clrscr; { очищаем экран функцией clrscr из модуля crt }
WriteLn('Введите строку : '); { Выводим сообщение на экран }
ReadLn(s); { запоминаем введенную строку в переменной s }
WriteLn('Исходная строка : ',s); { Выводим на экран содержимое переменной s }
FOR i:=Length(s)-1 downto 1 do { Проходим от предпоследнего символа строки s до первого символа строки }
  if s[i] = s[Succ(i)] then { Сравниваем каждый символ со следующим за ним символом }
    begin
      inc(k); { Увеличиваем счётчик одинаковых символов на единицу }
      delete(s,i,1) { Удаляем текущий проверяемый символ }
    end;
WriteLn('Количество одинаковых символов : ',k); { Выводим на экран количество одинаковых символов }
WriteLn('Результат обработки строки : ',s); { Показываем на экране строку в которой одинаковые символы удалены }
Readkey { Препятствуем завершению программы и смотрим на результат работы программы }
END.

Var s:string; 
i,k,n:integer; 
Begin
Writeln('Введите строку:');
Readln(s); 
i:=1; 
k:=0; 
n:=1; 
While i<=length(s)-1 do 
begin 
 if s[i]=s[i+1] then 
  begin
   Delete(s,i+1,1); 
   k:=k+1+n; 
   i:=i-1; 
   n:=0; 
  end else n:=1;
 i:=i+1
end; 
Writeln('Таких символов - ',k); 
Writeln('Новая строка - ',s); 
End.