Delphi 2010中使用TPerlRegEx ReplaceAll出现非预期结果

问题重现 #

使用TPerlRegEx的ReplaceAll方法处理带^行首锚点的正则时，若替换为空字符串，会出现重复匹配替换的异常：

var
  lpReg: TPerlRegEx;
begin
  lpReg := TPerlRegEx.Create;
  try
    lpReg.Options := lpReg.Options + [preCaseLess];
    lpReg.Subject := 'aabb';
    lpReg.RegEx := '^a';
    lpReg.Replacement := '';
    lpReg.ReplaceAll;
    Result := string(lpReg.Subject);
  finally
    lpReg.Free;
  end;
end;

预期结果为'abb'，实际得到'bb'——ReplaceAll替换了所有开头的a而非仅第一个。

需求要求实现通用替换逻辑：

• 示例1：模式'a'，目标字符串'aabbaaba'，替换为空，需得到'bbb'（全局替换）
• 示例2：模式'^a'，目标字符串'aabb'，替换为空，需得到'abb'（仅替换行首第一个匹配）

原因分析 #

查看ReplaceAll源码可知，其通过循环调用Match、Replace和MatchAgain实现全局替换：

function TPerlRegEx.ReplaceAll: Boolean;
begin
  if Match then begin
    Result := True;
    repeat
      Replace
    until not MatchAgain;
  end
  else Result := False;
end;

当替换为空字符串且正则带^锚点时，每次替换后匹配位置仍停留在字符串开头，导致MatchAgain会重复匹配行首的新字符（原第二个a变成新的行首），最终所有开头的a都被替换。

解决方案 #

方案1：自定义智能替换函数 #

编写一个函数自动判断正则是否包含单行模式下的行首锚点，按需执行单次或全局替换：

procedure SmartReplaceAll(lpReg: TPerlRegEx);
var
  HasSingleLineStartAnchor: Boolean;
  Pattern: string;
  i: Integer;
begin
  HasSingleLineStartAnchor := False;
  Pattern := lpReg.RegEx;
  i := 1;

  // 仅在非多行模式下判断行首锚点
  if not (preMultiLine in lpReg.Options) then
  begin
    while i <= Length(Pattern) do
    begin
      if Pattern[i] = '^' then
      begin
        // 排除字符集中的^（如[^abc]）
        if (i = 1) or (Pattern[i-1] <> '[') then
        begin
          HasSingleLineStartAnchor := True;
          Break;
        end;
      end;
      Inc(i);
    end;
  end;

  if HasSingleLineStartAnchor then
  begin
    // 行首锚点，仅替换一次
    if lpReg.Match then
      lpReg.Replace;
  end
  else
  begin
    // 无行首锚点，执行全局替换
    lpReg.ReplaceAll;
  end;
end;

使用时将原代码中的lpReg.ReplaceAll替换为SmartReplaceAll(lpReg)即可。

方案2：继承重写ReplaceAll方法 #

创建TPerlRegEx的子类，重写ReplaceAll方法实现智能替换逻辑：

type
  TSmartPerlRegEx = class(TPerlRegEx)
  public
    function ReplaceAll: Boolean; override;
  end;

function TSmartPerlRegEx.ReplaceAll: Boolean;
var
  HasSingleLineStartAnchor: Boolean;
  Pattern: string;
  i: Integer;
begin
  HasSingleLineStartAnchor := False;
  Pattern := Self.RegEx;
  i := 1;

  if not (preMultiLine in Self.Options) then
  begin
    while i <= Length(Pattern) do
    begin
      if Pattern[i] = '^' then
      begin
        if (i = 1) or (Pattern[i-1] <> '[') then
        begin
          HasSingleLineStartAnchor := True;
          Break;
        end;
      end;
      Inc(i);
    end;
  end;

  if HasSingleLineStartAnchor then
  begin
    Result := Self.Match;
    if Result then
      Self.Replace;
  end
  else
  begin
    // 调用父类原全局替换逻辑
    Result := inherited ReplaceAll;
  end;
end;

后续直接使用TSmartPerlRegEx替代TPerlRegEx即可，无需修改原有调用逻辑。

注意事项 #

• 若开启preMultiLine多行模式，^会匹配每行开头，此时仍会执行全局替换，符合正则语义
• 函数已排除字符集中的^（如[^a-z]），避免误判

内容的提问来源于stack exchange，提问作者Venture