ホーム >プログラム >Delphi 6 ローテクTips

Unicode対応StringReplace

Unicode対応のStringReplace関数。


ほぼオリジナル

function StringReplaceW(sSrc, sOld, sNew: WideString; bCaseSensitive: Boolean): WideString;
//StringReplaceのUnicode対応版。
var
  SearchStr, Patt, NewStr: WideString;
  Offset: Integer;
begin
  //ほぼSysUtilsのStringReplaceのまんま。
  if not(bCaseSensitive) then
  begin
    SearchStr := WideUpperCase(sSrc);
    Patt      := WideUpperCase(sOld);
  end else
  begin
    SearchStr := sSrc;
    Patt      := sOld;
  end;

  NewStr := sSrc;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := Pos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + sNew;
    NewStr := Copy(NewStr, Offset + Length(sOld), MaxInt);
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

オリジナルのStringReplaceのソースコードをコピーしてWideString向けに書き換えただけのものです。
ただしオリジナルと違い、全て置換することを目的にしているので引数に指定するのは大文字と小文字を区別するかの指定だけにしています。
bCaseSensitiveがTrueで大文字と小文字を区別します。

高速版

function gfnsStrReplaceW2(sSrc, sOld, sNew: WideString; const bCaseSensitive: Boolean): WideString;
{2008-12-07,2017-02-16,2020-08-30:
StringReplaceのUnicode対応の高速版。
bCaseSensitiveは大文字小文字の区別をするかしないか。Trueで区別する。
2017-02-16:再帰することで例えば置換後の文字列に置換対象文字列がある場合へ対処。
2020-08-30:残りの対象文字列の長さが1文字の時に取りこぼしてしまう不具合を修正(掲示板からの指摘)

}

  function _StrReplace(sSrc, sOld, sNew: WideString; const bCaseSensitive: Boolean): WideString;
  var
    li_Pos      : Integer;
    li_SrcIndex : Integer;
    li_ResIndex : Integer;
    ls_CmpSrc   : WideString;
    lp_Src      : PWideChar;
    lp_CmpSrc   : PWideChar;
    li_OldLen   : Integer;
    li_NewLen   : Integer;
    li_Count    : Integer;
    li_Len      : Integer;
  begin
    if (sSrc = '')
    or (sOld = '')
    then begin
      Result := sSrc;
  Exit;
    end;

    if not(bCaseSensitive)
    then begin
      ls_CmpSrc := WideUpperCase(sSrc);
    end else
    begin
      ls_CmpSrc := sSrc;
    end;

    li_OldLen   := Length(sOld);
    li_Count    := 0;
    li_SrcIndex := 0;
    repeat
      lp_CmpSrc := @PWideChar(ls_CmpSrc)[li_SrcIndex];
      li_Pos := Pos(sOld, WideString(lp_CmpSrc));
      if (li_Pos > 0)
      then begin
        //置換対象文字列があった。
        Inc(li_Count);
        li_SrcIndex := li_SrcIndex + li_Pos + li_OldLen -1;
      end;
    until (li_Pos = 0);

    if (li_Count <= 0)
    then begin
      Result := sSrc;
  Exit;
    end;

    try
      li_NewLen := Length(sNew);
      li_Len    := Length(sSrc) + (li_NewLen - li_OldLen) * li_Count;
      if (li_Len <= 0)
      then begin
        Result := '';
  Exit;
      end;
      SetLength(Result, li_Len);
      li_ResIndex := 1; //ResultはWideStringなので0ではなく1
      li_SrcIndex := 0; //lp_SrcはPWideCharなので0
      repeat
        lp_Src    := @PWideChar(sSrc)     [li_SrcIndex];
        lp_CmpSrc := @PWideChar(ls_CmpSrc)[li_SrcIndex];
        li_Pos := Pos(sOld, WideString(lp_CmpSrc));
        if (li_Pos > 0)
        then begin
          //置換対象文字列があった。
          lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, li_Pos);
          Inc(li_ResIndex, li_Pos - 1);
          if (li_NewLen > 0)
          then begin
            lstrcpynW(PWideChar(@Result[li_ResIndex]), PWideChar(sNew), li_NewLen +1);
            Inc(li_ResIndex, li_NewLen);
          end;
          li_SrcIndex := li_SrcIndex + li_Pos + li_OldLen -1;
        end else
        if (li_Len > li_ResIndex -1) //2020-08-30:残りの対象文字列の長さが1文字の時に取りこぼす不具合修正
        then begin
          //置換対象文字列がなかったので残りの文字列をコピーする。
          lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, Length(WideString(lp_Src)) +1); //末尾の#0分もいれるので+1
        end;
      until (li_Pos = 0);
    finally
      if not(bCaseSensitive)
      then begin
        ls_CmpSrc := WideUpperCase(Result);
      end else
      begin
        ls_CmpSrc := Result;
      end;

      if (Pos(sOld, ls_CmpSrc) > 0)
      then begin
        Result := _StrReplace(Result, sOld, sNew, bCaseSensitive);
      end;
    end;
  end;
begin
  if not(bCaseSensitive)
  then begin
    sOld := WideUpperCase(sOld);
  end;

  Result := _StrReplace(sSrc, sOld, sNew, bCaseSensitive);
end;

オリジナルでは文字列を置換するたびにResultに足しているのでメモリの再割り当てが発生して遅くなっています。
この高速版ではその点を改良しています。

オリジナルと違いループを二回行っています。
最初のループで必要なサイズを計算しSetLengthでResultに必要な長さをセットします。
その後二回目のループでlstrcpynW APIを使ってResultにコピーしていきます。

こうすることで約1.3倍速くなりました。
Posで文字列の途中から検索させるためにややこしいことをしていますがこうすることでいちいちCopyで文字列を切り出さずに済みます。

更に高速版はNG

※以前置換対象文字列の位置を配列に持って更に高速化を狙ったコードを書いたのですが、その後このコードでは正しい置換が行われないことが判明しました。


2020-08-30:掲示板からの指摘により残りの対象文字列の長さが1文字の時に取りこぼしてしまう不具合を修正。
2017-02-16:更に高速版が正しい動作をしていなかったのでコメントアウト。
2017-01-20:範囲外エラーへ対処。
2011-11-21: