I always get wa.
Could you help me?
Here is my program:

var n,aa,b,c,d:integer; s,s2:string; s1:string[1]; tt,tf:boolean;
t:text;
    a:array[1..200] of integer;
begin
  assign(t,''); reset(t);
  repeat
    readln(t,s);
    while s[length(s)]=' ' do delete(s,length(s),1);
    if s<>'#' then begin
      readln(t,n);
      tf:=true;
      if s[1]='-' then s1:='-' else s1:='';
      if s[1] in ['+','-'] then delete(s,1,1);
      fillchar(a,sizeof(a),0); aa:=0; b:=-1;
      while (s<>'')and(s[1] in ['0'..'9','.']) do begin
        if s[1]='.' then begin
          if b=-1 then b:=aa
            else begin tf:=false; break; end;
        end else begin
          inc(aa); a[aa]:=ord(s[1])-48;
        end;
        delete(s,1,1);
      end;
      if tf and ((s='')or(upcase(s[1])='E'))and(aa>0) then begin
        if b=-1 then b:=aa;
        if s<>'' then begin
          delete(s,1,1);
          if s[1]='-' then tt:=false else tt:=true;
          if s[1] in ['+','-'] then delete(s,1,1);
          if s<>'' then begin
            for c:=1 to length(s) do
              if not(s[c] in ['0'..'9']) then break;
            if s[c] in ['0'..'9'] then begin
              c:=0;
              while (s<>'')and(c<1000) do begin
                c:=c*10+ord(s[1])-48;
                delete(s,1,1);
              end;
              if tt then inc(b,c) else dec(b,c);
            end else tf:=false;
          end else tf:=false;
        end;
        if tf then begin
          s2:='';
          if b>0 then begin
            for d:=1 to b do if a[d]<>0 then break;
            for c:=d to b do s2:=s2+chr(a[c]+48);
            if n>0 then begin
              s2:=s2+'.';
              for c:=1 to n do
                if b+c<=aa then s2:=s2+chr(a[b+c]+48) else s2:=s2+'0';
            end;
          end else begin
            if n=0 then s2:='0' else s2:=s2+'0.';
            for c:=1 to n do
              if b+c>0 then s2:=s2+chr(a[b+c]+48) else s2:=s2+'0';
          end;
          for b:=1 to length(s2) do
            if s2[b] in ['1'..'9'] then break;
          if s2[b] in ['1'..'9'] then write(s1);
          for b:=1 to aa do if a[b] in [1..9] then break;
          if a[b] in [1..9] then write(s2) else write(0);
        end;
      end else tf:=false;
      if tf=false then write('Not a floating point number');
      writeln;
    end;
  until s='#';
  close(t);
end.

Thanks!

subj

Thank you.
But still wrong answer.:(
Here is the program:

var n,aa,b,c,d:integer; s,s2:string; s1:string[1]; tt,tf:boolean;
t:text;
    a:array[1..250] of integer;
begin
  assign(t,''); reset(t);
  repeat
    readln(t,s);
    while s[length(s)]=' ' do delete(s,length(s),1);
    if s<>'#' then begin
      readln(t,n);
      tf:=true;
      if s[1]='-' then s1:='-' else s1:='';
      if s[1] in ['+','-'] then delete(s,1,1);
      fillchar(a,sizeof(a),0); aa:=0; b:=-1;
      while (s<>'')and(s[1] in ['0'..'9','.']) do begin
        if s[1]='.' then begin
          if (b=-1)and(s[2] in ['0'..'9']) then b:=aa
            else begin tf:=false; break; end;
        end else begin
          inc(aa); a[aa]:=ord(s[1])-48;
        end;
        delete(s,1,1);
      end;
      if tf and ((s='')or(upcase(s[1])='E'))and(aa>0) then begin
        if b=-1 then b:=aa;
        if s<>'' then begin
          delete(s,1,1);
          if s[1]='-' then tt:=false else tt:=true;
          if s[1] in ['+','-'] then delete(s,1,1);
          if s<>'' then begin
            for c:=1 to length(s) do
              if not(s[c] in ['0'..'9']) then break;
            if s[c] in ['0'..'9'] then begin
              c:=0;
              while (s<>'')and(c<1000) do begin
                c:=c*10+ord(s[1])-48;
                delete(s,1,1);
              end;
              if tt then inc(b,c) else dec(b,c);
            end else tf:=false;
          end else tf:=false;
        end;
        if tf then begin
          s2:='';
          if b>0 then begin
            for d:=1 to b do if a[d]<>0 then break;
            for c:=d to b do s2:=s2+chr(a[c]+48);
            if n>0 then begin
              s2:=s2+'.';
              for c:=1 to n do
                if b+c<=aa then s2:=s2+chr(a[b+c]+48) else s2:=s2+'0';
            end;
          end else begin
            if n=0 then s2:='0' else s2:=s2+'0.';
            for c:=1 to n do
              if b+c>0 then s2:=s2+chr(a[b+c]+48) else s2:=s2+'0';
          end;
          for b:=1 to length(s2) do
            if s2[b] in ['1'..'9'] then break;
          if s2[b] in ['1'..'9'] then write(s1);
          write(s2);
        end;
      end else tf:=false;
      if tf=false then write('Not a floating point number');
      writeln;
    end;
  until s='#';
  close(t);
end.