Stringverarbeitung - Leerzeichen reduzieren

[Sir Rufo]

Hab ich mal gemacht ...

Delphi-Quellcode:

function DeleteBlanksFromStr1( const AString : string ) : string;

  function DeleteBlanks(AStr: string): string; 
  var i, 
    LIndex, 
    LCount: Integer; 
    LStr,
    LString: string; 
  begin 
    //prüfen ob innerhalb des Strings noch zwei aufeinander folgende Leerzeichen sind, 
    //wenn keine vorhanden, keine weitere Verarbeitung nötig 
    result := AStr; 
    LIndex := Pos('  ', AStr); 
    if (LIndex > 0) then 
    begin 
      //falls den leerzeichen ein weiteres folgt prüfen, ob weitere folgen 
      i := LIndex + 2; 
      while (AStr[i] = ' ') do 
      begin 
        inc(i); 
      end; 

      //wenn i sich verändert hat, gab es weitere folgende leerzeichen 
          //if not (i = LIndex + 2) then   <- dies würde dazu führen, daß zwei leerzeichen hintereinander nicht
          //begin                             verarbeitet werden 
        LStr := Copy(AStr, 1 , LIndex); 

        LString := Copy(AStr, i, Length(AStr)); 
        result := LStr +  DeleteBlanks(LString); 
         //end; 
    end; 

  end; 

begin 
  //Leerzeichen ganz vor und ganz hinten streichen 
  result := Trim(AString); 

  //alle leerzeichen innerhalb des strings verarbeiten 
  result := DeleteBlanks(result); 
end;

function DeleteBlanksFromStr2( const AString : string ) : string;
Var
  i    : Integer;
  iLen : Integer;
  iPos : Integer;
  s    : String;
begin
  s      := Trim(AString);
  iPos   := Pos('  ',s);
  if iPos = 0 then begin
    Result := s;
    exit;
  end;
  iLen   := Length(s);
  Result := Copy(s,1,iPos - 1);
  for i := iPos to iLen do begin
    case s[i - 1] of
      ' ' : case s[i] of
             ' ' : ;
            else
              Result := Result + s[i];
            end;
    else
      Result := Result + s[i];
    end;
  end;
end;

function DeleteBlanksFromStr3( const AString : string ) : string;
begin 
  RESULT := AString;
  while Pos( '  ', RESULT ) > 0 do
    RESULT := {SysUtils.}StringReplace( RESULT, '  ', ' ', [ rfReplaceAll ] );
end;

function DeleteBlanksFromStr4( const AString : string ) : string;
var i,j: integer; 
begin 
  SetLength(Result,Length(AString));
  if Length(Result) > 0 then 
    begin 
      i := 1; 
      j := 1;
      while i <= Length(AString) do
        begin 
          Result[j] := AString[i];
          if (AString[i] = #32) then
            begin 
              while (i <= Length(AString)) and (AString[i] = #32) do
                inc(i); 
            end 
          else 
            inc(i); 
          inc(j); 
        end; 
      SetLength(Result,j); 
    end; 
end;

... und hier die Ergebnisse für jeweils 1.000.000 Durchläufe für den Text
"Peter und der Wolf" 1. ca. 3094 ms/1000
2. ca. 2900 ms/1000
3. ca. 1275 ms/1000 *** allerdings nur 10.000 Durchläufe ***
4. ca. 900 ms/1000

Ich sach ja schon nix mehr

cu

Oliver