标签:des style blog http color io os ar for
I have a Delphi 6 application that has a thread dedicated to communicating with a foreign application that uses SendMessage() and WM_COPYDATA messages to interface with external programs. Therefore, I create a hidden window with AllocateHWND() to service that need since a thread message queue won‘t work due to the SendMessage() function only accepting window handles, not thread IDs. What I‘m not sure about is what to put in the thread Execute() method.
I assume that if I use a GetMessage() loop or a create a loop with a WaitFor*() function call in it that the thread will block and therefore the thread‘s WndProc() will never process the SendMessage() messages from the foreign program right? If so, what is the correct code to put in an Execute() loop that will not consume CPU cycles unnecessarily but will exit once a WM_QUIT message is received? I can always do a loop with a Sleep() if necessary but I‘m wondering if there is a better way.
AllocateHWnd()
(more specifically, MakeObjectInstance()
) is not thread-safe, so you have to be careful with it. Better to use CreatWindow/Ex()
directly instead.
In any case, an HWND
is tied to the thread context that creates it, so you have to create and destroy the HWND
inside your Execute()
method, not in the thread‘s constructor/destructor. Also, even though SendMessage()
is being used to send the messages to you, they are coming from another process, so they will not be processed by your HWND
until its owning thread performs message retrieval operations, so the thread needs its own a message loop.
Your Execute()
method should look something like this:
procedure TMyThread.Execute; var Message: TMsg; begin FWnd := AllocateHWnd(WndProc); try while not Terminated do begin if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLINPUT) = WAIT_OBJECT_0 then begin while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do begin TranslateMessage(Message); DispatchMessage(Message); end; end; end; finally DeallocateHWnd(FWnd); end; end; procedure TMyThread.WndProc(var Message: TMessage); begin if Message.Msg = WM_COPYDATA then begin ... Message.Result := ...; end else Message.Result := DefWindowProc(FWnd, Message.Msg, Message.WParam, Message.LParam); end;
You should use DSiAllocateHwnd instead of AllocateHwnd.
VCL components are designed to be used solely from the main thread of an application. For visual components this never presents me with any difficulties. However, I would sometimes like to be able to use, for example, non-visual components like TTimer
from a background thread. Or indeed just create a hidden window. This is not safe because of the reliance on AllocateHwnd
. Now, AllocateHwnd
is not threadsafe which I understand is by design.
Is there an easy solution that allows me to use AllocateHwnd
from a background thread?
This problem can be solved like so:
AllocateHwnd
and DeallocateHwnd
.For item 1 I use Primo? Gabrijelcic‘s code, as described on his blog article on the subject.
For item 2 I simply use the very well-known trick of patching the code at runtime
and replacing the beginning of the unsafe routines with unconditional JMP
instructions that redirect execution to the threadsafe functions.
Putting it all together results in the following 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.
This unit must be included very early in the .dpr file‘s list of units.
Clearly it cannot appear before any custom memory manager, but it should appear immediately after that.
The reason being that the replacement routines must be installed before any calls to AllocateHwnd
are made.
Update I have merged in the very latest version of Primo?‘s code which he kindly sent to me.
[This article also serves as announcement of DSiWin32 1.26.]
[Update: Reported as QC #47559. Vote for it!]
You‘re probably asking yourself - what‘s that AllocateHwnd anyway? And why must it be thread-safe?
As the Google is guick to tell (BTW, Steve, thanks for the search filter!), AllocateHwnd is used to create a hidden window which you can use to receive messages in non-windowed components. Of course, you can use it outside of any component to set up simple and easy messaging subsystem anywhere in your application. If you need more communication channels, just call AllocateHwnd many times.
I won‘t bother you with the usage pattern - if you want to use AllocateHwnd and don‘t know how, use the search link above. You‘ll find many examples, including this one from DelphiDabbler, which Steve‘s searcher lists on the first place.
An example of a very popular component using AllocateHwnd internally is Delphi‘s TTimer.
That should answer the first question, but what about thread-safety?
Well, many programmers use AllocateHwnd in threaded code to create hidden windows where messages are processed. Many are also using TTimer inside threads without knowing the first thing about AllocateHwnd. But almost nobody knows that this is totally unsafe and may lead to rare and obscure crashes. AllocateHwnd was written with single-threaded VCL applications in mind and you can use it from a thread only if you take special precaution.
Let‘s see how the AllocateHwnd is implemented. Following code was copied from D2007‘s Classes.pas (in very old Delphis, AllocateHwnd was implemented in Forms.pas):
var UtilWindowClass: TWndClass = ( style: 0; lpfnWndProc: @DefWindowProc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: ‘TPUtilWindow‘); function AllocateHWnd(Method: TWndMethod): HWND; var TempClass: TWndClass; ClassRegistered: Boolean; begin UtilWindowClass.hInstance := HInstance; {$IFDEF PIC} UtilWindowClass.lpfnWndProc := @DefWindowProc; {$ENDIF} ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass); end; Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, ‘‘, WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil); if Assigned(Method) then SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); end;
Basically, the code registers window class if necessary, creates a new window of that class, and sets window procedur for that window to MakeObjectInstance(Method). Nothing special, except this last step. Can you tell why it is necessary at all?
The reason lies in the discrepancy between Delphi‘s object model and Win32 API, which is not object oriented. The TWndMethod parameter passed to the AllocateHwnd is not just an address of code, but contains also the address of the object this method belongs to.
On the other hand, Win32 API wants to call a simple method anytime it has to deliver a message to a window.
MakeObjectInstance bridges this gap. It manages a linked list of methods together with a dynamically generated code preamble (address of which is returned from the MakeObjectInstance function). When Windows calls this code preamble, it makes sure that correct method is called on the correct object.
MakeObjectInstance is complicated, but it works. That is, until you call it from two threads at the same time. You see, MakeObjectInstance does nothing to lock its internal list while it is being manipulated. If you do this from two threads running on two CPUs, or even if you have only one CPU and context switch occurs at a bad time, internal instance list can get corrupted. Later, this may lead to crashes, bad program behaviour, you name it. And you‘ll never find the true culprit.
Admittedly, there is only a small window - few instructions - which are problematic. In most applications such problems will never occur. But if you‘re running 24/7 server which calls AllocateHwnd/DeallocateHwnd constantly from multiple threads, you can be sure that sooner or later it will crash.
There are two possible solutions to the problem - one is to wrap all AllocateHwnd and DeallocateHwnd in some sort of critical section, spinlock or mutex that will allow only one instance to be called at the same time and other is to write a better and thread-safe AllocateHwnd. First solution is somewhat clumsy to implement in production code while the second can be hard to write.
Actually, I search the net wide and deep and found only two alternative AllocateHwnd implementations (references below). I‘m sure there are more. I just couldn‘t find them. None of them was really suitable for my needs so I created a third one using ideas from both of them. My version — DSiAllocateHwnd, DSiDeallocateHwnd and TDSiTimer — has been published as a part of the DSiWin32 library.
This is the current version of my AllocateHwnd alternative:
const GWL_METHODCODE = SizeOf(pointer) * 0; GWL_METHODDATA = SizeOf(pointer) * 1; CDSiHiddenWindowName = ‘DSiUtilWindow‘; var GDSiWndHandlerCritSect: TRTLCriticalSection; GDSiWndHandlerCount: integer; function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall; var instanceWndProc: TMethod; msg : TMessage; begin instanceWndProc.Code := Pointer(GetWindowLong(Window, GWL_METHODCODE)); instanceWndProc.Data := Pointer(GetWindowLong(Window, GWL_METHODDATA)); if Assigned(TWndMethod(instanceWndProc)) then begin msg.msg := Message; msg.wParam := WParam; msg.lParam := LParam; TWndMethod(instanceWndProc)(msg); Result := msg.Result end else Result := DefWindowProc(Window, Message, WParam,LParam); end; { DSiClassWndProc } 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 Windows.UnregisterClass(CDSiHiddenWindowName, HInstance); utilWindowClass.lpszClassName := CDSiHiddenWindowName; utilWindowClass.hInstance := HInstance; utilWindowClass.lpfnWndProc := @DSiClassWndProc; utilWindowClass.cbWndExtra := SizeOf(TMethod); if 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)]); SetWindowLong(Result, GWL_METHODDATA, Longint(TMethod(wndProcMethod).Data)); SetWindowLong(Result, GWL_METHODCODE, Longint(TMethod(wndProcMethod).Code)); Inc(GDSiWndHandlerCount); finally LeaveCriticalSection(GDSiWndHandlerCritSect); end; end; { DSiAllocateHWnd } procedure DSiDeallocateHWnd(wnd: HWND); begin DestroyWindow(wnd); EnterCriticalSection(GDSiWndHandlerCritSect); try Dec(GDSiWndHandlerCount); if GDSiWndHandlerCount <= 0 then Windows.UnregisterClass(CDSiHiddenWindowName, HInstance); finally LeaveCriticalSection(GDSiWndHandlerCritSect); end; end; { DSiDeallocateHWnd }
There are many differences between this code and Delphi version.
I admit that this approach to message dispatching is slower than the Delphi‘s version, but usually that is not a problem - custom windows are usually created to process some small subset of messages only.
The AllocateHwnd problem is not something I have found by myself. It has been documented for years, but is not well known.
I‘d like to thank to:
Thread message loop for a thread with a hidden window? Make AllocateHwnd safe
标签:des style blog http color io os ar for
原文地址:http://www.cnblogs.com/shangdawei/p/4016031.html