In Delphi 2009 I'm finding that any time I use TThread.CurrentThread in an application, I'll get an error message like the following when the application closes:
Exception EAccessViolation in module ntdll.dll at 0003DBBA.
Access violation at address 7799DBBA in module 'ntdll.dll'. Write of
address 00000014.
Unless it's just my machine, you can replicate this in a few seconds: create a new Delphi Forms Application, add a button to the form, and use something like the following for the button's event handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.CurrentThread;
end;
On both my Vista machine and my XP machine I'm finding that, if I don't click the button everything's fine, but if I do click the button I get the above error message when I close the application.
So... I'm wondering if this is a bug, but at the same time I think it's rather likely that I'm simply not understanding something very basic about how you're supposed to work with TThreads in Delphi. I am a bit of a Delphi newbie I'm afraid.
Is there something obviously wrong with using TThread.CurrentThread like that?
If not, and you have Delphi 2009, do you get the same problem if you implement my simple sample project?
Unfortunately it seems like a bug linked to the call order of the finalization section in the Classes unit:
DoneThreadSynchronization
clears the ThreadLock
structure, thenFreeExternalThreads
wants to destroy the Thread object you just created when calling CurrentThread
, and
that requires the ThreadLock to be already initialized in the call toEnterCriticalSection(ThreadLock)
in TThread.RemoveQueuedEvents
...
UPDATE:
There is now a workaround patch in the QC report.
Patch unit for Delphi 2009 Update 3.
{ Fix Delphi 2009's invalid finalization order in Classes.pas.
Written by Primoz Gabrijelcic, http://gp.17slon.com.
No rights reserved - released to public domain.
D2009 update 3 only.
}
unit FixD2009Classes;
interface
implementation
uses
Windows,
SysUtils,
Classes;
type
TCode = array [0..144] of byte;
{$WARN SYMBOL_PLATFORM OFF}
procedure PatchClasses;
{$IFDEF ConditionalExpressions}
{$IF RTLVersion = 20}
var
i : integer;
oldProtect: cardinal;
pCode : ^TCode;
tmp : DWORD;
const
COffsets_Call: array [1..12] of integer = (0, 15, 24, 42, 47, 58, 73, 91, 101, 111, 134, 139);
COffset_UnRegisterModuleClasses = 107;
COffset_DoneThreadSynchronization = 134;
COffset_FreeExternalThreads = 139;
CCallDelta = COffset_FreeExternalThreads - COffset_DoneThreadSynchronization;
{$IFEND}
{$ENDIF}
begin
{$IFDEF ConditionalExpressions}
{$IF RTLVersion = 20}
pCode := pointer(cardinal(@TStreamReader.ReadToEnd) + COffset_UnRegisterModuleClasses);
Win32Check(VirtualProtect(pCode, COffsets_Call[High(COffsets_Call)], PAGE_READWRITE, oldProtect));
try
for i := Low(COffsets_Call) to High(COffsets_Call) do
if pCode^[COffsets_Call[i]] <> $E8 then
raise Exception.Create('Unexpected version of Classes - cannot patch');
tmp := PDword(@pCode^[COffset_DoneThreadSynchronization+1])^;
PDword(@pCode^[COffset_DoneThreadSynchronization+1])^ :=
PDword(@pCode^[COffset_FreeExternalThreads+1])^ + CCallDelta;
PDword(@pCode^[COffset_FreeExternalThreads+1])^ := tmp - CCallDelta;
finally VirtualProtect(pCode, COffsets_Call[High(COffsets_Call)], oldProtect, oldProtect); end;
{$IFEND}
{$ENDIF}
end;
initialization
PatchClasses;
end.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With