Delphi实现DLL调用主窗体函数

技术包含

1、DLL的创建与调用

2、接口的创建与实现

3、接口函数的实现

4、DLL调用主窗体函数

调用流程

1、声明接口函数单元，创建接口与函数

2、创建主窗体，引用接口单元，实现接口函数

3、创建DLL引用接口单元，调用主窗体实现的接口函数

代码如下

 

/***************接口单元代码************************/

unit uBase;

interface
uses
Vcl.Forms,System.SysUtils,Vcl.Dialogs;
type
ITest=interface
['{A07F6E22-209B-43F5-8CF8-5B44EFF6ACBD}']
function GetValue(sBM:WideString):WideString;
end;
function writemem(str:WideString):WideString;
var
MainApp: TApplication;

implementation

function writemem(str:WideString):WideString;
var
FWSysLog:ITest;
begin

if Supports(MainApp.MainForm, ITest, FWSysLog) then //判断主模块是否实现了接口？如果实现就调用！
Result :=FWSysLog.GetValue(str);

end;

end.

 

 

 

/*******************主窗体代码***********************/

unit uMain;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxLookAndFeels,
cxLookAndFeelPainters, Vcl.Menus, dxSkinsCore, dxSkinsDefaultPainters,
cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, Vcl.StdCtrls, cxButtons,uBase;

type
TfrmMain = class(TForm,ITest)
cxButton1: TcxButton;
cxMemo1: TcxMemo;
procedure cxButton1Click(Sender: TObject);
private
{ Private declarations }
function GetValue(sBM:WideString):WideString;//stdcall;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TfrmMain }

procedure TfrmMain.cxButton1Click(Sender: TObject);
type
TmyDiaoYong = function (MainApplication:TApplication;sBM:WideString):WideString; stdcall;
var
hDll:Thandle;

pFnc:TFarProc;

myDiaoYong:TmyDiaoYong;
begin
hDll := Loadlibrary(pchar('C:\DelphiWorkSpace\接口\主界面\MyFirstDLL.dll'));
if hDll <> 0 then
begin
try
try

pFnc := GetProcAddress(hDll, 'MyDLL');
if pFnc = nil then
begin
ShowMessage('DLL中为找到函数MyDLL，请联系管理员！');
Exit;
end;

myDiaoYong := TmyDiaoYong(pFnc);

ShowMessage(myDiaoYong(Application,'1'));

finally
FreeLibrary(hDLL);
end;
except
on E: exception do
begin
ShowMessage('DLL异常' + e.Message);
Exit;
end;
end;
end
end;

function TfrmMain.GetValue(sBM:WideString):WideString;
begin

if sBM='1' then
begin
Result := '男';
end else
begin
Result := '女';
end;
end;

end.

 

/*******************DLL代码*************************/

library MyFirstDLL;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
Vcl.Forms,
System.SysUtils,
System.Classes,
uDemo in 'uDemo.pas',
uBase in '..\主界面\uBase.pas';

{$R *.res}
function MyDLL(MainApplication:TApplication;sBMM:WideString):WideString;stdcall;
begin
MainApp := MainApplication;

Result := Test(sBMM);
end;
exports
MyDLL;
begin
end.

 

unit uDemo;

interface
uses
Vcl.Forms,System.SysUtils,uBase,Winapi.Windows,Vcl.Dialogs;
function Test(sBM:WideString):WideString;
implementation

function Test(sBM:WideString):WideString;
begin

Result := writemem(sBM);
end;

end.