(* 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: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; 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.
3条答案
按热度按时间blpfk2vs1#
这个问题可以这样解决:
1.获取或实现
AllocateHwnd
和DeallocateHwnd
的线程安全版本。1.替换这些函数的VCL的不安全版本。
对于项目1,我使用Primož Gabrijelcic's代码,正如他在blog article上所描述的。对于第2项,我简单地使用了非常著名的技巧,即在运行时修补代码,并将不安全例程的开头替换为无条件的
JMP
指令,将执行重定向到线程安全函数。把它们放在一起,就可以得出下面的单元。
字符串
此单元必须很早就包含在.dpr文件的单元列表中。显然,它不能出现在任何自定义内存管理器之前,但它应该在那之后立即出现。原因是必须在调用
AllocateHwnd
之前安装替换例程。更新我已经合并了Primoš的代码的最新版本,他亲切地发送给我。
lvmkulzt2#
不要在线程中使用
TTimer
,它永远不会安全。有线程之一:1)使用
SetTimer()
与手动消息循环。如果使用回调函数,则不需要HWND
,但仍然需要分发消息。2)使用
CreateWaitableTimer()
,然后在循环中调用WaitForSingleObject()
,直到计时器发出信号。3)使用
timeSetEvent()
,这是一个多线程定时器。只是要小心,因为它的回调是在它自己的线程中调用的,所以要确保你的回调函数是线程安全的,并且对你在那个线程中被允许调用的内容有限制。最好让它设置一个信号,让你的真实的的线程等待,然后在计时器之外完成它的工作。kzipqqlq3#
由于您已经编写了在专用线程中操作的代码,因此我假设您不期望任何代码在等待某些事情时运行。在这种情况下,您可以使用特定的毫秒数或少量的毫秒调用Sleep,并在循环中使用它来检查Now或GetTickCount,以查看是否已经过了特定的时间。使用Sleep也会降低CPU的使用率,因为操作系统会收到信号,您不需要线程在这段时间内保持运行。