替换HTML字符串中的字符 - 除标签外

Question

我需要遍历一个HTML字符串，并将除标签、空格和换行符之外的字符替换为0（零）。我创建了下面的代码，但它运行得太慢了。请问有人能帮我优化一下吗？

procedure TForm1.btn1Click(Sender: TObject);
var
  Txt: String;
  Idx: Integer;
  Tag: Boolean;
begin
  Tag := False;
  Txt := mem1.Text;
  For Idx := 0 to Length(Txt) - 1 Do
  Begin
    If (Txt[Idx] = '<') Then
      Tag := True Else
    If (Txt[Idx] = '>') Then
    Begin
      Tag := False;
      Continue;
    end;
    If Tag Then Continue;
    If (not (Txt[Idx] in [#10, #13, #32])) Then
      Txt[Idx] := '0';
  end;
  mem2.Text := Txt;
end;

HTML文本中永远不会在标签外部（即文本中间）出现"<"或">"，因此我不需要担心这个问题。

谢谢！

- Guybrush

---

你能提供一个所需输入和输出的例子吗？ - MBo

这段代码将无法处理有效的HTML。你不能以这种方式强大地解析HTML。 - David Heffernan

定义太慢了。在我看来，它似乎会运行得非常快 - 它只是一个循环。 - Rob

你正在从零开始索引字符串。除非你有一个带有编译器指令 {$ZEROBASEDSTRINGS ON} 的 Delphi 版本，否则这将导致错误。 - LU RD

Answer 1

看起来很简单。如果没有针对您正在使用的数据进行编程剖析（这总是一个好主意;如果您需要优化Delphi代码，请先通过Sampling Profiler运行它，以便了解实际花费时间的地方），很难确定，但是如果我必须做一个有根据的猜测，我会猜测您的瓶颈在这一行中：

Txt[Idx] := '0';

作为编译器对字符串类型安全写时复制语义的保证的一部分，对字符串中单个元素（字符）进行的每次写操作都涉及到对UniqueString例程的隐藏调用。这确保您不会更改其他地方某个东西持有引用的字符串。

在这种特殊情况下，这是不必要的，因为您在此例程的开始处获得了新的字符串，并且知道它是唯一的。如果小心，有一个解决方法。

明确而明确的警告：在确保拥有唯一字符串之前，请勿执行我即将解释的操作！最简单的方法是手动调用UniqueString。此外，在循环期间不要执行任何可能将此字符串分配给任何其他变量的操作。在我们这样做时，它不被视为普通字符串。不遵守此警告可能会导致数据损坏。

好了，现在已经解释清楚了，您可以使用指针直接访问字符串的字符并绕过编译器的保护，如下所示：

procedure TForm1.btn1Click(Sender: TObject);
var
  Txt: String;
  Idx: Integer;
  Tag: Boolean;
  current: PChar; //pointer to a character
begin
  Tag := False;
  Txt := mem1.Text;
  UniqueString(txt); //very important
  if length(txt) = 0 then
    Exit; //If you don't check this, the next line will raise an AV on a blank string
  current := @txt[1];
  dec(current); //you need to start before element 1, but the compiler won't let you
                //assign to element 0
  For Idx := 0 to Length(Txt) - 1 Do
  Begin
    inc(current); //put this at the top of the loop, to handle Continue cases correctly
    If (current^ = '<') Then
      Tag := True Else
    If (current^ = '>') Then
    Begin
      Tag := False;
      Continue;
    end;
    If Tag Then Continue;
    If (not (current^ in [#10, #13, #32])) Then
      current^ := '0';
  end;
  mem2.Text := Txt;
end;

这改变了比喻。我们不再将字符串视为数组进行索引，而是像磁带一样处理它，使用指针作为头部，每次向前移动一个字符，从头到尾扫描，并在适当时更改其下的字符。没有冗余的UniqueString调用，也没有重复计算偏移量，这意味着这种方法可以更快速地完成。 当使用指针时，请非常小心。编译器的安全检查是有充分理由的，而使用指针则超出了这些范畴。但有时，它们确实可以加速您的代码。再次强调，在尝试此类操作之前，请先进行性能分析。确保您知道哪些因素导致了速度下降，而不是仅凭想象。如果发现其他因素导致了速度下降，请不要使用此方法；相反，请找到解决真正问题的方法。

- Mason Wheeler

---

谢谢！我会进行测试并告诉您结果。 - Guybrush

@Mason，你真的认为这会对性能产生可衡量的影响吗？我必须承认，当考虑到相对于循环的其余部分时，“UniqueString”所需的成本足够大，以至于会感到惊讶。 - David Heffernan

@David：循环本身非常简单，成本微不足道。您能看到任何其他可能成为性能瓶颈的地方吗？ - Mason Wheeler

@MasonWheeler请检查我的编辑答案 - 看起来它并不是UniqueString。 - Blorgbeard

@Blorgbeard：好发现。我在脑海中写下了所有内容，实际上并没有测试它。现在已经修复了。 - Mason Wheeler

Answer 2

编辑：看起来我错了——UniqueString不是问题所在。实际瓶颈似乎是通过字符访问字符串。鉴于我的整个答案都不相关，我已经完全替换了它。

如果您使用PChar来避免重新计算字符串偏移量，同时仍通过Txt[Idx]更新字符串，则该方法速度更快（在我的1000次测试中，时间从5秒缩短到0.5秒）。

这是我的版本：

procedure TForm1.btn1Click(Sender: TObject);
var
  Idx: Integer;
  Tag: Boolean;
  p : PChar;
  Txt : string;
begin
  Tag := False;
  Txt := Mem1.Text;
  p := PChar(txt);
  Dec(p);
  For Idx := 0 to Length(Txt) - 1 Do
  Begin
    Inc(p);
    If (not Tag and (p^ = '<')) Then begin
      Tag := True;
      Continue;
    end
    Else If (Tag and (p^ = '>')) Then
    Begin
      Tag := False;
      Continue;
    end;
    If Tag Then Continue;
    If (not (p^ in [#10, #13, #32])) Then begin
      Txt[Idx] := '0';
    end;
  end;
  mem2.Text := Txt;
end;

- Blorgbeard

---

“写时复制语义”并不意味着每次更改内容都会复制整个内容；它意味着外部行为将与复制整个内容时看到的相同。正如Barry Kelly在链接问题的答案中所写，这是为了确保“不会影响到对同一字符串的其他引用。”这并不意味着总是会进行复制，只是在必要时才会进行复制。但即使是检查也可能在紧密循环中具有昂贵的代价。 - Mason Wheeler

@Blorgbeard，你的回答仍然包含错误的事实。你应该纠正它。 - David Heffernan

这意味着每次更改一个字符时，整个字符串可能都需要被复制。但是由于它的引用计数为1，所以它永远不会被复制。 - David Heffernan

@DavidHeffernan编辑 - 看起来你对UniqueString是正确的。 - Blorgbeard

使用 p^ := '0' 而不是 Txt[Idx] := '0' - David Heffernan

Answer 3

我进行了一些分析，并得出了这个解决方案。

• 使用测试> #32替代[#10，#13，#32]可以提高一些速度（感谢@DavidHeffernan）。
• 循环中更好的逻辑也能稍微提高一点速度。
• 使用PChar独占访问字符串更有效。

---

procedure TransformHTML( var Txt : String);
var
  IterCnt : Integer;
  PTxt    : PChar;
  tag     : Boolean;
begin
  PTxt := PChar(Txt);
  Dec(PTxt);
  tag := false;
  for IterCnt := 0 to Length(Txt)-1 do
  begin
    Inc(PTxt);
    if (PTxt^ = '<') then
      tag := true
    else
    if (PTxt^ = '>') then
      tag := false
    else
    if (not tag) and (PTxt^ > #32) then
      PTxt^ := '0';
  end;
end;

这个解决方案比Mason的解决方案有效率提高了30％，比Blorgbeard的有效率提高了2.5倍。

- LU RD