Here is my program.

var a:array[0..1000] of char;
    n,i,top,j,one,oo,k:integer;
    s:longint;
    c:char;

begin
 readln(n);
 while not eof do
 begin
  top:=0;
  one:=0;
  while not eoln do
  begin
   read(c);
   if (c<>' ') then
   begin
    inc(top);
    a[top]:=c;
    if c='1' then inc(one);
   end;
  end;
  s:=0;
  for j:=1 to top do
  if a[j]='1' then s:=s+j;
  if top=n then
  begin
   if s mod (n+1)=0 then
   begin
    for j:=1 to n do write(a[j]);
    writeln;
   end else
   begin
    for j:=1 to n do
    if a[j]='1' then
    begin
     if (s-j) mod (n+1)=0 then
     begin
      a[j]:='0';
      for j:=1 to n do write(a[j]);
      writeln;
      break;
     end;
    end;
   end;
  end else
  if top=n-1 then
  begin
   a[0]:=' ';
   oo:=0;
   for j:=0 to n-1 do
   begin
    if a[j]='1' then inc(oo);
    if (s+one-oo) mod (n+1)=0 then
    begin
     for k:=1 to j do write(a[k]);
     write('0');
     for k:=j+1 to top do write(a[k]);
     writeln;
     break;
    end else
    if (s+one-oo+j+1) mod (n+1)=0 then
    begin
     for k:=1 to j do write(a[k]);
     write('1');
     for k:=j+1 to top do write(a[k]);
     writeln;
     break;
    end;
   end;
  end else
  begin
   oo:=0;
   for j:=1 to n+1 do
   begin
    if a[j]='0' then
    begin
     if (s-one+oo) mod (n+1)=0 then
     begin
      for k:=1 to j-1 do write(a[k]);
      for k:=j+1 to n+1 do write(a[k]);
      writeln;
      break;
     end;
    end else
    if a[j]='1' then
    begin
     if (s-one+oo-j) mod (n+1)=0 then
     begin
      for k:=1 to j-1 do write(a[k]);
      for k:=j+1 to n+1 do write(a[k]);
      writeln;
      break;
     end;
    end;
   if a[j]='1' then inc(oo);
   end;
  end;
  readln;
 end;
end.