program hamming;
const n    = 5;
     logn = 4;

var a : array[1..logn, 1..n + logn] of byte;
   s0 : array[1..logn] of byte;
   b : array[1..n + logn] of byte;
   i, j, k : integer;
   src : array[1..n] of byte;
   s   : string;

begin
(************************************************)
(* Ч А С Т Ь    1 : К О Д И Р О В А Н И Е         *)
(************************************************)

{ Ввод посл-ти }
   readLn(s);
   for i := 1 to n do src[i] := byte(s[i]) - byte('0');

{ Заполнение матр. a }
   fillchar(a, sizeof(a), 0);
   for i := 1 to n + logn do
   begin
       k := i;
       for j := 1 to logn do
       begin
           a[j, i] := k mod 2;
           k := k shr 1
       end;
   end;

{ Заполнение матр. b }
   k := 0; j := 1;
   for i := 1 to n + logn do
   begin
       if i shr k = 1  then begin
                               inc(k);
                               b[i] := 0
                           end
       else begin b[i] := src[j]; inc(j) end;
   end;

{ Подсчет контр. сумм }
   for i := 1 to logn do
   begin
       k := 0;
       for j := 1 to n + logn do
           k := (k + a[i, j] * b[j]) mod 2;
       s0[i] := k
   end;

{ Запихивание их в результат вместо нулей }
   k := 1;
   for i := 0 to logn - 1 do
   begin
       k := 1 shl i;
       b[k] := s0[i+1];
   end;

{ Вывод результатов }
   writeLn('_____________________________________________');
   for i := 1 to logn do begin
       write('a',i,'| ');
       for j := 1 to n + logn do write(a[i,j] :2, '|');
       write('    ||',s0[i]:2); writeLn;
   end;
   writeLn('_____________________________________________');
   write('b | '); for i := 1 to n + logn do write(b[i]:2, '|'); writeLn;

(************************************************)
(* Ч А С Т Ь    2 : П О И С К   О Ш И Б К И       *)
(************************************************)

{ Ввод ошибочной посл-ти }
   readLn(s);
   for i := 1 to n + logn do
       b[i] := byte(s[i]) - byte('0');

{ Поиск глюка в ошибочной посл-ти }
   for i := 1 to logn do
   begin
       k := 0;
       for j := 1 to n + logn do
           k := (k + a[i, j] * b[j]) mod 2;
       s0[i] := k
   end;
{ Вывод }
   k := 0;
   for i := logn downto 1 do k := k shl 1 + s0[i];
   if k <> 0 then writeLn('Ошибка в ', k, ' позиции')
             else writeLn('Нет ошибки');
   writeLn;
end.

1 0 1 0 1 0 1 0 1 |
0 1 1 0 0 1 1 0 0 |
0 0 0 1 1 1 1 0 0 |
0 0 0 0 0 0 0 1 1 |
------------------
0 1 1 0 1 0 1 1 1