Некорректный результат в файле при переводе из 8СС в 16СС - Free Pascal

program kurs_1;
uses
  crt;
const
d:array[0..15] of string=('0000','0001','0010','0011','0100','0101','0110','0111','1000','1001','1010','1011','1100','1101','1110','1111');
 c:array[0..15] of string=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
b:array[0..7] of string=('000','001','010','011','100','101','110','111');
var
  s,s2,s16,a,str1,dk:string;
  i,n,j,z,f:integer;
  s10,s8:longint;
  k:byte;
  f1,f2:text;
  b1:array of integer;
  r:longint;
 
procedure cod(s:string; a:string; var s2:string);
const
s0='00000001';
d8:array[0..7] of string = ('000','001','010','011','100','101','110','111');
var
ss,str1:string;
 x,k,c,i,r,z,f:integer;
f1,f2:text;
begin
 val(s,x);
if s[1]='-' then
begin z:=1; Delete(s,1,1) end
else z:=0; { знак }
s2:='';
 for k := 1 to length(s) do
 s2:=s2+d8[ord(s[ k])-48];
if z=0 then s2:='0'+s2
else begin
 for c :=length(s2) downto 1 do
 if s2[c]='1' then s2[c]:='0'
 else s2[c]:='1';
for i:=8 downto 1 do
begin
if s2[i] <>'0' then
s2[i]:='0'
else
begin
s2[i]:='1';
break
end;
end;
s2:='1'+s2;
end;
f:=Length(s2);
if f>7 then Delete(s,1, f-7)
else if f<7 then Insert(Copy('0000000',1,7-f),s2,1);
 
end;
 
procedure to16(s:string;var a:string; var s16:string);
var
i,j:integer;
 begin
   val(s,s8);
if s[1]='0' then
      begin
        a:='1';
        delete(s,1,1) end
    else a:='0';
  repeat
    i:=s8 mod 10 ;
    s2:=b[i]+s2;
    s8:=s8 div 10;
    until s8=0;
while length(s2)mod 4<>0 do
s2:='0'+s2;
    for i:=length(s2) downto 1 do
         if i mod 4=1 then
            begin
              a:=copy(s2,i,4);
              for j:=0 to 15 do
                 if d[j]=a then
                   s16:=c[j]+s16;
            end;
   end;
 
procedure to10(s:string;var a:string; var r:longint);
var
  i,f:integer;
begin
    if s[1]='-' then
      begin
        a:='-';
        delete(s,1,1)
      end
    else a:=''; 
  r:=0; f:=1;
  for i:=length(s) downto 1 do
    begin
      r:=r+f*(ord(s[i])-48);
      f:=f*8;
    end;
end;
 
procedure open;
begin
  assign(f1,'dano.txt');
  reset(f1);
  read(f1,str1);
  close(f1);
  assign(f2,'rezult.txt');
  rewrite(f2);
end;
BEGIN
clrscr;
open;
  for i:=1 to length(str1) do
    begin
     if str1[i]<>',' then s:=s+str1[i];
     if (i=length(str1)) or (str1[i]=',') then
       begin
         n:=0;
         repeat
         writeln('Vvedite 1-esli 10 CC,   2-esli 16 CC,   3-esli dop.kod,   4-sled chislo:',n);
         readln(n);
    case n of
   1: begin
      to10(s,a,r);
      write(f2,s,'=',a,r,' ')
      end;
   2: begin
      to16(s,a,s16);
      write(f2,s,'=',s16,' ')
      end;
   3: begin
      cod(s,a,s2);
      write(f2,s,'=',s2,' ')
      end;
   4: break
   end;
   until n=4;
   s:='';
   end;
   end;
   close(f2);
END.