Delphi XE2，Delphi 10 西雅图，应用程序句柄，DLL，操作错误

Question

我在 Delphi XE2 中创建了 App.exe 个应用程序，然后在 Delphi 10 Seattle 中创建了 DLL。当我在调用 DLL 后将 Application.Handle 传递给 DLL 时，出现错误 "Exception class .... 'floating point stack check ...'"。当我从 EXE 分配中删除 Application.Handle 时，DLL 正常。我注意到这与连接到 controlek 的 TAction 操作有关。例如到 MainMenu。我还要补充一点，当从 Delphi 10 Seattle 中编写的 EXE 调用 DLL 时，一切正常。

感谢您的帮助。

下面附上一些代码

代码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.

代码 Delphi 10 西雅图

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.

Answer 1

您需要确保消息 CM_ACTIONEXECUTE 和 CM_ACTIONUPDATE 不会从 DLL 中的 VCL 代码发送到 EXE 中的 VCL 代码（因为它们具有不同的运行时和不同的 TAction 对象）。

有几种方法：

挂钩 window TApplication.Handle window 过程并过滤消息。例如，在以下位置查看 HookApplication 和 UnhookApplication： https://github.com/achechulin/loodsman/blob/master/Loodsman/Loodsman.Infrastructure.PluginUtils.pas
向所有 TAction 对象添加 OnUpdate 和 OnExecute 处理程序。
根本不要使用 TAction。

此外，您需要捕获 Run_TestDLL 中的所有异常。

Delphi XE2，Delphi 10 西雅图，应用程序句柄，DLL，操作错误

Delphi XE2, Delphi 10 Seattle, Application Handle, Dll, Action Error

delphi

delphi-xe2

delphi-10-seattle