我在Delphi XE2中创建了App.exe应用程序,然后在Delphi 10 Seattle中创建了DLL。当我在调用DLL后将Application.Handle传递给DLL时,我得到一个错误“Exception class ....'浮点堆栈检查...'”。当我从EXE赋值中删除Application.Handle时,DLL就可以了。我注意到这与连接到controlek的TAction动作有关。例如MainMenu。我还要补充一点,当从用Delphi 10 Seattle编写的EXE调用DLL时,一切正常。
感谢您的帮助。
下面我附上一些代码
Code Delphi XE2
unit Form_MainApp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons;
type
TfrmMainApp = class(TForm)
btnRunDLL: TBitBtn;
procedure btnRunDLLClick(Sender: TObject);
private
public
end;
var
frmMainApp: TfrmMainApp;
implementation
{$R *.dfm}
procedure TfrmMainApp.btnRunDLLClick(Sender: TObject);
const
LibraryFolder = '\Library\';
DLLName = LibraryFolder + 'TestDLL.dll';
type
TDLLProc = Function(pAppHandle:HWND; pAppTitle:PChar; pId:Integer; var pOUTId:Integer): TModalResult; StdCall;
var
DLLHandle: THandle;
DLLProc: TDLLProc;
DLLResult: TModalResult;
OUTId: Integer;
LibraryName: String;
begin
LibraryName:=ExtractFileDir(Application.ExeName) + DLLName;
DLLHandle:=Winapi.Windows.LoadLibrary(PChar(LibraryName));
try
if DLLHandle <> 0 then
begin
@DLLProc:=Winapi.Windows.GetProcAddress(DLLHandle, PChar('Run_TestDLL'));
if (@DLLProc <> nil) then
DLLResult:=DLLProc(Application.Handle, PChar(Application.Title), 0, OUTId);
end;
finally
if DLLHandle <> 0 then
Winapi.Windows.FreeLibrary(DLLHandle);
end;
end;
end.
Code Delphi 10 Seattle
library TestDLL;
uses
System.SysUtils,
System.Classes,
Controls,
Forms,
Dialogs,
Windows,
Form_MainDLL in 'Form_MainDLL.pas' {frmMainDLL};
{$R *.res}
Function Run_TestDLL(pAppHandle:HWND; pAppTitle:PChar; pId:Integer; var pOUTId:Integer):TModalResult; StdCall;
begin
Application.Handle:=pAppHandle;
Result:=mrNone;
try
frmMainDLL:=TfrmMainDLL.Create('Test');
frmMainDLL.ShowModal;
finally
FreeAndNil(frmMainDLL);
Result:=mrOk;
end;
end;
exports
Run_TestDLL;
begin
ReportMemoryLeaksOnShutdown:=True;
Randomize;
end.
DLL中的FORM
unit Form_MainDLL;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
cxEdit, dxBar, Vcl.ExtCtrls, System.Actions,
Vcl.ActnList, Vcl.Menus, Vcl.StdCtrls;
type
TfrmMainDLL = class(TForm)
mmMain: TMainMenu;
mmEdit: TMenuItem;
mmAdd: TMenuItem;
mmData: TMenuItem;
mmClose: TMenuItem;
mmOpen: TMenuItem;
btnSetAction: TButton;
alMain: TActionList;
acAdd: TAction;
procedure acAddExecute(Sender: TObject);
procedure btnSetActionClick(Sender: TObject);
private
fName: String;
public
constructor Create(pName:String);reintroduce; virtual;
destructor Destroy; Override;
end;
var
frmMainDLL: TfrmMainDLL;
implementation
{$R *.dfm}
constructor TfrmMainDLL.Create(pName:String);
begin
inherited Create(Nil);
fName:=pName;
end;
destructor TfrmMainDLL.Destroy;
begin
inherited;
end;
procedure TfrmMainDLL.acAddExecute(Sender: TObject);
begin
ShowMessage('TEST');
end;
procedure TfrmMainDLL.btnSetActionClick(Sender: TObject);
begin
mmAdd.Action:=acAdd;
mmAdd.OnClick:=acAddExecute;
end;
end.
答案 0 :(得分:1)
您需要确保消息CM_ACTIONEXECUTE
和CM_ACTIONUPDATE
不会从DLL中的VCL代码发送到EXE中的VCL代码(因为它们具有不同的运行时和不同的TAction对象)。
有几种方法:
此外,您需要捕获Run_TestDLL中的所有异常。