С помощью цикла while:
var
a, s, x, n: integer;
begin
writeln('Введите число: ');
read(n);
a := 1; x := 1000;
while x <> 0 do
begin
s := (n div x) mod 10;
a := a * s;
x := trunc(x / 10);
end;
writeln('Результат: ',a);
end.
C помощью цикла repeat:
var
a, s, x, n: integer;
begin
writeln('Введите число: ');
read(n);
a := 1;
x := 1000;
repeat
s := (n div x) mod 10;
a := a * s;
x := trunc(x / 10);
until x < 1;
writeln('Результат: ', a);
end.