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

Question

我在 Delphi XE2 中创建了 App.exe 应用程序，然后在 Delphi 10 Seattle 中创建了 DLL。当我在调用 DLL 后将 Application.Handle 传递给 DLL 时，出现错误“异常类 ....'浮点堆栈检查 ...'”。当我从 EXE 分配中删除 Application.Handle 时，DLL 正常。我注意到这与连接到 controlek 的 TAction 操作有关。例如到主菜单。我还要补充一点，当从 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)对象)。

有几种方法:

1. TApplication.Handle 窗口的 Hook 窗口过程和过滤消息。例如，请参阅 HookApplication 和 UnhookApplication，网址为: https://github.com/achechulin/loodsman/blob/master/Loodsman/Loodsman.Infrastructure.PluginUtils.pas
2. 向所有 TAction 对象添加 OnUpdate 和 OnExecute 处理程序。
3. 根本不要使用 TAction。

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