Вычислить количество IP адресов, которые можно составить из данного числа

var
  ip, nip, t: longword;
  p, n, k, i, j: byte;
  num: array[1..14] of byte;
  ipn: array[1..12] of byte;
  b: array[1..14] of boolean;
  err: boolean;
  s: string;
 
begin
  repeat //ввод массива цифр с проверкой
    write('Введите целое десятичное число длиной от 4 до 14 разрядов: ');
    readln(s);
    n := length(s);
    err := (n = 0) or (n < 4) or (n > 14) or not (s[1] in ['1'..'9']);
    if not err
      then for i := 1 to n do
        begin
          err := not (s[i] in ['0'..'9']);
          if not err
            then num[i] := ord(s[i]) - ord('0')
            else break
        end
  until not err;
  nip := 0;
  writeln('0%                            50%                             100%'); //progressbar
  writeln('                               |                               |'); //progressbar
  for ip := 0 to $FFFFFFFF do
    begin
      if ip and $3FFFFFF = 0 then write('|'); //progressbar
      for i := 1 to n do b[i] := false;
      k := 0;
      t := ip;
      for i := 1 to 4 do
        begin
          p := t mod $100;
          t := t div $100;
          repeat
            inc(k);
            ipn[k] := p mod 10;
            p := p div 10
          until p = 0
        end;
      for i := 1 to k do
        begin
          for j := 1 to n do
            begin
              err := (ipn[i] <> num[j]) or b[j];
              if not err
                then begin
                  b[j] := true;
                  break
                end
            end;
          if err then break
        end;
      if not err then inc(nip)
    end;
  writeln; //progressbar
  write('IP quantity = ', nip);
  readln
end.

program ip;
 
var
  s: string;
  i, j, k, l, n, a, b, c, d, code: integer;
 
begin
  readln(s);
  n := 0;
  for i := 1 to 3 do
    for j := 1 to 3 do
      for k := 1 to 3 do
        for l := 1 to 3 do
          if i + j + k + l = length(s) then
          begin
            val(copy(s, 1, i), a, code);
            val(copy(s, i + 1, j), b, code);
            val(copy(s, i + j + 1, k), c, code);
            val(copy(s, i + j + k + 1, l), d, code);
            if (a <= 255) and (b <= 255) and (c <= 255) and (d <= 255) then n := n + 1;
          end;
  writeln(n);
end.