[Пересланное сообщение]
  Ivan Bazanov, 29 октября в 10:15
  uses CRT;



  function F(i:integer):string; // preobrazovanie v dvoichniy kod i perevorot stroki
   var
   s:string;
   c:char;
   j,k:integer;
   begin
   while (i<>0) do
   begin
   s:=s+IntToStr(i mod 2);
   i:=i div 2;
   end;
   j:=length(s)div 2;
   for k := 1 to j do begin
   c := s[k];
   s[k] := s[length(s)-k+1];
   s[length(s)-k+1] := c;
   end;
   F:=s;
   end;


  function F2(s:string; i:integer):string;//dobovlenie nuley
  var
   j:integer;
  begin
   if length(s)<i then
   begin
   for j:=length(s) to i-1 do
   Insert('0',s,1);
   end;
   F2:=s;
  end;

  procedure F3(s:string); // samiy chastiy simvol
  var
   s1,s2:string;
   i,k,mx:integer;
   c:char;
  begin
  s1:=s;
  mx:=0;
  for i:=1 to length(s) do
   begin
   k:=0;
   while pos(s[i],s1)>0 do
   begin
   k:=k+1;
   delete(s1,pos(s[i],s1),1);
   end;
   if k>mx then
   begin
   mx:=k;
   c:=s[i];
   end;
   end;
   writeln('Самый частый символ:' ,c ,' Встретился раз: ',mx);

  end;

  var //main()
   a:array of string;
   str,org:string;
   i,j,K:int64;


  begin

   writeln('Введите строку : ');
   readln(str);
   org:='';
   for i:=1 to length(str) do
   if (pos(str[i],org)=0) then org:=org+str[i];
   if (ln(length(org))/ln(2)) = int((ln(length(org))/ln(2))) then k:=trunc(ln(length(org))/ln(2)) else k:=trunc(ln(length(org))/ln(2))+1;
   ClrScr;
   writeln('Всего различных символов:', length(org));
   writeln('Размер алфавита:', k);
   setlength(a,length(org));
   for i:=0 to length(org)-1 do
   begin;
   a[i]:=F(i);
   a[i]:=F2(a[i],k);
   end;
   writeln('Таблица кодов каждого элемента: ' );
   for i:=1 to length(org)do
   begin
   writeln(org[i],'= ',a[i-1]);
   end;



   writeln('Исходная строка: ',str);
   write('Исходный код строки:');
   for i:=1 to length(str) do
   begin
   for j:=1 to length(org) do
   begin
   if str[i]=org[j] then write(a[j-1],' ');
   end;
   end;
   writeln();
   F3(str);
  end.