codage decodage

program codibb;
uses WinCrt ;
Var
 a,b,c,d,e,n : Integer;
 ch,cc,hc : string ;

 Procedure cod(var n : integer );
  var
     a,b,c,d,e : integer;
     ch,cc : string;
    begin
     write('ekteb 3dad : ');
      readln(n);
        ch:='';
        Repeat
         str(n mod 2 , cc );
         ch:=cc+ch;
         n := n div 2 ;
        until n = 0 ;
        Writeln(ch);
    end;
    Procedure deco(var ch :string);
     var
      a,b,c,d,e,n : Integer;
        cc: string ;
     begin
      repeat
         b:=0;
         write('ekteb code binaire : ');
          readln(ch);
         for a:=1 to Length(ch)do
          if (ch[a] <>'0') and (ch[a] <> '1') then
             b:=b+1;
        Until b = 0 ;
        b:=1;
        n:=0;
        for a:= Length(ch) DownTo 1 do
         begin
          if ch[a] = '1' then
             n := n+b;

          b := b*2 ;
         end;

         writeln(n);
     End;
     procedure chex(var n : integer);
       var
         a,b,c,d,e : Integer;
         cc,ch,hc: String;
        begin
        // decimale -> binaire
           write('ekteb 3dad : ');
              readln(n);
                ch:='';
                Repeat
                 str(n mod 2 , cc );
                 ch:=cc+ch;
                 n := n div 2 ;
                until n = 0 ;
                writeln(ch);
        // tawa el hexadecimal part
         hc:='';
         for e:=1 to Length(ch) div 4 + 1 do
          begin
                 cc:= copy(ch,Length(ch)-3,4);
                 Delete(ch,Length(ch)-3,4);
                 b:=1;
                 n:=0;
                 for a:=Length(cc) DownTo 1 do
                  begin
                     if cc[a]='1' then
                      n:= n+b;
                     b := b*2;
                    end;
                    if n >= 10 then
                     hc:= chr(n+55) + hc
                    Else
                     begin
                      str(n,cc);
                      hc:=cc+hc;
                     end;
          End;
     write(hc);
        end;
        Procedure dhex(var ch : string);
            var
             a,b,c,d,e,n : Integer;
             cc,hc: String;
                begin
                 repeat
             b:=0;
             write('ekteb code binaire : ');
              readln(ch);
             for a:=1 to Length(ch)do
              if (ch[a] <>'0') and (ch[a] <> '1') then
                 b:=b+1;
            Until b = 0 ;
             hc:='';
             for e:=1 to (Length(ch) div 4) + 1 do
              begin
                     cc:= copy(ch,Length(ch)-3,4);
                     Delete(ch,Length(ch)-3,4);
                     b:=1;
                     n:=0;
                     for a:=Length(cc) DownTo 1 do
                      begin
                         if cc[a]='1' then
                          n:= n+b;
                         b := b*2;
                        end;
                        if n >= 10 then
                         hc:= chr(n+55) + hc
                        Else
                         begin
                          str(n,cc);
                          hc:=cc+hc;
                         end;
              End;
         write(hc);
            end ;
             procedure indhex(var hc : string);
                var
                    a,b,c,d,e,n : Integer;
                  cc,ch: String;

                begin
            repeat
                        b:=0;
                    Write('ekteb code Hexadecimal : ');
                        readln(hc);
                        for a:= 1 to Length(hc) do
                         if not(hc[a] in ['1'..'9']) and not (Upcase(hc[a]) in ['A'..'F']) then
                            b:=b+1
                          Else
                              hc[a]:=Upcase(hc[a]);
          Until b=0;

                     ch:='';
                     c:=0;
                     cc:='';
                    for a:=1 to Length(hc) do
                     if hc[a] in ['1'..'9'] then
                        begin
                         val(hc[a],c,e);
                         b:=8 ;
                          for e:=1 to 4 Do
                            Begin
                            if c>= b then
                                 begin
                                     c:=c-b;
                                     ch:= ch+'1' ;
                                 end
                                Else
                                 ch:= ch+'0';

                                b:=b div 2 ;
                            end;
                            ch:=ch+'  ';
                        end

                     Else

                        begin
                             n := ord(hc[a])-55;
                             b:=8;
                             for e:=1 to 4 Do
                                Begin
                                if n>= b then
                                     begin
                                        ch:= ch+'1';
                                        n:=n-b;
                                     end

                                    Else
                                     ch:= ch+'0';

                                    b:=b div 2 ;
                                end;

                            ch:= ch+'  ';
                        end;

                        writeln('ch  ',ch);
                end;
                procedure inchex(var hc : string);
                var
                    a,b,c,d,e,n : Integer;
                  cc,ch: String;

                begin

                    repeat
                        b:=0;
                    Write('ekteb code Hexadecimal : ');
                        readln(hc);
                        for a:= 1 to Length(hc) do
                         if not(hc[a] in ['1'..'9']) and not (Upcase(hc[a]) in ['A'..'F']) then
                            b:=b+1
                          Else
                              hc[a]:=Upcase(hc[a]);

                    Until b=0;

                     ch:='';
                     c:=0;
                     cc:='';
                    for a:=1 to Length(hc) do
                     if hc[a] in ['1'..'9'] then
                        begin
                         val(hc[a],c,e);
                         b:=8 ;
                          for e:=1 to 4 Do
                            Begin
                            if c>= b then
                                 begin
                                     c:=c-b;
                                     ch:= ch+'1' ;
                                 end
                                Else
                                 ch:= ch+'0';

                                b:=b div 2 ;
                            end;
                        end

                     Else

                        begin
                             n := ord(hc[a])-55;
                             b:=8;
                             for e:=1 to 4 Do
                                Begin
                                if n>= b then
                                     begin
                                        ch:= ch+'1';
                                        n:=n-b;
                                     end

                                    Else
                                     ch:= ch+'0';

                                    b:=b div 2 ;
                                end;
                        end;

                        b:=1;
                        n:=0;
                        for a:= Length(ch) DownTo 1 do
                         begin
                          if ch[a] = '1' then
                             n := n+b;

                          b := b*2 ;
                         end;

                         writeln(n);
end;



begin

 Repeat
  ClrScr;
    write('type of input "2" for binary / "10" for decimal / "16" for Hexadecimal : ');
     Readln(e);
 Until (e = 2) or (e= 10 )or (e = 16);
     if e = 2 then
      begin
           Repeat
                  ClrScr;
                    Write('type of result "10" for decimal / "16" for hexadecimal : ');
                     Readln(b);
             Until (b = 16) or (b= 10 );
             if b=10 then
              deco(ch)
             Else
              dhex(ch);
        End
    Else
        if e = 10    then
         begin
              Repeat
                  ClrScr;
                    Write('type of result "2" for binary / "16" for hexadecimal : ');
                     Readln(b);
              Until (b = 16) or (b= 2 );
                if b = 2 then
                 cod(n)
                else
                 chex(n);
         end
    Else
         begin
              Repeat
                  ClrScr;
                    Write('type of result "2" for binary / "10" for decimal : ');
                     Readln(b);
              Until (b = 10) or (b= 2 );
                if b = 2 then
                 indhex(hc)
                else
                 inchex(hc);
         end



End.