Delphi XE2、Delphi 10 Seattle、应用程序句柄、Dll、操作错误

Question

我在 Delphi XE2 中创建了 App.exe 应用程序，然后在 Delphi 10 Seattle 中创建了 DLL。当我在调用 DLL 后将 Application.Handle 传递给 DLL 时，出现错误“异常类 ....'浮点堆栈检查 ...'”。当我从 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 对象）。

有几种方法：

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

另外，您需要在 Run_TestDLL 中捕获所有异常。