12

我正在尝试解决 System.Classes.pas 中已知的丑陋性能限制,该限制具有 1980 年代的常量缓冲区限制 ($F000),如下所示:

function TStream.CopyFrom(const Source: TStream; Count: Int64): Int64;
const
  MaxBufSize = $F000;
....

这在我们的 Delphi 应用程序中造成了重大的性能损失。在 delphi XE2 到 XE5 中,我们能够修改它并使用以下方法之一:

  • 我可以修改 Delphi 源代码,然后通过从批处理文件中调用 dcc32.exe,在 Delphi 库文件夹中重建 System.Classes.dcu 文件。我意识到这很丑陋,我不喜欢这样做,但我也不喜欢 RTL 中这种丑陋的性能问题,我们的用户无法忍受它引起的性能问题。

  • 我可以尝试将修改后的 system.classes.pas 文件放在我的项目搜索路径中的某个位置。

现在,上述两种方法都不适用于我在 Delphi XE6 中,这可能要归功于一些内部编译器的更改。我在使用子句中包含 System.Contnrs 的最小命令行应用程序中遇到的错误是:

[dcc32 Fatal Error] System.Classes.pas(19600): F2051 Unit System.Contnrs was compiled with a different version of System.Classes.TComponent

重现此问题的示例程序(假设您已修改 System.Classes.pas 并更改了 MaxBufSize 常量)如下所示:

program consoletestproject;

{$APPTYPE CONSOLE}

{$R *.res}

uses
   System.Contnrs,
   System.SysUtils;

var
  List:System.Contnrs.TObjectList;
begin
   WriteLn('Hello world');
end.

同样,这个问题在 Delphi XE6 中很容易重现,但在 XE5 或更早版本中不是问题。

当您绝对必须使用 System.Classes.pas 或 System.SysUtils.pas 或其他一些非常低级别的单元的修改副本来解决基本 RTL 或 VCL 限制时,推荐的做法是什么?(是的,我知道你不应该这样做,如果你不必这样做,不要费心讲课。)

您是否可以通过命令行上的“dcc32.exe”使用一组神奇的命令行参数来生成修改后的 DCU,该 DCU 将与上面的应用程序示例正确链接?

作为第二个问题,是否存在不存在源的 .dcu 文件在尝试执行此操作时会中断,在这种情况下,上述所有问题的答案是,“您无法修复此问题,并且如果存在错误在 RTL 中,你运气不好”?

一种可能的解决方法是在项目搜索路径(或库路径)中包含“$(BDS)\source\rtl\common”,强制每个损坏的(需要重新编译的)DCU 每次都重建,但这看起来很丑陋和错误。

4

2 回答 2

10

你可以通过绕道来克服这个限制,试试这个使用Delphi Detours Library

首先定义要hook的方法的签名

var
 Trampoline_TStreamCopyFrom : function (Self : TStream;const Source: TStream; Count: Int64): Int64 = nil;

然后实施绕道

function Detour_TStreamCopyFrom(Self : TStream;const Source: TStream; Count: Int64): Int64;
const
  MaxBufSize = 1024*1024; //use 1 mb now :)
var
  BufSize, N: Integer;
  Buffer: TBytes;
begin
  if Count <= 0 then
  begin
    Source.Position := 0;
    Count := Source.Size;
  end;
  Result := Count;
  if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
  SetLength(Buffer, BufSize);
  try
    while Count <> 0 do
    begin
      if Count > BufSize then N := BufSize else N := Count;
      Source.ReadBuffer(Buffer, N);
      Self.WriteBuffer(Buffer, N);
      Dec(Count, N);
    end;
  finally
    SetLength(Buffer, 0);
  end;
end;

最后用蹦床替换原来的函数(可以在某些单元的初始化部分使用这段代码)

  Trampoline_TStreamCopyFrom     := InterceptCreate(@TStream.CopyFrom,   @Detour_TStreamCopyFrom);

并释放你可以使用的钩子

 if Assigned(Trampoline_TStreamCopyFrom) then
   InterceptRemove(@Trampoline_TStreamCopyFrom);
于 2014-06-10T16:17:40.620 回答
6

更新 1:以下建议不适用于ClassesXE6 中的单元。基本技术是健全的,并且确实解决了类似的问题。但是对于 XE6,至少是该Classes单元,如何重新编译它并不是很明显。

这似乎是 XE6 中引入的一个错误,因为该技术旨在工作并得到 Embarcadero 官方认可:http: //blog.marcocantu.com/blog/2014_august_buffer_overflow_bitmap.html

更新 2:

在 XE7 中,这个问题不再存在。看来 XE6 中的任何问题都已修复。


您需要编译器选项与 Embarcadero 编译该单元时使用的选项相匹配。这就是为什么您的实现部分仅在看起来应该成功时才更改失败的原因。

启动一个默认项目并使用CTRL++O生成O这些选项。我明白了

{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}

当我在 XE6 中执行此操作时。

把它放在你的单位副本的顶部,你应该很高兴。根据您的宿主项目选项,您可能可以使用其中的一个缩减子集。在我的代码中,我发现:

{$R-,T-,H+,X+}

就够了。

于 2014-06-10T15:50:46.507 回答