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:
Until CodeGear issues a fix, you can use the patch below. Save it into a standalone unit and use it anywhere in your program. I'll try to add it to the QC, too.
This version works with D2009 (original), update 1 and update 2.
{ 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.
}
unit FixD2009Classes;
interface
implementation
uses
Windows,
SysUtils,
Classes;
type
TCode = array [0..109] 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, 34, 49, 59, 69, 79, 89, 94, 99, 109);
COffset_UnRegisterModuleClasses = 106;
COffset_DoneThreadSynchronization = 94;
COffset_FreeExternalThreads = 99;
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.
Unfortunately it seems like a bug linked to the call order of the finalization section in the Classes unit:
DoneThreadSynchronization
clears the ThreadLock
structure, then
FreeExternalThreads
wants to destroy the Thread object you just created when calling CurrentThread
, and
that requires the ThreadLock to be already initialized in the call to
EnterCriticalSection(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.
I think CurrentThread is added in 2009 (or 2007). I have 2006 at home. But are you sure it is a class property?