最近一直在测试BPL和DLL,总结一下这段时间的经验。
如果是模块化架构,就选择BPL,不要选择DLL,DLL可以对外做接口使用,不过Delphi接口我觉得DataSnap更方便点。为什么要用BPL呢,因为DLL是无法传递对象的,只能传递对象的内存地址过去。BPL就可以实现对象的传递。
使用BPL的注意事项,首先一定要注意Debug 和Release 两种编译是有很大区别的。直接Release编译最好,主程序也要用Release编译调用,如果编译类型不同,会有异常提示。BPL里面各个Form和Unit之间的调用,需要注意的如果用到了Form的控件,记得一定要把Form对象传过去。这样获取才不会出问题。BPL调用BPL的时候,也要把Form传过去,传回来的时候再转换回来。下面说下调用案例。
我是一个主程序,两个BPL
主程序调用的代码
procedure TFMenuItem.Label1DblClick(Sender: TObject);
var
BPLHandle: HMODULE;
frm: TCustomForm;
AClass : TPersistentClass;
SetUser:procedure(sform:TForm;User:String;IP:String;Port:Integer);
newPage:TAdvTabSheet;
Path:String;
ClassName:String;
SetName:String;
begin
//BPL的目录和名称
Path:='System/'+Copy(self.Caption,1,2)+'.bpl';
//调用的Form的名称
ClassName:='T'+self.Caption;
//BPL里面的过程名称
SetName:=self.Caption+'SetUser';
//加载BPL
BPLHandle := LoadPackage(Path);
//加载后获取过程
@SetUser := GetProcAddress(BPLHandle, Pchar(SetName));
if BPLHandle > 0 then
begin
//获取Form
AClass := FindClass(ClassName);
if AClass<>nil then
begin
//新增一个Page页面
newPage:=TAdvTabSheet.Create(FMyMain.AdvPageControl2);
newPage.Caption:=Label1.Caption;
newPage.Color:=clWhite;
newPage.AdvPageControl:=FMyMain.AdvPageControl2;
newPage.ShowClose:=True;
FMyMain.AdvPageControl2.ActivePage:=newPage;
//创建BPL的Form实例
frm:=TComponentClass(AClass).Create(Application) as TCustomForm;
if @SetUser<>nil then
//执行BPL里面的过程
SetUser(TForm(frm),'admin',FMyMain.DSRestConnection1.Host,FMyMain.DSRestConnection1.Port);
//放入新建的Page里面
frm.Parent:=newPage;
//显示
frm.Show;
// frm.Free;
end
end
end;
第一个BPL的代码
unit User;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, Vcl.ComCtrls, Vcl.ToolWin, System.ImageList, Vcl.ImgList,
Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, EhLibVCL, GridsEh,
DBAxisGridsEh, DBGridEh, AdvEdit, AdvEdBtn, Vcl.StdCtrls, Vcl.ExtCtrls,
Datasnap.DSClientRest, FireDAC.Stan.StorageJSON,
FireDAC.Stan.StorageXML, FireDAC.Stan.StorageBin,DataBase;
type
//定义回调过程
MeADD=procedure(DepCode:String;DepName:String;MyForm:TForm);
TF901 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit7: TEdit;
Edit6: TAdvEditBtn;
Panel2: TPanel;
DBGridEh1: TDBGridEh;
Panel3: TPanel;
DataSource1: TDataSource;
FDMemTable1: TFDMemTable;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton10: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure Edit6ClickBtn(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
var
UserNo:String;
MyDataBase:TDDataBase;
end;
//定义给主程序调用的过程
procedure F901SetUser(sform:TForm;UserNo:String;IP:String;Port:Integer);
//定义一个跟回调过程一样的过程,这个用于回调过程功能实现
procedure SetDep(depcode:String;depname:String;MyForm:TForm);
var
F901: TF901;
implementation
Uses DataPost;
{$R *.dfm}
//给主程序调用的过程
procedure F901SetUser(sform:TForm;UserNo:String;IP:String;Port:Integer);
begin
TF901(sform).UserNo:=UserNo;
TF901(sform).MyDataBase:=DataPost.ConnectData(IP,Port);
end;
//一个跟回调过程一样的过程,这个用于回调过程功能实现
procedure SetDep(depcode:String;depname:String;MyForm:TForm);
begin
TF901(MyForm).Edit7.Text:=depcode;
TF901(MyForm).Edit6.Text:=depname;
end;
//BPL里面调用另外一个BPL
procedure TF901.Edit6ClickBtn(Sender: TObject);
var
BPLHandle: HMODULE;
frm: TCustomForm;
AClass : TPersistentClass;
DepSetUser:procedure(sform:TForm;tForm:TForm;User:String;IP:String;Port:Integer);
PMeADD:procedure(me:MeADD);
begin
//加载BPL
BPLHandle := LoadPackage('Share/DepBPL.bpl');
//这里跟主程序调用的一样,调用另外一个BPL的过程
@DepSetUser := GetProcAddress(BPLHandle, 'DepSetUser');
//另外一个BPL回调本BPL的过程
@PMeADD := GetProcAddress(BPLHandle, 'PMeADD');
if BPLHandle > 0 then
begin
//获取Form
AClass := FindClass('TFQueryDep');
if AClass<>nil then
begin
//创建另外一个BPL的Form实例
frm:=TComponentClass(AClass).Create(Application) as TCustomForm;
if @DepSetUser<>nil then
//调用里面的过程
DepSetUser(TForm(frm),self,'admin',MyDataBase.DSRestConnection1.Host,MyDataBase.DSRestConnection1.Port);
if @PMeADD<>nil then
//把实现回调功能的过程传过去
PMeADD(SetDep);
frm.ShowModal;
frm.Free;
end
end
end;
procedure TF901.FormShow(Sender: TObject);
begin
DataPost.ButtonPower(Self.Name,self.UserNo,self.ToolBar1,self.MyDataBase);
DataPost.F901OpenData(self);
end;
procedure TF901.ToolButton10Click(Sender: TObject);
begin
DataPost.F901Cancel(self);
end;
procedure TF901.ToolButton1Click(Sender: TObject);
begin
DataPost.F901Add(self);
end;
procedure TF901.ToolButton2Click(Sender: TObject);
begin
DataPost.F901Update(self);
end;
procedure TF901.ToolButton3Click(Sender: TObject);
begin
DataPost.F901Delete(self);
end;
procedure TF901.ToolButton4Click(Sender: TObject);
begin
DataPost.F901Save(self);
end;
procedure TF901.ToolButton8Click(Sender: TObject);
begin
DataPost.F901Cancel(self);
end;
//这里是给主程序显示可调用的过程
exports
F901SetUser;
//这里把Form给主程序定位Form使用
initialization
RegisterClass(TF901);
finalization
UnRegisterClass(TF901);
end.
第二个BPL代码
unit QueryDep;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, EhLibVCL, GridsEh, DBAxisGridsEh, DBGridEh,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
FireDAC.Comp.Client, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.pngimage,Vcl.ShadowForms,
Datasnap.DSClientRest,system.IniFiles,Data.FireDACJSONReflect,
FireDAC.Stan.StorageXML, FireDAC.Stan.StorageJSON, FireDAC.Stan.StorageBin;
type
//定义回调过程
MeADD=procedure(DepCode:String;DepName:String;MyForm:TForm);
TFQueryDep = class(TShadowForm)
DBGridEh1: TDBGridEh;
DataSource1: TDataSource;
Panel1: TPanel;
Label4: TLabel;
Image1: TImage;
Panel3: TPanel;
Panel4: TPanel;
DSRestConnection1: TDSRestConnection;
FDMemTable1: TFDMemTable;
FDStanStorageBinLink1: TFDStanStorageBinLink;
FDStanStorageJSONLink1: TFDStanStorageJSONLink;
FDStanStorageXMLLink1: TFDStanStorageXMLLink;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure DBGridEh1DblClick(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
var
UserNo:String;
//用于接收上一个BPL的Form,后面调用回调过程的时候会传回去
Form:TForm;
end;
//顶一个回调过程功能实现,用于调用上一个BPL的回调过程接收
procedure PMeADD(me:MeADD);
//定义上一个BPL调用过程
procedure DepSetUser(sform:TForm;UserNo:String;IP:String;Port:Integer);
var
FQueryDep: TFQueryDep;
FMeADD:MeADD;
implementation
Uses Server;
{$R *.dfm}
//上一个BPL调用过程的功能实现
procedure DepSetUser(sform:TForm;UserNo:String;IP:String;Port:Integer);
begin
TFQueryDep(sform).UserNo:=UserNo;
TFQueryDep(sform).Form:=sform;
TFQueryDep(sform).DSRestConnection1.Host:=IP;
TFQueryDep(sform).DSRestConnection1.Port:=Port;
end;
//用于接收传过来的过程
procedure PMeADD(me:MeADD);
begin
FMeADD:=ME;
end;
procedure TFQueryDep.DBGridEh1DblClick(Sender: TObject);
begin
//调用回调过程,把值和Form传回去 FMeADD(DBGridEh1.DataSource.DataSet.FieldByName('cDepCode').AsString,DBGridEh1.DataSource.DataSet.FieldByName('cDepName').AsString,Form);
close;
end;
procedure TFQueryDep.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Action := caFree;
end;
procedure TFQueryDep.FormDestroy(Sender: TObject);
begin
FQueryDep := nil;
end;
procedure TFQueryDep.FormShow(Sender: TObject);
var
Server: TServerMethods1Client;
DSlIST: TFDJSONDataSets;
begin
Server := TServerMethods1Client.Create(DSRestConnection1);
DSlIST := Server.ServerGetTable('select * from Department order by cDepCode', UserNo, 1);
FDMemTable1.FieldDefs.Clear;
FDMemTable1.Close;
FDMemTable1.Data := TFDJSONDataSetsReader.GetListValue(DSlIST, 0).Data;
FDMemTable1.Open;
end;
procedure TFQueryDep.Image1Click(Sender: TObject);
begin
close;
end;
//给另外一个BPL获取过程使用
exports
PMeADD,DepSetUser;
//给另外一个BPL获取Form使用
initialization
RegisterClass(TFQueryDep);
finalization
UnRegisterClass(TFQueryDep);
end.
主要代码就这些
调用第一个BPL
通过第一个BPL调用第二个BPL
点击后,把第二个BPL的值,通过回调过程传递到一个BPL里面