Вот попробуй, это отнюдь не самый лучший вариант:
Код
Program DeleteOfficialSymbols;
Uses
Crt;
Const
S:String = 'affffb&&&cdefg ..//hheudsloi--((**jksla8ew%%';
Var
l:Byte;
Begin
ClrScr;
Randomize;
For l:=2 to Length(S)-1 do
If (S[l]=S[l+1]) or (S[l-1]=S[l]) then
Case Ord(S[l]) of
1..47,58..64,91..96,123..127,176..223,240..254:S[l]:=#255;
end;
While Pos(#255,S)<>0 do Delete(S,Pos(#255,S),1);
WriteLn(S);
End.