Программа перевода из одной системы счисления в другую

program zadanie8;
uses crt;
const c : array [1..16] of char = ('0','1','2','3','4','5','6','7','8','9','A',
'B','C','D','E','F');
chara : array [1..16] of byte =(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
var s,sdo,spos:string;
    a,a2,i,b,dec,f,sa1: integer;
    mas : array [1..100]of integer;
    rrr,sa2:real;
procedure razdstr(s:string);
var l,k,i:integer;
    flag: boolean;
 begin
   sdo:='';
   spos:='';
   l:=length(s);
   flag:=false;
   for i:=1 to l do
   if s[i] in ['a'..'f']then
   s[i]:=upcase(s[i]);
   for i:=1 to l do
   if(s[i]='.')then flag:=true;
   if (flag = false)then s:=s+'.0';
   k:=pos('.',s);
  for i:=1 to k-1 do
     sdo:=sdo+s[i];
  for i:=k+1 to l do
     spos:=spos+s[i];
  end;
function pow(ar,k :integer):integer;
var i,res,b : integer;
 begin
   res :=1;
   if (k<0)then
   b:=round(1/ar);
   k:=abs(k);
   if k=0 then pow:=1;
   for i:=1 to k do
      res:=res*ar;
       pow:=res;
  end;
function sdoone(s:string;a:integer):integer;
var l,j,sum,k:integer;
    z:string;
    flag:boolean;
  begin
      if a in [2..16] then
      begin           z:='';
         l:=length(s);
         for i:=l downto 1 do
         z:=z+s[i];
         for i:=1 to l do
          if z[i] in ['0'..c[a]] then flag :=true;
         k:=l-1;sum:=0;
         for i:=1 to l do
         for j:=1 to 16 do
          if (z[i] = c[j])then
           begin
            sum:=sum+(chara[j]*pow(a,i-1));
            k:=k-1;
          end;end;
          if (flag = false)then
          begin
          writeln('error in notation');
          readln;
          halt(1);
          end;
    sdoone:=sum;
  end;
function sposone(s:string;a:integer):real;
         var k,x:real;
         p,i,n:integer;
         flag:boolean;
begin
           x:=0;
           p:=pos('.',s);
           if (p>0)then
    begin
      k:=a;
       for i:=p+1 to length(s) do
         begin
          if s[i] in ['0'..c[a]] then flag:=true;
          n:=ord(s[i]);
          if n>=ord('A')then n:=n-ord('A')+10
           else n:=n-ord('0');
           x:=x+n/k;
           k:=k*k;
         end;
    end;
    if(flag=false)then
    begin
          writeln('error in notation');
          readln;
          halt(1);
          end;
   sposone:=x;
end;
function two(dec,a:integer):string;
 var d,u:integer;
     rez:string;
     b:array [1..30]of byte;
  begin
  u:=0; rez:='';d:=dec;
while d>0 do
  begin
    inc(u);
    b[u]:=d mod a;
    d:=d div a;
  end;
for i:=u downto 1 do
  rez:=rez+c[b[i]+1];
  two:=rez;
     end;
function spostwo(d:real;a:integer;spos:string):string;
 var  s:string;
      b:integer;
      z:real;
       begin
       s:='.';z:=d;
       while (length(s)-1<length(spos)) do
         begin
          z:=z*a;
          b:=trunc(z);
          s:=s+c[b+1];
          z:=z-b;
          end;
       spostwo:=s;
      end;
 
begin
clrscr;
writeln('enter cislo');
 readln(s);
writeln('enter osnovanie');
readln(a);
writeln('enter second notation');
readln(a2);
razdstr(s);
dec:=sdoone(sdo,a);
rrr:=sposone(s,a);
writeln('in ',a2);
writeln('result ',two(dec,a2),spostwo(rrr,a2,spos));
readln;
end.