使用VCL主题时内存损坏(基本的Delphi功能失败)

时间:2017-08-28 13:10:23

标签: delphi themes delphi-xe7

我在我的应用中使用主题(vsf)。当我点击蒙皮菜单时,FastMM检测到我尝试访问已释放的对象。

我设法按需复制它:

Add a menu and a submenu (which does nothing, just a dummy menu) to a form
Start the program. 
Load a vsf skin.
Click the submenu.
Close the program.
On shutdown Fast MM will detect a mem corruption in Vcl.SysStyles.TSysPopupStyleHook.Create. See the FastMM log provided in RAR. Voila :)

这是(最小)源代码:

https://ufile.io/a7bwb 要么 http://s000.tinyupload.com/?file_id=09126466747848393733

UNIT FormMain;

INTERFACE

USES
  WinApi.Windows, WinApi.Messages, System.SysUtils, System.Classes, Vcl.ComCtrls, AppEvnts, VCL.Forms,   Vcl.Controls, System.UITypes, Vcl.ActnList, Vcl.Menus, System.Actions;

TYPE
  TMainForm = class(TForm)
    ActionList            : TActionList;
    actLoad               : TAction;
    Clearall1             : TMenuItem;
    MainMenu              : TMainMenu;
    mn0Project            : TMenuItem;
    procedure FormCreate    (Sender: TObject);
    procedure actLoadExecute(Sender: TObject);
  private
  public
 end;

VAR
   MainForm: TMainForm;

IMPLEMENTATION {$R *.dfm}

USES
   Vcl.Themes;

function LoadSkinFromFile(CONST DiskShortName: string): Boolean;
VAR  Style : TStyleInfo;
begin
 Result:= FileExists(DiskShortName);
 if Result then
  if TStyleManager.IsValidStyle(DiskShortName, Style)
  then
    if NOT TStyleManager.TrySetStyle(Style.Name, FALSE)
    then
      begin
       TStyleManager.LoadFromFile(DiskShortName);
       TStyleManager.SetStyle(Style.Name);
      end
    else Result:= FALSE
  else
     //MsgError('Style is not valid: '+ DiskShortName);
end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
 LoadSkinFromFile('8 Graphite Green.vsf');
 Show;
end;

procedure TMainForm.actLoadExecute(Sender: TObject);
begin
 Caption:= 'dummy';
end;

end.

快速MM报告是:

FastMM has detected an error during a free block scan operation. FastMM detected that a block has been modified after being freed. 

Modified byte offsets (and lengths): 36(1)

The previous block size was: 80

This block was previously allocated by thread 0xA28, and the stack trace (return addresses) at the time was:
4069EA 
4077EF 
407F16 
5EF55E [Vcl.SysStyles][Vcl][Vcl.SysStyles.TSysPopupStyleHook.Create]
58FBF6 [Vcl.Themes][Vcl][Vcl.Themes.{System.Generics.Collections}TDictionary<System.string,Vcl.Themes.TSysStyleHookClass>.GetItem]
58B669 [Vcl.Themes][Vcl][Vcl.Themes.AddControl]
58B797 [Vcl.Themes][Vcl][Vcl.Themes.TCustomStyleEngine.HookCBProc]
76217459 [Unknown function at CallNextHookEx]
76219046 [Unknown function at SetWindowsHookExA]
7741011A [KiUserCallbackDispatcher]
7622DE30 [TrackPopupMenuEx]

The block was previously used for an object of class: TSysPopupStyleHook

The allocation number was: 63473

The block was previously freed by thread 0xA28, and the stack trace (return addresses) at the time was:
406A06 
40780D 
407F61 
5F062F [Vcl.SysStyles][Vcl][Vcl.SysStyles.TSysPopupStyleHook.Destroy]
407913 
58B7FE [Vcl.Themes][Vcl][Vcl.Themes.TCustomStyleEngine.HookCBProc]
76217459 [Unknown function at CallNextHookEx]
762080B9 [Unknown function at GetUserObjectInformationW]
76206DF8 [Unknown function at GetThreadDesktop]
76208143 [Unknown function at GetUserObjectInformationW]
7741011A [KiUserCallbackDispatcher]

The current thread ID is 0xA28, and the stack trace (return addresses) leading to this error is:
416034 [FastMM4][FastMM4][FastMM4.CheckBlocksOnShutdown]
416D44 [FastMM4][FastMM4][FastMM4.FinalizeMemoryManager]
416DB0 [FastMM4][FastMM4][FastMM4.Finalization]
408F54 
40935D 
63F666 [test.dpr][test][test.test][18]
769B338A [BaseThreadInitThunk]
77439902 [Unknown function at RtlInitializeExceptionChain]
774398D5 [Unknown function at RtlInitializeExceptionChain]

为什么我会收到此错误?

注意:
如果我禁用主题(加载&#39;默认赢主题&#39;),该对话框将起作用。

这是BASIC功能失败。
它显示了两件事:
1. Embarcadero在运输产品之前没有做任何测试,2。它的客户群有多小(因为没有人发现这样的基本故障)。

0 个答案:

没有答案