我在我的应用中使用主题(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。它的客户群有多小(因为没有人发现这样的基本故障)。