Delphi主线程重入而导致程序卡死的解决方案
Delphi的线程可以通过调用AThread.Synchronize(AProc),可以将Proc放入主线程中同步运行,此时AThread将挂起,直到主线程执行完AProc。
如果有BThread,调用了BThread.Synchronize(BProc),而BProc中释放了AThread
procedure TBThread.BProc begin AThread.Terminate; AThread.WaitFor; AThread.Free; end;
此时我们的程序将会卡死,下面的代码可以避免死锁,是通用的线程等待结束代码。
AThread.Terminate; while not AThread.Finished do begin if GetCurrentThreadID = MainThreadID then //由于是通过Synchronize同步到主线程执行,所以调用CheckSynchronize,防止死锁 CheckSynchronize(0); Sleep(1); end; FreeAndNil(AThread);
如果以前没注意此重入问题,请修改你的代码吧。因为不能保证我们的代码被其他人用时不会出现重入。
此代码既支持Windows,也支持Android
不过包含的单元不一样:
uses System.SyncObjs, {$ifdef MSWINDOWS} Windows; {$endif} {$ifdef POSIX} Posix.Pthread; {$endif}
Delphi写的DLL,OCX中多线程一个同步问题
Delphi写的DLL,OCX中如果使用了TThread.Synchronze(Proc),可能导致线程死锁,原因是无法唤醒EXE中主线程,
Synchronze并不会进入EXE主线程消息队列.
下面的程序自动解决此问题,只需要加入DLL,OCX工程文件中,在DLL,OCX中便可以使用TThread.Synchronze(Proc)了,无需再写一行代码。
//解决Delphi编译的DLL,OCX文件中的线程调用 TThread.Synchronize后挂起无法再激活问题 //调用了TThread.Synchronize函数的所有工程请包含此文件 //仅需将此单元包含到工程文件即可 unit Lib.Common.DLLThread; interface implementation uses Classes, Windows, Messages; type { TDLLSystemController } TDLLSystemController = class private FHandle: HWND; FPrevWakeMainThread: TNotifyEvent; procedure WakeMainThread(Sender: TObject); procedure HookSynchronizeWakeup; procedure UnhookSynchronizeWakeup; protected procedure WndProc(var Message: TMessage); public constructor Create; destructor Destroy; override; end; var FDLLController:TDLLSystemController; { TDLLSystemController } constructor TDLLSystemController.Create; begin inherited; if IsLibrary then begin FHandle := AllocateHWnd(WndProc); HookSynchronizeWakeup; end; end; destructor TDLLSystemController.Destroy; begin if IsLibrary then begin DeallocateHWnd(FHandle); UnhookSynchronizeWakeup; end; inherited; end; procedure TDLLSystemController.WndProc(var Message: TMessage); begin case Message.Msg of WM_NULL: CheckSynchronize; else Message.Result := DefWindowProc(FHandle, Message.Msg, Message.wParam, Message.lParam); end; end; procedure TDLLSystemController.WakeMainThread(Sender: TObject); begin PostMessage(FHandle, WM_NULL, 0, 0); end; procedure TDLLSystemController.HookSynchronizeWakeup; begin FPrevWakeMainThread := Classes.WakeMainThread; Classes.WakeMainThread := WakeMainThread; end; procedure TDLLSystemController.UnhookSynchronizeWakeup; begin Classes.WakeMainThread := FPrevWakeMainThread; end; initialization if IsLibrary then FDLLController := TDLLSystemController.Create else FDLLController:=nil; finalization if Assigned(FDLLController) then FDLLController.Free; end.
Delphi跨平台下的GetTickCount,GetCurrentThreadID 在Windows下只要uses Windows,就有这两个API可调用GetTickCount,GetCurrentThreadID 如果我们需要跨平台使用这两个函数,就不能仅仅Uses Windows了。 如果需要跨平台使用GetTickCount,可以uses System.Classes,然后使用类方法:TThread.GetTickCount 如果需要跨平台使用GetCurrentThreadID,则仅需引用不同的单元即可: uses {$ifdef MSWINDOWS} Windows; {$endif} {$ifdef POSIX} Posix.Pthread; {$endif}
Delphi Firemonkey在主线程 异步调用函数(延迟调用)
先看下面的FMX.Layouts.pas中一段代码 1 2 3 4 5 6 7 8 9 10 11 procedure TCustomScrollBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FMouseEvents := True; inherited; if (Button = TMouseButton.mbLeft) then begin MousePosToAni(X, Y); AniMouseDown(ssTouch in Shift, X, Y); end; end; 在执行Inherited;这行时可能会调用控件的OnDblClick事件,如果此时在OnDblClick中将Form或控件释放了,后面调用MousePosToAni可能就会造成内存访问异常 因此最好能够在UI线程(主线程)中执行MouseDown完全后,再调用Form或控件的释放,如下面 procedure TForm1.OnListBox1Item1DblClick(Sender:TObject); begin ....//处理一些事情 AsyncCallInUIThread( procedure begin Self.DisposeOf; //延迟释放,防止内存访问异常 end); end; 下面是AsyncCallInUIThread的实现: procedure AsyncCallInUIThread(Proc: TProc); begin TThread.CreateAnonymousThread( procedure begin Sleep(0); TThread.Synchronize(nil, procedure begin Proc; end); end).Start; end;