意外的线程行为调用 Delphi DLL
Unexpected Thread behaviour calling Delphi DLL
从我的另一个问题继续:
我使用 编写了 DLL。 DLL 使用 IXMLDocument
(起初我认为与以下问题有关)
测试了它,它在主要 UI 中运行良好。当我从工作线程调用 DLL 时,问题就开始了。
DLL:
library MyDLL;
uses
Windows,
Variants,
SysUtils,
Classes,
AxCtrls,
ActiveX,
XMLDoc,
XMLIntf;
{$R *.res}
procedure Debug(V: Variant);
begin
OutputDebugString(PChar(VarToStr(V)));
end;
procedure DoProcess(InStream, OutStream: TStream);
var
Doc: IXMLDocument;
begin
InStream.Position := 0;
Doc := TXMLDocument.Create(nil);
Doc.LoadFromStream(InStream);
// plans to do some real work...
OutStream.Position := 0;
Debug('MyDLL DoProcess OK');
end;
function Process(AInStream, AOutStream: IStream): Integer; stdcall;
var
InStream, OutStream: TStream;
begin
try
InStream := TOleStream.Create(AInStream);
try
OutStream := TOleStream.Create(AOutStream);
try
DoProcess(InStream, OutStream);
Result := 0;
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
except
on E: Exception do
begin
Result := -1;
Debug('MyDLL Error: ' + E.Message);
end;
end;
end;
exports
Process;
begin
end.
我的调用者应用程序:
implementation
uses
ActiveX,ComObj;
{$R *.dfm}
procedure Debug(V: Variant);
begin
OutputDebugString(PChar(VarToStr(V)));
end;
const
MyDLL = 'MyDLL.dll';
{$DEFINE STATIC_DLL}
{$IFDEF STATIC_DLL}
function Process(AInStream, AOutStream: IStream): Integer; stdcall; external MyDLL;
{$ENDIF}
type
// Dynamic
TDLLProcessProc = function(AInStream, AOutStream: IStream): Integer; stdcall;
function DLLProcess(AInStream, AOutStream: TStream): Integer;
var
InStream, OutStream: IStream;
Module: HMODULE;
DLLProc: TDLLProcessProc;
begin
InStream := TStreamAdapter.Create(AInStream, soReference);
OutStream := TStreamAdapter.Create(AOutStream, soReference);
{$IFDEF STATIC_DLL}
Result := Process(InStream, OutStream); // Static
Exit;
{$ENDIF}
// Dynamic load DLL ...
Module := LoadLibrary(MyDLL);
if Module = 0 then RaiseLastOSError;
try
DLLProc := GetProcAddress(Module, 'Process');
if @DLLProc = nil then RaiseLastOSError;
Result := DLLProc(InStream, OutStream);
finally
FreeLibrary(Module);
end;
end;
type
TDLLThread = class(TThread)
private
FFileName: string;
public
constructor Create(CreateSuspended: Boolean; AFileName: string);
procedure Execute(); override;
end;
constructor TDLLThread.Create(CreateSuspended: Boolean; AFileName: string);
begin
FreeOnTerminate := True;
FFileName := AFileName;
inherited Create(CreateSuspended);
end;
procedure TDLLThread.Execute;
var
InStream, OutStream: TMemoryStream;
RetValue: Integer;
begin
try
//CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
CoInitialize(nil);
try
InStream := TMemoryStream.Create;
try
InStream.LoadFromFile(FFileName);
OutStream := TMemoryStream.Create;
try
RetValue := DLLProcess(InStream, OutStream);
Sleep(0);
Debug('TDLLThread Result=> ' + IntToStr(RetValue));
if RetValue = 0 then
begin
Debug('TDLLThread OK');
end;
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
finally
CoUninitialize;
end;
except
on E: Exception do
begin
Debug('TDLLThread Error: ' + E.Message);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject); // Test
var
I: Integer;
begin
for I := 1 to 5 do
TDLLThread.Create(False, '1.xml');
end;
当 运行 一些测试时,我 有时 得到访问冲突,即使是异常块也无法捕获。并且程序会因 Runtime error 216 at xxxxxxx
或 Invalid pointer operation
.
而崩溃
我已经尝试了静态和动态 DLL 链接(估计 可能 动态链接在 LoadLibrary/FreeLibrary 中有竞争条件。
首先我认为 IXMLDocument
是主要问题:
Doc := TXMLDocument.Create(nil);
Doc.LoadFromStream(InStream);
这有时会在没有明显原因的情况下随机失败:
Invalid at the top level of the
document.
或:
A name was started with an invalid character.
我想它可能使用了一些共享资源。但即使 省略这些行 也会导致 AV!
所以 DLL 实际上没有做任何特别的事情。
我也没有看到任何可以感染 DLLMain
.
的特殊情况
我不知道发生了什么...有人可以建议如何处理这种情况吗? (有人可以重现这种行为吗?)
编辑:我只想添加一个相关问题(具有类似的 IsMultiThread
解决方案):
Delphi DLL - thread safe
关于 IsMultiThread
的一些提示:
IsMultiThread Variable
Delphi 中的内存管理器针对单线程使用进行了优化。默认情况下启用这些。如果您的代码是多线程的,则需要禁用此优化。通过将 IsMultiThread
设置为 True
来实现。
在创建 Delphi 线程的模块中,框架在创建线程时将 IsMultiThread
设置为 True
。在您的程序中,线程是由主机创建的,因此库中没有任何内容将 IsMultiThread
设置为 True
。所以你必须在 DLL 中明确地这样做。在库 .dpr 文件的主要部分写下:
begin
IsMultiThread := True;
end.
从我的另一个问题继续:
我使用 IXMLDocument
(起初我认为与以下问题有关)
测试了它,它在主要 UI 中运行良好。当我从工作线程调用 DLL 时,问题就开始了。
DLL:
library MyDLL;
uses
Windows,
Variants,
SysUtils,
Classes,
AxCtrls,
ActiveX,
XMLDoc,
XMLIntf;
{$R *.res}
procedure Debug(V: Variant);
begin
OutputDebugString(PChar(VarToStr(V)));
end;
procedure DoProcess(InStream, OutStream: TStream);
var
Doc: IXMLDocument;
begin
InStream.Position := 0;
Doc := TXMLDocument.Create(nil);
Doc.LoadFromStream(InStream);
// plans to do some real work...
OutStream.Position := 0;
Debug('MyDLL DoProcess OK');
end;
function Process(AInStream, AOutStream: IStream): Integer; stdcall;
var
InStream, OutStream: TStream;
begin
try
InStream := TOleStream.Create(AInStream);
try
OutStream := TOleStream.Create(AOutStream);
try
DoProcess(InStream, OutStream);
Result := 0;
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
except
on E: Exception do
begin
Result := -1;
Debug('MyDLL Error: ' + E.Message);
end;
end;
end;
exports
Process;
begin
end.
我的调用者应用程序:
implementation
uses
ActiveX,ComObj;
{$R *.dfm}
procedure Debug(V: Variant);
begin
OutputDebugString(PChar(VarToStr(V)));
end;
const
MyDLL = 'MyDLL.dll';
{$DEFINE STATIC_DLL}
{$IFDEF STATIC_DLL}
function Process(AInStream, AOutStream: IStream): Integer; stdcall; external MyDLL;
{$ENDIF}
type
// Dynamic
TDLLProcessProc = function(AInStream, AOutStream: IStream): Integer; stdcall;
function DLLProcess(AInStream, AOutStream: TStream): Integer;
var
InStream, OutStream: IStream;
Module: HMODULE;
DLLProc: TDLLProcessProc;
begin
InStream := TStreamAdapter.Create(AInStream, soReference);
OutStream := TStreamAdapter.Create(AOutStream, soReference);
{$IFDEF STATIC_DLL}
Result := Process(InStream, OutStream); // Static
Exit;
{$ENDIF}
// Dynamic load DLL ...
Module := LoadLibrary(MyDLL);
if Module = 0 then RaiseLastOSError;
try
DLLProc := GetProcAddress(Module, 'Process');
if @DLLProc = nil then RaiseLastOSError;
Result := DLLProc(InStream, OutStream);
finally
FreeLibrary(Module);
end;
end;
type
TDLLThread = class(TThread)
private
FFileName: string;
public
constructor Create(CreateSuspended: Boolean; AFileName: string);
procedure Execute(); override;
end;
constructor TDLLThread.Create(CreateSuspended: Boolean; AFileName: string);
begin
FreeOnTerminate := True;
FFileName := AFileName;
inherited Create(CreateSuspended);
end;
procedure TDLLThread.Execute;
var
InStream, OutStream: TMemoryStream;
RetValue: Integer;
begin
try
//CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
CoInitialize(nil);
try
InStream := TMemoryStream.Create;
try
InStream.LoadFromFile(FFileName);
OutStream := TMemoryStream.Create;
try
RetValue := DLLProcess(InStream, OutStream);
Sleep(0);
Debug('TDLLThread Result=> ' + IntToStr(RetValue));
if RetValue = 0 then
begin
Debug('TDLLThread OK');
end;
finally
OutStream.Free;
end;
finally
InStream.Free;
end;
finally
CoUninitialize;
end;
except
on E: Exception do
begin
Debug('TDLLThread Error: ' + E.Message);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject); // Test
var
I: Integer;
begin
for I := 1 to 5 do
TDLLThread.Create(False, '1.xml');
end;
当 运行 一些测试时,我 有时 得到访问冲突,即使是异常块也无法捕获。并且程序会因 Runtime error 216 at xxxxxxx
或 Invalid pointer operation
.
我已经尝试了静态和动态 DLL 链接(估计 可能 动态链接在 LoadLibrary/FreeLibrary 中有竞争条件。
首先我认为 IXMLDocument
是主要问题:
Doc := TXMLDocument.Create(nil);
Doc.LoadFromStream(InStream);
这有时会在没有明显原因的情况下随机失败:
Invalid at the top level of the document.
或:
A name was started with an invalid character.
我想它可能使用了一些共享资源。但即使 省略这些行 也会导致 AV!
所以 DLL 实际上没有做任何特别的事情。
我也没有看到任何可以感染 DLLMain
.
我不知道发生了什么...有人可以建议如何处理这种情况吗? (有人可以重现这种行为吗?)
编辑:我只想添加一个相关问题(具有类似的 IsMultiThread
解决方案):
Delphi DLL - thread safe
关于 IsMultiThread
的一些提示:
IsMultiThread Variable
Delphi 中的内存管理器针对单线程使用进行了优化。默认情况下启用这些。如果您的代码是多线程的,则需要禁用此优化。通过将 IsMultiThread
设置为 True
来实现。
在创建 Delphi 线程的模块中,框架在创建线程时将 IsMultiThread
设置为 True
。在您的程序中,线程是由主机创建的,因此库中没有任何内容将 IsMultiThread
设置为 True
。所以你必须在 DLL 中明确地这样做。在库 .dpr 文件的主要部分写下:
begin
IsMultiThread := True;
end.