Questo problema può essere risolto in questo modo:
- ottenere o implementare una versione threadsafe di
AllocateHwnd
e DeallocateHwnd
.
- Sostituire le versioni non sicure di VCL di queste funzioni.
Per l'articolo 1 utilizzo il codice Primož Gabrijelcic's, come descritto sul suo numero blog article sull'argomento. Per l'articolo 2 uso semplicemente il trucco ben noto di applicare patch al codice in fase di runtime e sostituire l'inizio delle routine non sicure con istruzioni incondizionate JMP
che reindirizzano l'esecuzione alle funzioni thread-safe.
Mettere insieme tutti i risultati nella seguente unità.
(* Makes AllocateHwnd safe to call from threads. For example this makes TTimer
safe to use from threads. Include this unit as early as possible in your
.dpr file. It must come after any memory manager, but it must be included
immediately after that before any included unit has an opportunity to call
Classes.AllocateHwnd. *)
unit MakeAllocateHwndThreadsafe;
interface
implementation
{$IF CompilerVersion >= 23}{$DEFINE ScopedUnitNames}{$IFEND}
uses
{$IFDEF ScopedUnitNames}System.SysUtils{$ELSE}SysUtils{$ENDIF},
{$IFDEF ScopedUnitNames}System.Classes{$ELSE}Classes{$ENDIF},
{$IFDEF ScopedUnitNames}Winapi.Windows{$ELSE}Windows{$ENDIF},
{$IFDEF ScopedUnitNames}Winapi.Messages{$ELSE}Messages{$ENDIF};
const //DSiAllocateHwnd window extra data offsets
GWL_METHODCODE = SizeOf(pointer) * 0;
GWL_METHODDATA = SizeOf(pointer) * 1;
//DSiAllocateHwnd hidden window (and window class) name
CDSiHiddenWindowName = 'DSiUtilWindow';
var
//DSiAllocateHwnd lock
GDSiWndHandlerCritSect: TRTLCriticalSection;
//Count of registered windows in this instance
GDSiWndHandlerCount: integer;
//Class message dispatcher for the DSiUtilWindow class. Fetches instance's WndProc from
//the window extra data and calls it.
function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall;
var
instanceWndProc: TMethod;
msg : TMessage;
begin
{$IFDEF CPUX64}
instanceWndProc.Code := pointer(GetWindowLongPtr(Window, GWL_METHODCODE));
instanceWndProc.Data := pointer(GetWindowLongPtr(Window, GWL_METHODDATA));
{$ELSE}
instanceWndProc.Code := pointer(GetWindowLong(Window, GWL_METHODCODE));
instanceWndProc.Data := pointer(GetWindowLong(Window, GWL_METHODDATA));
{$ENDIF ~CPUX64}
if Assigned(TWndMethod(instanceWndProc)) then
begin
msg.msg := Message;
msg.wParam := WParam;
msg.lParam := LParam;
msg.Result := 0;
TWndMethod(instanceWndProc)(msg);
Result := msg.Result
end
else
Result := DefWindowProc(Window, Message, WParam,LParam);
end; { DSiClassWndProc }
//Thread-safe AllocateHwnd.
// @author gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
// TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
// @since 2007-05-30
function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
var
alreadyRegistered: boolean;
tempClass : TWndClass;
utilWindowClass : TWndClass;
begin
Result := 0;
FillChar(utilWindowClass, SizeOf(utilWindowClass), 0);
EnterCriticalSection(GDSiWndHandlerCritSect);
try
alreadyRegistered := GetClassInfo(HInstance, CDSiHiddenWindowName, tempClass);
if (not alreadyRegistered) or (tempClass.lpfnWndProc <> @DSiClassWndProc) then begin
if alreadyRegistered then
{$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
utilWindowClass.lpszClassName := CDSiHiddenWindowName;
utilWindowClass.hInstance := HInstance;
utilWindowClass.lpfnWndProc := @DSiClassWndProc;
utilWindowClass.cbWndExtra := SizeOf(TMethod);
if {$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.RegisterClass(utilWindowClass) = 0 then
raise Exception.CreateFmt('Unable to register DSiWin32 hidden window class. %s',
[SysErrorMessage(GetLastError)]);
end;
Result := CreateWindowEx(WS_EX_TOOLWINDOW, CDSiHiddenWindowName, '', WS_POPUP,
0, 0, 0, 0, 0, 0, HInstance, nil);
if Result = 0 then
raise Exception.CreateFmt('Unable to create DSiWin32 hidden window. %s',
[SysErrorMessage(GetLastError)]);
{$IFDEF CPUX64}
SetWindowLongPtr(Result, GWL_METHODDATA, NativeInt(TMethod(wndProcMethod).Data));
SetWindowLongPtr(Result, GWL_METHODCODE, NativeInt(TMethod(wndProcMethod).Code));
{$ELSE}
SetWindowLong(Result, GWL_METHODDATA, cardinal(TMethod(wndProcMethod).Data));
SetWindowLong(Result, GWL_METHODCODE, cardinal(TMethod(wndProcMethod).Code));
{$ENDIF ~CPUX64}
Inc(GDSiWndHandlerCount);
finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiAllocateHWnd }
//Thread-safe DeallocateHwnd.
// @author gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
// TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
// @since 2007-05-30
procedure DSiDeallocateHWnd(wnd: HWND);
begin
if wnd = 0 then
Exit;
DestroyWindow(wnd);
EnterCriticalSection(GDSiWndHandlerCritSect);
try
Dec(GDSiWndHandlerCount);
if GDSiWndHandlerCount <= 0 then
{$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiDeallocateHWnd }
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, @OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
initialization
InitializeCriticalSection(GDSiWndHandlerCritSect);
RedirectProcedure(@AllocateHWnd, @DSiAllocateHWnd);
RedirectProcedure(@DeallocateHWnd, @DSiDeallocateHWnd);
finalization
DeleteCriticalSection(GDSiWndHandlerCritSect);
end.
Questa unità deve essere inclusa molto presto nella lista di unità del file .dpr. Chiaramente non può comparire prima di nessun gestore di memoria personalizzato, ma dovrebbe apparire immediatamente dopo. Il motivo è che le routine sostitutive devono essere installate prima di effettuare qualsiasi chiamata a AllocateHwnd
.
Aggiornamento Mi sono fuso nell'ultima versione del codice di Primož che mi ha gentilmente inviato.
Con pura API di Windows; il ['SetTimer'] (http://msdn.microsoft.it/it/us/library/windows/desktop/ms644906% 28v = vs.85% 29.aspx) non richiede HWND; è anche possibile utilizzare la funzione di callback. Vedi ['qui'] (http://stackoverflow.com/a/6761071/960757) per esempio. – TLama
@TLama Hai perfettamente ragione, ma 'TTimer' usa' WM_TIMER' e questo è l'obiettivo qui. –
Stavo pensando a qualcosa di ciò che è nel mio post eliminato (pseudocodice). Naturalmente devi ancora inviare i messaggi per ottenere il passaggio di 'WM_TIMER', ma mi sembra meno malvagio di' AllocateHwnd' per un thread di lavoro :) – TLama