Warning: file_get_contents(/data/phpspider/zhask/data//catemap/6/multithreading/4.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Multithreading TThread checksynchronize与dll的问题_Multithreading_Delphi - Fatal编程技术网

Multithreading TThread checksynchronize与dll的问题

Multithreading TThread checksynchronize与dll的问题,multithreading,delphi,Multithreading,Delphi,我有一个线程,我在我的dll中使用它来更新一些视觉控件。它工作正常,但当我试图关闭我的dll并再次打开它时,我面临这个问题。它引发了这个异常 从非主线程的线程调用checksynchronize 我做错了什么?我需要在计时器内调用checksynchronize,因为我将在应用程序运行时使用线程更新一些vcl 这是我的线程单元 unit Thread; interface uses Messages, Windows, SysUtils, dialogs, Classes, Menus, f

我有一个线程,我在我的dll中使用它来更新一些视觉控件。它工作正常,但当我试图关闭我的dll并再次打开它时,我面临这个问题。它引发了这个异常

从非主线程的线程调用checksynchronize

我做错了什么?我需要在计时器内调用checksynchronize,因为我将在应用程序运行时使用线程更新一些vcl

这是我的线程单元

unit Thread;

interface

uses Messages, Windows, SysUtils, dialogs, Classes, Menus, forms, ComOBJ,
  ShlObj;

{ Thread client }

type
  TThreadCallbackProc = procedure(Sender: TObject; Updatestring : string) of object;

  TAPPTHREAD = class(TThread)
  private
     Fstatus : String;
    FOnCallbackProc: TThreadCallbackProc;
    procedure dosomework;
    procedure DoCallbackProc;
    //
  protected
    procedure Execute; override;

  Public
    constructor Create(CreateSuspended: Boolean; aThreadCallbackProc: TThreadCallbackProc);
    destructor Destroy; override;

  end;

  var
  APPTHREAD : TAPPTHREAD;




implementation


constructor TAPPTHREAD.Create(CreateSuspended: Boolean;
  aThreadCallbackProc: TThreadCallbackProc);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FOnCallbackProc := aThreadCallbackProc;
end;

destructor TAPPTHREAD.Destroy;
begin
//
end;

procedure TAPPTHREAD.DoCallbackProc;
begin
  if Assigned(FOnCallbackProc) then
    FOnCallbackProc(self, Fstatus);
end;

procedure TAPPTHREAD.Execute;
begin

  while not Terminated do
  begin
    Fstatus := 'Synched';
    if Fstatus <> '' then
      dosomework;
  end;
end;



procedure TAPPTHREAD.dosomework;
begin

if Assigned(FOnCallbackProc) then
begin
Synchronize(DoCallbackProc);
end;

end;

end. 
DFM

dll代码

library dllapp;

uses
  System.SysUtils,
  Themes,
  Windows,
  Forms,
  dialogs,
  Graphics,
  Vcl.ExtCtrls,
  Unit1 in 'Unit1.pas' {Unit1},
  DThreadsend in 'Thread.pas';




var
  mHandle: THandle;
  DLLHandle: Longint = 0;

function createApp(Width: Integer; Height: Integer; hw: HWnd;
  app: TApplication): boolean; stdcall;
begin

  mHandle := CreateMutex(nil, True, 'APPNAMETLOAD');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    Halt;
  end;

  try
    form1 := Tform1.CreateParented(hw); // **
    form1.Width := Width;
    form1.Height := Height;
    Result := True
  except
    on e: exception do
    begin
      Result := False;
    end;
  end;
end;

procedure closeApp; stdcall;
begin
  ApplicationClosed := True;
  try
    if mHandle <> 0 then
      CloseHandle(mHandle);
  except
  end;
  if Assigned(form1) then
    try
      FreeAndNil(form1);
    except
    end;
  try
    OptimizeRamUsage;
  except
  end;
end;



procedure showapp; stdcall;
begin

  try
    form1.Visible := True;
  except
  end;
  form1.Show;
end;



procedure DLLEntryProc(EntryCode: Integer);
begin
  case EntryCode of
    DLL_PROCESS_DETACH:
      begin
        StyleServices.Free;
      end;
    DLL_PROCESS_ATTACH:
      begin

      end;
    DLL_THREAD_ATTACH:
      begin

      end;
    DLL_THREAD_DETACH:
      begin

      end;
  end;
end;

exports
  closeApp,
  createApp,
  showapp;

begin

  DllProc := @DLLEntryProc;


end.
该错误表示正在线程ID与RTL的global System.MainThreadID变量不匹配的线程中调用CheckSynchronize

DLL没有自己的主线程。mainthreaid初始化为初始化DLL的任何线程。因此,如果DLL在不同于初始化DLL的线程中创建其GUI,请选中Synchronize和TThread.Synchronize以及TThread.Queue,除非手动将MainThreadID变量更新为运行GUI的ThreadID。在创建辅助线程之前执行此操作,例如:

if IsLibrary then
  MainThreadID := GetCurrentThreadID;
Form1 := TForm1.Create(nil);
或:

或:


您显示了线程代码和GUI代码,但DLL代码在哪里?谁在重新加载DLL以及何时重新加载?DLL在何时何地创建其GUI?@RemyLebeau添加的DLL代码我将该DLL用作activex中的加载库当ie重新加载时,同步错误开始出现我将查看您的答案您正在名为createApp的导出函数中创建GUI。调用进程在哪个线程上下文中调用createApp?听起来好像加载DLL的线程上下文不同。另外,为什么要手动释放StyleServices对象?在深入查看后,每次我刷新ie检查同步错误时,activex窗体上都会显示检查同步错误,我添加了activeform和问题中所需的所有代码
library dllapp;

uses
  System.SysUtils,
  Themes,
  Windows,
  Forms,
  dialogs,
  Graphics,
  Vcl.ExtCtrls,
  Unit1 in 'Unit1.pas' {Unit1},
  DThreadsend in 'Thread.pas';




var
  mHandle: THandle;
  DLLHandle: Longint = 0;

function createApp(Width: Integer; Height: Integer; hw: HWnd;
  app: TApplication): boolean; stdcall;
begin

  mHandle := CreateMutex(nil, True, 'APPNAMETLOAD');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    Halt;
  end;

  try
    form1 := Tform1.CreateParented(hw); // **
    form1.Width := Width;
    form1.Height := Height;
    Result := True
  except
    on e: exception do
    begin
      Result := False;
    end;
  end;
end;

procedure closeApp; stdcall;
begin
  ApplicationClosed := True;
  try
    if mHandle <> 0 then
      CloseHandle(mHandle);
  except
  end;
  if Assigned(form1) then
    try
      FreeAndNil(form1);
    except
    end;
  try
    OptimizeRamUsage;
  except
  end;
end;



procedure showapp; stdcall;
begin

  try
    form1.Visible := True;
  except
  end;
  form1.Show;
end;



procedure DLLEntryProc(EntryCode: Integer);
begin
  case EntryCode of
    DLL_PROCESS_DETACH:
      begin
        StyleServices.Free;
      end;
    DLL_PROCESS_ATTACH:
      begin

      end;
    DLL_THREAD_ATTACH:
      begin

      end;
    DLL_THREAD_DETACH:
      begin

      end;
  end;
end;

exports
  closeApp,
  createApp,
  showapp;

begin

  DllProc := @DLLEntryProc;


end.
unit loadapp;

interface
uses windows, forms, System.SysUtils , dialogs;

procedure loadmainapp;

type
  TcreaFunc = function (Width: Integer; Height: Integer; hw:HWnd; app: TApplication): boolean; stdcall;
  TshowFunc = procedure stdcall;
  TCloseAppFunc = procedure stdcall;


  var
  dllHandle : THandle = 0;
  creaFunc : TcreaFunc;
  showFunc : TshowFunc;
  CloseAppFunc: TCloseAppFunc;

implementation
 uses  Mainapp;

procedure loadmainapp;
var
  S: widestring;
  PW: PWideChar;
begin
S := 'dllapp.dll';

  pw:=pwidechar(widestring(s));
  dllHandle := LoadLibrary(pw);
  if dllHandle <> 0 then
  begin
    @creaFunc := GetProcAddress(dllHandle, 'createApp');
    @showFunc := GetProcAddress(dllHandle, 'showapp');
    if Assigned (creaFunc) then
    begin
      creaFunc(mainfrm.panel1.Width, mainfrm.panel1.Height, mainfrm.panel1.Handle, Application);
      DisFunc;
    end
    else
      ShowMessage('ERROR');

  end
  else
  begin
    ShowMessage('ERROR');
  end;
end;

end.
unit activeform;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, Frmldr_TLB, StdVcl, Vcl.ExtCtrls, ShlObj, Vcl.StdCtrls, SHDocVw, MSHTML;

type
  TActiveFrmldr = class(TActiveForm, IActiveFrmldr)
    mpanl: TPanel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }

  protected
    { Protected declarations }

  public
    { Public declarations }
  end;







implementation

uses ComObj, ComServ, Mainapp, libacload;

{$R *.DFM}

{ TActiveFrmldr }


procedure TActiveFrmldr.FormDestroy(Sender: TObject);
begin
if dllHandle <> 0 then
begin
@CloseAppFunc := GetProcAddress(dllHandle, 'closeApp');
CloseAppFunc;
FreeLibrary(dllHandle);  //release dll
end;


if Assigned(mainfrm) then
try
FreeAndNil(mainfrm);
except
end;

end;

procedure TActiveFrmldr.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
mainfrm.Parent := mpanl;
mainfrm.Left := 0;
mainfrm.Top  := 0;
mainfrm.Width := self.Width;
mainfrm.Height := self.Height;
mainfrm.Align := alClient;
mainfrm.Show;
end;


procedure TActiveFrmldr.FormCreate(Sender: TObject);
begin
Application.CreateForm(Tmainfrm, mainfrm);
Timer1.Enabled := True;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TActiveFrmldr,
    Class_ActiveFrmldr,
    0,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);

finalization

end.
unit Mainapp;

interface

uses
  Windows, Messages, System.SysUtils, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.Classes, libacload,
  Vcl.Controls, Vcl.StdCtrls;

type
  Tmainfrm = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;


var
  mainfrm: Tmainfrm;

implementation
Uses loadapp;

{$R *.dfm}



procedure Tmainfrm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;

procedure Tmainfrm.Timer1Timer(Sender: TObject);
begin

Timer1.Enabled := False;

loadmainapp;

end;

procedure Tmainfrm.Timer2Timer(Sender: TObject);
begin 
checksynchronize; // i do this to check some thread in activex it self 
end;

end.
if IsLibrary then
  MainThreadID := GetCurrentThreadID;
Form1 := TForm1.Create(nil);
procedure TForm1.FormCreate(Sender: TObject);
begin
  if IsLibrary then
    MainThreadID := GetCurrentThreadID;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  if IsLibrary then
    MainThreadID := GetCurrentThreadID;
  APPTHREAD := TAPPTHREAD.Create(false, CallbackProc);
  Timer2.Enabled := True;
end;