delphi - 当控件的类名非常非常长时，为什么会出现访问冲突？

Question

我按顺序对控件进行了子类化，以便可以添加一些我需要的字段，但现在当我在运行时创建它时，我收到了访问冲突。不幸的是，这种访问冲突不会发生在我创建控件的地方，即使是我在启用所有调试选项(包括“使用调试 DCU 进行构建”)的情况下构建的控件，堆栈跟踪也根本无法帮助我!

在尝试重现该错误时，我尝试创建一个控制台应用程序，但显然此错误仅显示在表单应用程序中，并且仅当我的控件实际显示在表单上时!

以下是重现错误的步骤。创建一个新的 VCL Forms 应用程序，放置一个按钮，双击以创建 OnClick 处理程序并编写以下内容:

type TWinControl<T,K,W> = class(TWinControl);

procedure TForm3.Button1Click(Sender: TObject);
begin
  with TWinControl<TWinControl, TWinControl, TWinControl>.Create(Self) do
  begin
    Parent := Self;
  end;
end;

每次我尝试时，这都会连续生成访问冲突。仅在 Delphi 2010 上进行了测试，因为这是我在这台计算机上获得的唯一版本。

问题是:

• 这是 Delphi 泛型中的已知错误吗？
• 有解决方法吗？

编辑

以下是质量控制报告的链接:http://qc.embarcadero.com/wc/qcmain.aspx?d=112101

Answer 1

首先，这与泛型无关，但在使用泛型时更有可能出现。事实证明 TControl.CreateParams 中存在缓冲区溢出错误。如果您查看代码，您会注意到它填充了 TCreateParams 结构，尤其重要的是，它用当前类的名称( TCreateParams.WinClassName )填充了 ClassName 。不幸的是 WinClassName 是仅包含 64 字符的固定长度缓冲区，但需要包含 NULL 终止符；因此，64 char long ClassName 实际上会溢出该缓冲区!

可以使用以下代码进行测试:

TLongWinControlClassName4567890123456789012345678901234567891234 = class(TWinControl)
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  with TLongWinControlClassName4567890123456789012345678901234567891234.Create(Self) do
  begin
    Parent := Self;
  end;
end;

该类名称的长度正好 64 个字符。将其缩短一个字符，错误就会消失!

使用泛型时，这种情况更有可能发生，因为 Delphi 构造 ClassName 的方式:它包括声明参数类型的单元名称，加上一个点，然后是参数类型。例如，TWinControl<TWinControl, TWinControl, TWinControl> 类具有以下 ClassName:

TWinControl<Controls.TWinControl,Controls.TWinControl,Controls.TWinControl>

75 个字符长，超出了 63 限制。

解决方法

我采用了来自潜在错误生成类的简单错误消息。类似这样的东西，来自构造函数:

constructor TWinControl<T, K, W>.Create(aOwner: TComponent);
begin
  {$IFOPT D+}
  if Length(ClassName) > 63 then raise Exception.Create('The resulting ClassName is too    long: ' + ClassName);
  {$ENDIF}
  inherited;
end;

至少这显示了一条不错的错误消息，人们可以立即采取行动。

稍后编辑，真正的解决方法

之前的解决方案(引发错误)对于名称非常长的非泛型类效果很好；人们很可能能够将其缩短，使其不超过 63 个字符。泛型类型的情况并非如此:我遇到了带有 2 个类型参数的 TWinControl 后代的问题，因此它的形式如下:

TMyControlName<Type1, Type2>

基于此泛型类型的具体类型的生成类名采用以下形式:

TMyControlName<UnitName1.Type1,UnitName2.Type2>

因此它包含5个标识符(2x单元标识符+3x类型标识符)+5个符号(<.,.>)；这 5 个标识符的平均长度每个必须少于 12 个字符，否则总长度超过 63:5x12+5 = 65。每个标识符仅使用 11-12 个字符是非常少的，并且违背了最佳实践(即:使用长描述性名称，因为击键是免费的!)。同样，就我而言，我根本无法让我的标识符那么短。

考虑到缩短 ClassName 并不总是可行，我想我应该尝试消除问题的原因(缓冲区溢出)。不幸的是，这非常困难，因为错误源自 TWinControl.CreateParams ，位于 CreateParams 层次结构的底部。我们不能不调用 inherited，因为 CreateParams 在整个继承链中都用于构建窗口创建参数。不调用它需要复制基础 TWinControl.CreateParams 中的所有代码以及中间类中的所有代码；它也不是很可移植，因为任何代码都可能随着 VCL 的 future 版本(或者我们可能子类化的第三方控件的 future 版本)而改变。

以下解决方案不会阻止 TWinControl.CreateParams 溢出缓冲区，但会使其无害，然后(当 inherited 调用返回时)修复问题。我正在使用一条新记录(因此我可以控制布局)，其中包括原始的 TCreateParams 但用大量空间填充它以供 TWinControl.CreateParams 溢出。 TWinControl.CreateParams 溢出了它想要的所有内容，然后我读取完整的文本并使其符合记录的原始边界，同时确保生成的缩短名称相当可能是唯一的。我将原始 ClassName 的 HASH 包含在 WndName 中以帮助解决唯一性问题:

type
  TWrappedCreateParamsRecord = record
    Orignial: TCreateParams;
    SpaceForCreateParamsToSafelyOverflow: array[0..2047] of Char;
  end;

procedure TExtraExtraLongWinControlDescendantClassName_0123456789_0123456789_0123456789_0123456789.CreateParams(var Params: TCreateParams);
var Wrapp: TWrappedCreateParamsRecord;
    Hashcode: Integer;
    HashStr: string;
begin
  // Do I need to take special care?
  if Length(ClassName) >= Length(Params.WinClassName) then
    begin
      // Letting the code go through will cause an Access Violation because of the
      // Buffer Overflow in TWinControl.CreateParams; Yet we do need to let the
      // inherited call go through, or else parent classes don't get the chance
      // to manipulate the Params structure. Since we can't fix the root cause (we
      // can't stop TWinControl.CreateParams from overflowing), let's make sure the
      // overflow will be harmless.
      ZeroMemory(@Wrapp, SizeOf(Wrapp));
      Move(Params, Wrapp.Orignial, SizeOf(TCreateParams));
      // Call the original CreateParams; It'll still overflow, but it'll probably be hurmless since we just
      // padded the orginal data structure with a substantial ammount of space.
      inherited CreateParams(Wrapp.Orignial);
      // The data needs to move back into the "Params" structure, but before we can do that
      // we should FIX the overflown buffer. We can't simply trunc it to 64, and we don't want
      // the overhead of keeping track of all the variants of this class we might encounter.
      // Note: Think of GENERIC classes, where you write this code once, but there might
      // be many-many different ClassNames at runtime!
      //
      // My idea is to FIX this by keeping as much of the original name as possible, but
      // including the HASH value of the full name into the window name; If the HASH function
      // is any good then the resulting name as a very high probability of being Unique. We'll
      // use the default Hash function used for Delphi's generics.
      HashCode := TEqualityComparer<string>.Default.GetHashCode(PChar(@Wrapp.Orignial.WinClassName));
      HashStr := IntToHex(HashCode, 8);
      Move(HashStr[1], Wrapp.Orignial.WinClassName[High(Wrapp.Orignial.WinClassName)-8], 8*SizeOf(Char));
      Wrapp.Orignial.WinClassName[High(Wrapp.Orignial.WinClassName)] := #0;
      // Move the TCreateParams record back were we've got it from
      Move(Wrapp.Orignial, Params, SizeOf(TCreateParams));
    end
  else
    inherited;
end;