Var Text                : Array[1..10001] of Char;
    Long                : Integer;
    D1,D2               : Integer;
    Now                 : Integer;

Procedure Init;
Var S     : String;
    i     : Integer;
Begin
  Long := 0;
  Repeat
    Readln(S);
    For i := 1 to Length(S) do
      If S[i]<>#0 then
        Text[Long+i] := S[i];
    Inc(Long,Length(S));
  Until S='';
End;

Procedure Main;
Var i,j : Integer;
      P : Integer;
Begin
  P := 0;
  Now := 0;
  Repeat
    Inc(P);
    If Text[P]+Text[P+1]='(*' then
      Begin
        Inc(D1);
        Now := 2;
        Inc(P);
        Continue;
      End;
    If Now=2 then
      If Text[P]+Text[P+1]='*)' then
        Begin
          Dec(D1);
          If D1=0 then
            Begin
              If D2<>0 then Now := 1
                       else Now := 0;
            End;
          Inc(P);
          Continue;
        End;
    If Now<2 then
      Begin
        If Text[P]='(' then
          Begin
            Inc(D2);
            Now := 1;
            Continue;
          End;
        If Text[P]=')' then
          Begin
            Dec(D2);
            If D2=0 then Now := 0;
            Continue;
          End;
      End;
      If Now=1 then
        If Not(Text[P] in ['(',')','0'..'9','+','-
','*','/','=']) then
          Begin
            Writeln('No');
            Halt;
          End;
    If Now=0 then
      If Text[P]=')' then
        Begin
          Writeln('No');
          Exit;
        End;
  Until P=Long;
  If (D1<>0) or (D2<>0) then
    Begin
      Writeln('No');
      Exit;
    End;
  Writeln('Yes');
End;

Begin
  Init;
  Main;
End.

The first false of your program is : if the text is correct
D++ then you should write "YES", not "Yes" or "NO", not
"No" !
Hope you will get acc !
71222119
mailto : trungduck@yahoo.com

> Var Text                : Array[1..10001] of Char;
>     Long                : Integer;
>     D1,D2               : Integer;
>     Now                 : Integer;
>
> Procedure Init;
> Var S     : String;
>     i     : Integer;
> Begin
>   Long := 0;
>   Repeat
>     Readln(S);
>     For i := 1 to Length(S) do
>       If S[i]<>#0 then
>         Text[Long+i] := S[i];
>     Inc(Long,Length(S));
>   Until S='';
> End;
>
> Procedure Main;
> Var i,j : Integer;
>       P : Integer;
> Begin
>   P := 0;
>   Now := 0;
>   Repeat
>     Inc(P);
>     If Text[P]+Text[P+1]='(*' then
>       Begin
>         Inc(D1);
>         Now := 2;
>         Inc(P);
>         Continue;
>       End;
>     If Now=2 then
>       If Text[P]+Text[P+1]='*)' then
>         Begin
>           Dec(D1);
>           If D1=0 then
>             Begin
>               If D2<>0 then Now := 1
>                        else Now := 0;
>             End;
>           Inc(P);
>           Continue;
>         End;
>     If Now<2 then
>       Begin
>         If Text[P]='(' then
>           Begin
>             Inc(D2);
>             Now := 1;
>             Continue;
>           End;
>         If Text[P]=')' then
>           Begin
>             Dec(D2);
>             If D2=0 then Now := 0;
>             Continue;
>           End;
>       End;
>       If Now=1 then
>         If Not(Text[P] in ['(',')','0'..'9','+','-
> ','*','/','=']) then
>           Begin
>             Writeln('No');
>             Halt;
>           End;
>     If Now=0 then
>       If Text[P]=')' then
>         Begin
>           Writeln('No');
>           Exit;
>         End;
>   Until P=Long;
>   If (D1<>0) or (D2<>0) then
>     Begin
>       Writeln('No');
>       Exit;
>     End;
>   Writeln('Yes');
> End;
>
> Begin
>   Init;
>   Main;
> End.