j := 0;
k := 0;
{
c := #0;
}
for i = BeginPos to EndPos do begin
if Sour[i] in CKeepChars then begin
Dest[j] := Sour[i];
Inc(j);
k := 0;
{
c := #0;
}
end else begin
{
if c <> sour[i] then begin
k = 0;
c := sour[i];
end;
}
if k = 0 then begin
Dest[j] := Sour[i];
Inc(j);
end else
Inc(k);
end;
end;

未调试、未编译，后果自负。