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