Как удалить лишние пробелы

uses crt;
 var a:array [1..20] of string[100];
     i,j,k,n,p:integer;
     mn:set of char;
     s,t,s2,s1:string;
 BEGIN
clrscr;
writeln('vvedi text');
readln(s);
mn:=['.',' ','?','!',','];
n:=0;
s2:='';
for i:=1 to length(s) do
 begin if not (s[i] in mn)  then
     begin  t:=t+s[i];
        if i=length(s) then
        begin inc(n);
        a[n]:=t;
        end;
        end
         else begin inc(n);
                    a[n]:=t;
                    t:='';
                   end;
      end;
      for i:=1 to n do
 begin if a[i]<>a[n] then
       begin for j:=1 to length(a[i])-1 do
 
                 for k:=j+1 to length(a[i]) do
                     if (a[i,j]<>a[i,k]) and (p=0) then p:=0 else p:=1;
                     if p=0 then s2:=s2+' '+a[i];
       end;
       p:=0;
 
 end;
 
 writeln('preobrazovanyu text:');
 writeln(s2);
 readkey;
 
END.

For i:=Length(s) downto 2 do
 if (s[i]=' ')and(s[i-1]=' ') then Delete(s,i,1);

else begin
  inc(n);
  a[n]:=t;
  t:='';
end;

else if t <> '' then begin
  inc(n);
  a[n]:=t;
  t:='';
end;

mn:=['.',' ',#9,'?','!',','];