我可以修改RTL类System.Classes.TStream中的常量并在运行时在Delphi XE6中重建它吗?

War*_* P 11 delphi delphi-xe6

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

function TStream.CopyFrom(const Source: TStream; Count: Int64): Int64;
const
  MaxBufSize = $F000;
....
Run Code Online (Sandbox Code Playgroud)

这导致我们的Delphi应用程序遭受重大性能损失.在delphi XE2到XE5中,我们能够修改它并使用以下方法之一:

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

  • 我可以尝试在我的项目搜索路径中的某处放置一个经过修改的system.classes.pas文件.

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

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

重现此问题的示例程序(假设您已修改了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.
Run Code Online (Sandbox Code Playgroud)

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

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

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

作为第二个问题,是否有.dcu文件没有源存在,当一个人尝试这样做时会破坏,在这种情况下,上述所有的答案是,"你无法解决这个问题,如果有一个bug在RTL中,你运气不好"?

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

RRU*_*RUZ 10

您可以使用绕行来克服此限制,尝试使用此示例的此示例 Delphi Detours Library

首先定义要挂钩的方法的签名

var
 Trampoline_TStreamCopyFrom : function (Self : TStream;const Source: TStream; Count: Int64): Int64 = nil;
Run Code Online (Sandbox Code Playgroud)

然后实施绕道而行

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;
Run Code Online (Sandbox Code Playgroud)

最后用蹦床替换原来的功能(你可以在某个单元的初始化部分使用这个代码)

  Trampoline_TStreamCopyFrom     := InterceptCreate(@TStream.CopyFrom,   @Detour_TStreamCopyFrom);
Run Code Online (Sandbox Code Playgroud)

并释放你可以使用的钩子

 if Assigned(Trampoline_TStreamCopyFrom) then
   InterceptRemove(@Trampoline_TStreamCopyFrom);
Run Code Online (Sandbox Code Playgroud)


Dav*_*nan 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}
Run Code Online (Sandbox Code Playgroud)

当我在XE6中这样做时.

把它放在你的单元副本的顶部,你应该很高兴.根据您的主机项目选项,您可以放弃这些的缩减子集.在我的代码中,我发现:

{$R-,T-,H+,X+}
Run Code Online (Sandbox Code Playgroud)

就足够了.

  • 供应商可能无法分发匹配的源文件,这实际上是之前发生过的.到最后的非匹配断点是一个非确定性指示. (3认同)