Ошибка при переводе числа из десятичной в двоичную и при сложении двоичных чисел

const t=4;
type mas=array[1..t] of string[4];
procedure perevod(a:integer;var k:mas);
var i,n:integer;
    h:string;
begin
i:=4;
 while a<>0 do begin
       n:=a mod 10;
       a:=a div 10;
       case n of
       0:k[i]:='0000';
       1:k[i]:='0001';
       2:k[i]:='0010';
       3:k[i]:='0011';
       4:k[i]:='0100';
       5:k[i]:='0101';
       6:k[i]:='0110';
       7:k[i]:='0111';
       8:k[i]:='1000';
       9:k[i]:='1001';
       end;
       i:=i-1;
       end;
if  i<>0
then for n:=1 to i do
         k[n]:='0000';
end;
 
var a,i,b,carry:integer;
    k,k1,k2:mas;
    c,d,sr,z:string;
function BinAdd(c, d: string; var carry:integer): string;
var
  s,v,o,a: string;
  l, i,y,p,f: byte;
begin
  z:='0110';
  l:= 4;
  f:=f+1;
  s := '';
  o:=c;
  a:=d;
for i := l downto 1 do
    begin
    y := (ord(c[i]) - ord('0')) + (ord(d[i]) - ord('0')) + carry+p;
    carry := y div 2;
    y:= y mod 2;
    s := char(y + ord('0')) + s;
    p:=0;
    end;
  carry:=0;
  if (s>'1001') or ((o>='1000') and (a>='1000')) then begin
                    for i := 4 downto 1 do
                    begin
                    y := (ord(s[i]) - ord('0')) + (ord(z[i]) - ord('0')) + carry;
                    carry := y div 2;
                    y:= y mod 2;
                    v := char(y + ord('0')) + v;
                    end;
                    carry:=0;
                    p:=1;
                    BinAdd := v;
                    end
   else begin v:=s;
  BinAdd := v; end;
 if(f=4) and  (p=1) then writeln ('переполнение  в 5 тетраду')
end;
 
begin
writeln('Введите 2 числа');
readln(a,b);
if (a>9999) or (b>9999) then  writeln ('неправильно введено число. число должно быть 4-значным')  else  begin
perevod(a,k);
write(a,'=');
for i:=1 to t do
write(k[i],' ');
writeln;
perevod(b,k1);
write(b,'=');
for i:=1 to t do
write(k1[i],' ');
writeln;
carry := 0;
for i := 4 downto 1 do
  k2[i] := BinAdd(k[i], k1[i], carry);
writeln('результат сложения = ');
for i:=1 to t do
write(k2[i],' ');
end;
end.

Const
  Raz=2;  { Разрядность вычислений }
alphavit : array[0..35] of Char = ('0','1','2','3','4','5','6','7','8','9',
                                   'A','B','C','D','E','F','G','H','I','J',
                                   'K','L','M','N','O','P','Q','R','S','T',
                                   'U','V','W','X','Y','Z');
 
Function IntToN(A : Longint) : String;
Var
  S : String;
  n : Longint;
Begin
  S:=''; n:=A;
  While n>0 do
  Begin
    S:=Chr(48+(n mod Raz))+S;
    n:=n div Raz;
  End;
  IntToN:=S;
End;
 
Function k10(k : Byte) : Longint;
Begin
  If k>0 then k10:=10*k10(k-1)
  else k10:=1;
End;
 
Function NToInt(S : String) : Longint;
Begin
  If Length(S)>1 then
    NToInt:=CTN(S[1])*k10(Length(S)-1)+NToInt(Copy(S,2,Length(S)-1))
  else
    NToInt:=CTN(S[1]);
End;