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で文字列を切り出さずに済みます。
※以前置換対象文字列の位置を配列に持って更に高速化を狙ったコードを書いたのですが、その後このコードでは正しい置換が行われないことが判明しました。
2020-08-30:掲示板からの指摘により残りの対象文字列の長さが1文字の時に取りこぼしてしまう不具合を修正。
2017-02-16:更に高速版が正しい動作をしていなかったのでコメントアウト。
2017-01-20:範囲外エラーへ対処。
2011-11-21: