а бесконечный* while не напрягает?
пачему так решил я уже исправил где указывал там и была ошибка вот без ашибак
program Bevarde1;
var n,a,g: longint;
s,max,min,imin,imax:byte;
begin
WriteLn('введите число');
Readln(n);
g:=n;
max:=0;
min:=9;
while n>0 do
begin
s := n mod 10;
n := n div 10;
if s>max then begin max:=s; imax:=max; end;
end;
while g>0 do
begin
s := g mod 10;
g := g div 10;
if (imin<>s ) and (imax<>s)
then a:=1+a;
end;
WriteLn(a);
readln;
end.