Здравствуйте, Мироненко Николай Николаевич!
Решение сводится к нахождению цифр
(например, делением на 1000, 100, 10 и остаток)
И анализируй как хочется...
а) сравниваем 1, 4 и 2, 3
б,в) можно по разному.
Как вариант, считаем сначала цифры в массиве [0..9],
предварительно обнуленном. Индексом служат сами цифры.
Анализируем массив.
б)в массиве должны быть только два ненулевых значения, причем только 1 и 3
в)должны быть четыре единицы

Здравствуйте, Мироненко Николай Николаевич!
Program Chislo;
function CountDiffLetter(InData: String): integer;
var cnt: integer;
be: boolean;
a: array of char;
i, j: integer;
begin
cnt := 0;
SetLength(a, Length(InData));
for i := 1 to Length(InData) do
begin
be := true;
for j := 0 to i - 2 do
if InData[i] = a[j] then be := false;
a[i] := InData[i];
if be then cnt := cnt + 1;
end;
CountDiffLetter := cnt;
end;

function CountEq3Letter(InData: String): Boolean;
begin
if (InData[1] = InData[2] )AND(InData[1] = InData[3] ) AND (InData[1] <> InData[4] ) THEN CountEq3Letter := True
ELSE
if (InData[1] = InData[4] )AND(InData[1] = InData[3] ) AND (InData[1] <> InData[2] ) THEN CountEq3Letter := True
ELSE
if (InData[1] = InData[2] )AND(InData[1] = InData[4] ) AND (InData[1] <> InData[3] ) THEN CountEq3Letter := True
ELSE
if (InData[3] = InData[2] )AND(InData[1] = InData[4] ) AND (InData[1] <> InData[1] ) THEN CountEq3Letter := True
ELSE
CountEq3Letter := False
end;
Var
InData: string;
TempData: string;
i: integer;
Begin
WriteLn(‘Введите число‘);
Readln(InData);
IF Length(InData) < 4 THEN
BEGIN
WriteLn(‘Слишком короткое число‘);
Readln
END ELSE
BEGIn
for i := 1 to Length(InData) DO TempData := InData[i] + TempData;
IF TempData = InData Then WriteLn(‘Число - полиндром‘) ELSE WriteLN(‘Число не полиндром‘);
IF CountEq3Letter(InData) THEN WriteLN(‘Пункт Б - верно‘) ELSE WriteLN(‘Пункт Б - неверно‘);
IF CountDiffLetter(InData) = Length(InData) THEN WriteLN(‘Пункт B - верно‘) ELSE WriteLN(‘Пункт B - неверно‘);
END;
end;