Giải nén xâu trong pascal

program xau_thuan_nhat;
uses crt;
var s,ss,st,si:string; i,j,l:integer;
function kttn(s:string):boolean;
 var x:char; ok:boolean;
 begin
  kttn:=true;
  for i:=1 to length(s) do
  s[i]:=upcase(s[i]);
  for i:=1 to length(s) do
  begin
    ok:=false;
    for x:='A' to 'Z' do
    if s[i]=x then ok:=true;
    if not ok then begin kttn:=false;break;end;
  end;
 end;
procedure nen(s:string;var st:string);
 begin
  ss:='';
  while s<>'' do
  begin
    i:=1;
    while (s[i+1]=s[1])and(i<length(s)) do
    inc(i);
    if i>1 then
    begin
      str(i,si);
      ss:=ss+s[1]+si;
    end
    else ss:=ss+s[1];
    delete(s,1,i);
  end;

  s:=ss;l:=2;
  while l<length(s) do
  begin
    i:=1;
    while i<=length(s)-l do
    begin
      si:=copy(s,i,l);
      j:=i+l;
      ss:=copy(s,j,l);
      while ss=si do
      begin
        j:=j+l;
        ss:=copy(s,j,l);
      end;
      if j=i+l then inc(i)
      else
      begin
        str((j-i)div l,ss);
        delete(s,i,j-i);
        si:='('+si+')'+ss;
        insert(si,s,i);
        i:=i+l+2+length(ss);
      end;
    end;
    inc(l);
  end;
  st:=s;
 end;
function ktcd(st:string):boolean;
 begin
  ktcd:=false;
  for i:=1 to length(st) do
  if st[i]='(' then begin ktcd:=true; break; end;
 end;
procedure giainen(st:string;var s:string);
 var d,c:byte; code:integer;
 begin
  while ktcd(st) do
  begin
    i:=1; c:=0;
    while st[i]<>'(' do inc(i);
    d:=1; j:=i+1;
    while c<d do
    begin
      inc(j);
      if st[j]='(' then inc(d);
      if st[j]=')' then inc(c);
    end;
    si:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    delete(si,1,1);
    delete(si,length(si),1);
    j:=i;
    while st[j+1] in['0'..'9'] do inc(j);
    ss:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    val(ss,l,code);
    for j:=1 to l do
    insert(si,st,i);
  end;
  i:=1;
  while i<=length(st) do
  begin
    inc(i);
    if st[i] in['0'..'9'] then
    begin
      j:=i;
      while st[j+1] in['0'..'9'] do inc(j);
      ss:=copy(st,i,j-i+1);
      delete(st,i,j-i+1);
      val(ss,l,code);
      ss:=st[i-1];
      for j:=1 to l-1 do insert(ss,st,i);
      i:=i+l-1;
    end;
  end;

  s:=st;
 end;
begin
 clrscr;
 write('nhap chuoi: ');readln(s);
 if kttn(s) then
  begin
  nen(s,st);
  writeln('Chuoi sau khi nen la: ',st);
  giainen(st,s);
  writeln('Chuoi sau khi giai nen la: ',s);
  end
 else write('Xau ko thuan nhat.');
readln;
end.