Delphi7 开发 DLL 及调用

Dll 项目

创建 DLL 项目

File > New > Other... 打开新建对话框，新建一个 DLL 项目。

代码

Object > View Source 查看项目源码默认效果如下：

library DllProject;

uses
  SysUtils,  Classes;

{$R *.res}

begin
end.

按里说函数的实现部分应该放在单元里。这果偷懒就没建单元了。

library DllProject;

uses
  SysUtils, Classes, Dialogs; // 用到了 ShowMessage 这里加上 Dialogs
  
// ------------------------------ 这里实现两个方法 -------------------------------- 
function test():Integer; Export; stdcall;
begin
  ShowMessage('调用成功！');
  Result := 0; // 函数返回值，写法一（Result ）
end;

function ShowForm(var username, password, p3, p4, p5: PAnsiChar):Integer; Export; stdcall;
var
  _str1: string[10];     //第一个参数
  _str2: string[10];     //第二个参数
  _str3: string[10];     //第三个参数
  _str4: string[10];     //第四个参数
  _str5: string[10];     //第五个参数
begin
  _str1 := ShortString(PChar(username));  // PChar 转  ShortString
  _str2  := ShortString(PChar(password)); // PChar 转  ShortString
  _str3  := ShortString(PChar(p3));       // PChar 转  ShortString
  _str4  := ShortString(PChar(p4));       // PChar 转  ShortString
  _str5  := ShortString(PChar(p5));       // PChar 转  ShortString

  ShowMessage('调用成功: ' +  _str1 + '; ' +  _str2 + '; ' +  _str3 + '; ' +  _str4 + '; ' +  _str5);
  p3:= '笨笨的笨';
  ShowForm := 0; // 函数返回值，写法二（函数名）
end;

// -------------- 导出函数给外面用 (如果是重载的话，需要写参数列表) -------------- 
exports
  test, ShowForm;

{$R *.res}

begin
end.

借助 Dependency Walker 看导出

可以看到，两个函数都已经成功导出了。

Exe 宿主

静态加载

新建一个窗体项目，拖两个按钮出来。

然后添加函数声明和点击事件的内容：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    btn_1: TButton;
    btn_2: TButton;
    procedure btn_1Click(Sender: TObject);
    procedure btn_2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  // ------------------- 添加声明从DLL中引用函数 -------------------
  function test():Integer; stdcall; External 'DllProject.dll'; // 当前目录下的 dll
  function ShowForm(var username, password,p3,p4,p5: PAnsiChar):Integer; stdcall; External 'DllProject.dll'; // 当前目录下的 dll

implementation

{$R *.dfm}

// ------------------- 为两个按钮添加点击事件 -------------------
procedure TForm1.btn_1Click(Sender: TObject);
begin
  test();
end;

procedure TForm1.btn_2Click(Sender: TObject);
var
  username: PChar;
  password: PChar;
  p3: PChar;
  p4: PChar;
  p5: PChar;
  intResult: Integer;
begin
  username := 'jerryjin';
  password := '笨笨';
  p3 := '3014';
  p4 := 'D:\Servercj';
  p5 := 'show';

  intResult := ShowForm(username, password, p3, p4, p5);
end;

end.

External

external 指令声明外部函数和过程。

动态加载

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    btn_test: TButton;
    lbledt_dll: TLabeledEdit;
    btn_exe: TButton;
    btn_showForm: TButton;
    procedure btn_testClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn_exeClick(Sender: TObject);
    procedure btn_showFormClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DllHandle: THandle;

implementation

{$R *.dfm}
// 关闭窗口事件
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeLibrary(DllHandle); // 销毁DLL句柄，释放资源
end;

// 【加载DLL】-点击事件
procedure TForm1.btn_testClick(Sender: TObject);
begin
  try
    DllHandle := LoadLibrary(PChar(lbledt_dll.Text));
    if DllHandle = 0 then
      raise Exception.Create('加载DLL失败！');
    btn_exe.Enabled := true;
    btn_showForm.Enabled := true;
  except
    on E: Exception do ShowMessage(E.Message);
  end;
end;

// 【执行test】-点击事件
procedure TForm1.btn_exeClick(Sender: TObject);
var
  myFunc: function():Integer; stdcall;
  i: Integer;
begin
  try
    myFunc := GetProcAddress(DllHandle, 'test');
    if Assigned(myFunc) then begin
      i := myFunc();
      ShowMessage('结果：' + IntToStr(i));
    end else
      ShowMessage('加载test失败！');
  except
    on E: Exception do ShowMessage(E.Message);
  end;
end;

// 【执行ShowForm】-点击事件
procedure TForm1.btn_showFormClick(Sender: TObject);
var
  myFunc: function(var p1,p2,p3,p4,p5: PAnsiChar):Integer; stdcall;
  i: Integer;
  p1,p2,p3,p4,p5:PAnsiChar;
begin
  p1:= '大家好';
  p2:= '我是笨笨';
  p3:= '笨笨地笨';
  p4:= '笨笨的笨';
  p5:= '谢谢！';
  try
    myFunc := GetProcAddress(DllHandle, 'ShowForm');
    if Assigned(myFunc) then begin
      i := myFunc(p1, p2, p3, p4, p5);
      ShowMessage('结果：' + IntToStr(i) + ';' + #13#10 + 'p3修正：'+ p3);
    end else
      ShowMessage('加载ShowForm失败！');
  except
    on E: Exception do ShowMessage(E.Message);
  end;
end;

end.

注意：加载 ShowForm 时参数是 var 的表示传址。要与DLL中的声明保持一至。因为是传址的，DLL中才能修改p3。

LoadLibrary 加载DLL

• function LoadLibrary; external kernel32 name ‘LoadLibraryA’;
• 将指定的模块加载到调用进程的地址空间中。 指定的模块可能导致加载其他模块。

GetProcAddress 获取函数

• function GetProcAddress; external kernel32 name ‘GetProcAddress’;
• 从指定的动态链接库 (DLL) 检索导出函数 (也称为过程) 或变量。

FreeLibrary 释放DLL

• function FreeLibrary; external kernel32 name ‘FreeLibrary’;
• 释放加载的动态链接库 (DLL) 模块，并在必要时递减其引用计数。 当引用计数达到零时，将从调用进程的地址空间卸载模块，并且句柄不再有效。

参考资料

Dependency Walker 2.2