function encode(s:string):string;//функция архивации
var i,j:integer;
    k:string;
begin
  i:=1;
  while i <= length(s) do
  begin
    j:=i;
    while (s[i] = s[j+1]) do
    inc(j);
    if (j-i = 0) or (j-i = 1) or (j-i =2) then
    begin
      k := k + s[i];
      if (s[i]='0') then k:=k+'0';
      inc(i)
    end
    else
    begin
      k:= k + inttostr(j-i+1) + s[i];
      inc(i,j-i+1)
    end;
  end;
  result:= k;
end;
//--------------------------------------
function decode(s:string):string;//функция разархивации
var i,j,c:integer;
    k:string;
    m: string;
begin
  i:=1;
  while i <= length(s) do
  begin
    j:=i;
    while s[j] in ['0'..'9'] do
    inc(j);
    if j-i > 0 then
    begin
      m:= copy(s,i,j-i);
      for c:=1 to strtoint(m) do k:= k+ s[j];
      delete(s,i,j-i+1);
    end
    else
    begin
      k:= k+ s[i];
      inc(i);
    end;
  end;
  result:= k;
end;
begin
  Writeln('Введите текст для архивации');
  read(m);
  writeln(encode(m));
  writeln(decode(m));
  Readln;
end.

var file_name,file_name1,k,s,file_name2,m,b,c:string;
    i,q,j,size1,size2:Integer;
    t,t1,t2:TextFile;
begin

//----------------------------------
  Writeln('Введите имя исходного файла:');
  Readln(file_name);
  file_name:=file_name+'.txt';
  AssignFile(t,file_name);
  Reset(t);
  while not Eof(t)do
   begin
     read(t,s);
     Writeln(s);
     i:=1;
     k:='';
     while i < length(s) do
      begin
        j:=i;
        while (s[i] = s[j+1]) do
         inc(j);
         if (j-i = 0) or (j-i = 1) or (j-i =2) then
          begin
            k := k + s[i];
            if (s[i]='0') then k:=k+'0';
            inc(i)
          end
         else
          begin
            k:= k + inttostr(j-i+1) + s[i];
            inc(i,j-i+1)
          end;
      end;
   end;
   str(FileSize(File_in),size);

  CloseFile(t);
//-----------------------------------
  Writeln('Введите имя заархивированного файла:');
  Readln(file_name1);
  file_name1:=file_name1+'.txt';
  AssignFile(t1,file_name1);
  rewrite(t1);
  Writeln(t1,k);
  Reset(t1);
  while not Eof(t1)do
   begin
     read(t1,c);
     Writeln(c);
     i:=1;
     b:='';
     while i <length(c) do
      begin
        j:=i;
        while c[j] in ['0'..'9'] do
          inc(j);
          if j-i > 0 then
           begin
              m:= copy(c,i,j-i);
              for j:=1 to strtoint(m) do b:= b+ c[j];
              delete(c,i,j-i+1);
           end
          else
           begin
             b:= b+ s[i];
             inc(i);
           end;
      end;
      end;
  CloseFile(t1); 
  Writeln('Введите имя файла после распаковки:');
  Readln(file_name2);
  file_name2:=file_name2+'.txt';
  AssignFile(t2,file_name2);
  rewrite(t2);
  Writeln(t2,b);
  size3:=filesize(t2)
  CloseFile(t2);
  size2:=filesize(t1);
  CloseFile(t1);
//------------------------------------
  Writeln('размер исходного файла:',size1);
  Writeln('размер после архивации',size2);
  writeln('размер после распаковки',size3);
  readln
end.