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

时间:2017-06-29 08:57:12

标签: delphi delphi-xe2 delphi-10-seattle

我在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.

1 个答案:

答案 0 :(得分:1)

您需要确保消息CM_ACTIONEXECUTECM_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。
  4. 此外,您需要捕获Run_TestDLL中的所有异常。