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?