线程 Delphi主线程重入而导致程序卡死的解决方案 Delphi写的DLL,OCX中多线程一个同步问题 Delphi Firemonkey在主线程 异步调用函数(延迟调用)

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;

猜你喜欢

转载自www.cnblogs.com/marklove/p/9206847.html