在 Delphi 2007 DLL 和 XE6 EXE 之间传递 PChar

Question

我有一个用 Delphi 2007 编写的 DLL，由于各种原因，我无法转换为在 XE6 中编译。

我在 XE6 中编写了一个调用 DLL 的小测试应用程序，这一切都很好，但是我需要将字符串数据从 DLL 传递给 exe，并且我正在使用 PCHAR 来执行此操作。 但是，事实证明，在 XE6 exe 中使用 PCHAR 有点痛苦。

我在某处读到，在 D2007 中，PCHAR 实际上是 PANSICHAR，所以我尝试使用 PANSICHAR 并调用 DLL，但它只返回一个空字符串！

我尝试过各种其他类型，例如 PWIDECHAR、String、WideString、ShortString 和 PCHAR。 PCHAR 确实返回了一些看起来像宽字符串的东西，但我不确定它是否真的是因为它在我尝试时没有强制转换:-)

所以我想知道我做错了什么？我是否从 D2007 DLL 传递了错误的类型？我应该在 XE6 中以不同的方式使用数据吗？

-- 编辑-- 好的，根据 Remy 的想法，我没有得到任何结果，所以这次我已经包含了我的代码，我相信解决方案对某人来说是显而易见的。感谢您的帮助:-)

这是用 D2007 编写的 DLL 的代码：

library mydll;

  uses
    SysUtils

type
  TOnCommandProc = procedure(sMessage:PAnsiChar);
stdcall;

var
  FOnCommandProc: TOnCommandProc = nil;

procedure SetOnCommandProc(CallbackProc: TOnCommandProc);
stdcall;
begin
  FOnCommandProc := CallbackProc;
end;

procedure OnEventMessage(Data: String);
var
 BuffSize: Integer;
 sOut: string;
 oData : PAnsiChar;
begin

  sOut:=Data;
  BuffSize:=SizeOf(Char)*(Length(sOut)+1);
  getmem(oData, BuffSize);
  FillChar(oData^,BuffSize,0);

  if (Length(sOut)>0) then
  begin
    Move(sOut[1], PAnsiChar(oData)^, BuffSize);
    FOnCommandProc(oData);
  end;
end;

procedure TryTheEvent;
begin
  OnEventMessage('Hello');
end;

exports
  SetOnCommandProc name 'SetOnCommandProc',
  TryTheEvent name 'TryTheEvent';
end.

这是用Delphi XE6编写的调用EXE代码：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TOnCommandProc = procedure(sMessage:PAnsiChar); stdcall;

  procedure SetOnCommandProc(CallbackProc: TOnCommandProc; sMessage:PAnsiChar); stdcall; external 'mydll.dll';
  procedure TryTheEvent; stdcall; external 'mydll.dll';

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    class procedure MyOnCommandProc(sMessage:PAnsiChar); stdcall; static;
    procedure OnCommand(sMessage : PAnsiChar);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  TryTheEvent;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetOnCommandProc(@MyOnCommandProc,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetOnCommandProc(nil,0);
end;

class procedure TForm1.MyOnCommandProc(sMessage:PAnsiChar); stdcall;
begin
  TForm1(sMessage).OnCommand(sMessage);
end;

procedure TForm1.OnCommand(sMessage :PAnsiChar);
begin
  showmessage(sMessage);
end;

end.

Answer 1

在 D2007 及更早版本中，String 是 AnsiString 的别名，PChar 是 PAnsiChar 的别名。

在 D2009 及更高版本中，String 是 UnicodeString 的别名，PChar 是 PWideChar 的别名。

如果您希望 XE6 项目调用 D2007 DLL，则必须使用 PAnsiChar 而不是 PChar 声明 DLL 类型/参数。在将PAnsiChar 指针传递到DLL 时，请务必使用AnsiString 或其他基于AnsiChar 的内存分配。如果您仍然遇到问题，请更新您的问题以显示无法正常工作的实际代码。

编辑：根据您现在显示的代码，试试这个代码：

D2007 DLL：

library mydll;

uses
  SysUtils;

type
  TOnCommandProc = procedure(sMessage: PChar; pUserData: Pointer); stdcall;

var
  FOnCommandProc: TOnCommandProc = nil;
  FOnCommandUserData: Pointer = nil;

procedure SetOnCommandProc(CallbackProc: TOnCommandProc; UserData: Pointer); stdcall;
begin
  FOnCommandProc := CallbackProc;
  FOnCommandUserData := UserData;
end;

procedure OnEventMessage(Data: String);
begin
  if (Data <> '') and Assigned(FOnCommandProc) then
  begin
    FOnCommandProc(PChar(Data), FOnCommandUserData);
  end;
end;

procedure TryTheEvent; stdcall;
begin
  OnEventMessage('Hello');
end;

exports
  SetOnCommandProc name 'SetOnCommandProc',
  TryTheEvent name 'TryTheEvent';
end.

XE6 应用：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TOnCommandProc = procedure(sMessage: PAnsiChar; pUserData: Pointer); stdcall;

  procedure SetOnCommandProc(CallbackProc: TOnCommandProc; UserData: Pointer); stdcall; external 'mydll.dll';
  procedure TryTheEvent; stdcall; external 'mydll.dll';

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    class procedure MyOnCommandProc(sMessage: PAnsiChar: pUserData: Pointer); stdcall; static;
    procedure OnCommand(sMessage : PAnsiChar);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  TryTheEvent;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetOnCommandProc(@MyOnCommandProc, Self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetOnCommandProc(nil, nil);
end;

class procedure TForm1.MyOnCommandProc(sMessage: PAnsiChar; pUserData: Pointer); stdcall;
begin
  TForm1(pUserData).OnCommand(sMessage);
end;

procedure TForm1.OnCommand(sMessage: PAnsiChar);
begin
  ShowMessage(sMessage);
end;

end.

Answer 2

我发现您的代码存在许多问题。具体来说：

• SetOnCommandProc 有一个参数。你在 EXE 中用两个声明它。
• 您在 DLL 中使用 register 调用约定实现 TryTheEvent，然后在 EXE 中将其声明为 stdcall。
• OnEventMessage 的实现是不必要的复杂，实际上是泄漏。
• EXE 代码执行错误的转换TForm1(sMessage)。 PAnsiChar 绝不是对象引用。
• 您使用@ 运算符来获取函数指针。这会抑制类型检查。

这是给您带来最多问题的第一点。但是你应该把它们都修好。

我会拥有这样的 DLL：

library mydll;

type
  TOnCommandProc = procedure(sMessage: PAnsiChar); stdcall;

var
  FOnCommandProc: TOnCommandProc = nil;

procedure SetOnCommandProc(CallbackProc: TOnCommandProc); stdcall;
begin
  FOnCommandProc := CallbackProc;
end;

procedure OnEventMessage(Data: AnsiString);
begin
  if Assigned(FOnCommandProc) then
    FOnCommandProc(PAnsiChar(Data));
end;

procedure TryTheEvent; stdcall;
begin
  OnEventMessage('Hello');
end;

exports
  SetOnCommandProc, TryTheEvent;

end.

还有这样的EXE：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    class procedure MyOnCommandProc(sMessage: PAnsiChar); stdcall; static;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TOnCommandProc = procedure(sMessage: PAnsiChar); stdcall;

procedure SetOnCommandProc(CallbackProc: TOnCommandProc); stdcall; external 'mydll.dll';
procedure TryTheEvent; stdcall; external 'mydll.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
  TryTheEvent;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetOnCommandProc(MyOnCommandProc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetOnCommandProc(nil);
end;

class procedure TForm1.MyOnCommandProc(sMessage: PAnsiChar);
begin
  ShowMessage(sMessage);
end;

end.

请注意，我已经完全删除了实例方法OnCommand。如果确实需要调用实例方法，则需要传递实例和回调函数。因此，您可以将实例引用传递给 DLL，键入为 Pointer，然后在回调中将该实例引用传回。