Dll学习三_Dll 相互间以及主程序间的数据共享——测试未通过，应该用内存映射

最新推荐文章于 2020-12-08 05:23:34 发布

胡伟峰

最新推荐文章于 2020-12-08 05:23:34 发布

阅读量1.1k

点赞数

分类专栏： Delphi类

本文链接：https://blog.csdn.net/jupt1/article/details/17006735

版权

Delphi类专栏收录该内容

32 篇文章 0 订阅

订阅专栏

测试环境：XP,DELPHI XE

验证通过结构：主程序+一个Dll窗体

共享方式原理：通过主程序与各Dll定义相同的参数结构体，由主程序实例化该结构体，对于各Dll间的共享，通过传主程序实例化的结构体指针达到各Dll与主程序相互间的数据共享。且Dll释放不影响主程序实例化结构体时获得的内存空间

主程序代码：

unit Main_Unit;

interface

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

type
  TPara = record
    ADOConnStr: String;
  end;
  TCreateFrm = procedure(AppHnd: THandle; APar: TPara); stdcall;		//此处传递主程序实例化后的参数结构体
  TCreateSubFrm = procedure(AppHnd: THandle); stdcall;
  TDropFrm = procedure; stdcall;
  TFrm_Main = class(TForm)
    Btn_1: TButton;
    Btn_2: TButton;
    Btn_3: TButton;
    Btn_4: TButton;
    Btn_5: TButton;
    Btn_6: TButton;
    Btn_7: TButton;    procedure Btn_1Click(Sender: TObject);
    procedure Btn_2Click(Sender: TObject);
    procedure Btn_3Click(Sender: TObject);
    procedure Btn_4Click(Sender: TObject);
    procedure Btn_5Click(Sender: TObject);
    procedure Btn_6Click(Sender: TObject);
    procedure Btn_7Click(Sender: TObject);
  private
    LibHandle: THandle;
    FormRef: LongInt;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_Main: TFrm_Main;
  APara: TPara;

implementation

{$R *.dfm}

procedure TFrm_Main.Btn_1Click(Sender: TObject);
begin
  if LibHandle = 0 then
  begin
    LibHandle := SafeLoadLibrary('SubMain.dll');
    if LibHandle = 0 then
      raise Exception.Create('Not Found Dll File')
    else
      ShowMessage('Dll Loaded');
  end;
end;

procedure TFrm_Main.Btn_2Click(Sender: TObject);
begin
  if LibHandle > 0 then
  begin
    FreeLibrary(LibHandle);
    LibHandle := 0;
    ShowMessage('Dll UnLoaded');
  end;
end;

procedure TFrm_Main.Btn_3Click(Sender: TObject);
var
  CreateFrm: TCreateFrm;
begin
  if LibHandle = 0 then
    raise Exception.Create('Place Load Dll File First');

  @CreateFrm := GetProcAddress(LibHandle,PChar('CreateFrm'));
  if @CreateFrm = nil then
    raise Exception.Create('Function Error');

  APara.ADOConnStr := 'Provider=SQLOLEDB.1;Password=*****;Persist Security Info=True;User ID=sa;Initial Catalog=test;Data Source=127.0.0.1';	//结构体赋值
  CreateFrm(Application.Handle,APara);
end;

procedure TFrm_Main.Btn_4Click(Sender: TObject);
var
  DropFrm: TDropFrm;
begin
  @DropFrm := GetProcAddress(LibHandle,PChar('DropFrm'));
  if @DropFrm = nil then
    raise Exception.Create('Function Error');

  DropFrm;
end;

procedure TFrm_Main.Btn_5Click(Sender: TObject);
var
  CreateSubFrm: TCreateSubFrm;
begin
  if LibHandle = 0 then
    raise Exception.Create('Place Load Dll File First');

  @CreateSubFrm := GetProcAddress(LibHandle,PChar('CreateSubFrm'));
  if @CreateSubFrm = nil then
    raise Exception.Create('Function Error');

  CreateSubFrm(Application.Handle);
end;

procedure TFrm_Main.Btn_7Click(Sender: TObject);
begin
  ShowMessage(APara.ADOConnStr);			//用来释放Dll后，验证结构体内存块是否同步被释放
end;

end.

Dll引用代码：

unit SubMain_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, FyDataConn_Unit, ActiveX,
  ADODB, StdCtrls, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, cxStyles, dxSkinsCore, dxSkinBlueprint,
  dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinHighContrast,
  dxSkinSevenClassic, dxSkinSharpPlus, dxSkinStardust, dxSkinTheAsphaltWorld,
  dxSkinVS2010, dxSkinWhiteprint, dxSkinscxPCPainter, cxCustomData, cxFilter,
  cxData, cxDataStorage, cxEdit, cxNavigator, cxDBData, cxGridLevel, cxClasses,
  cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
  cxGrid, Grids, DBGrids,dxCore;

type
  TPara = record				//与主程序定义一个一样的结构体
    ADOConnStr: String;
  end;
  TPPara = ^TPara;				//定义该结构体的指针结构
  TFrm_SubMain = class(TForm)
    Btn_1: TButton;
    GTV_1: TcxGridDBTableView;
    GL_1: TcxGridLevel;
    Grd_1: TcxGrid;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure Btn_1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    DSet: TADODataSet;
    DS: TDataSource;
    Conn: TADOConnection;
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure CreateFrm(AppHnd: THandle; APar: TPara);export;stdcall;
  procedure DropFrm; export;stdcall;

var
  Frm_SubMain: TFrm_SubMain;
  LocPara: TPara;
  PPara: TPPara;

implementation

{$R *.dfm}
procedure CreateFrm(AppHnd: THandle; APar: TPara);
begin
  Application.Handle := AppHnd;
  PPara := @APar;		//直接
  if not Assigned(Frm_SubMain) then
    Frm_SubMain := TFrm_SubMain.Create(Application);

  Frm_SubMain.Show;
end;

procedure DropFrm;
begin
  if Frm_SubMain <> nil then
    FreeAndNil(Frm_SubMain);
end;
procedure TFrm_SubMain.Btn_1Click(Sender: TObject);
var
  SQL: String;
begin
  DSet.Connection := Conn;
  DS.DataSet := DSet;
  SQL := 'Select * From Cg_CgDanSub';
  dbOpen(SQL,DSet);       //自定义函数，用于打开数据集
  GTV_1.DataController.DataSource := DS;
  (GTV_1.DataController as IcxCustomGridDataController).DeleteAllItems;           //清除cxGrid列
  (GTV_1.DataController as IcxCustomGridDataController).CreateAllItems(False);    //添加cxGrid列

end;

procedure TFrm_SubMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFrm_SubMain.FormCreate(Sender: TObject);
begin
  Conn := TADOConnection.Create(Application);
  Conn.LoginPrompt := False;
  Conn.ConnectionString := PPara.ADOConnStr;
  //Conn.ConnectionString := 'Provider=SQLOLEDB.1;Password=fydesign;Persist Security Info=True;User ID=sa;Initial Catalog=test;Data Source=127.0.0.1';
  Conn.Connected := True;
  DSet := TADODataSet.Create(Application);
  DS := TDataSource.Create(Application);
end;

procedure TFrm_SubMain.FormDestroy(Sender: TObject);
begin
  DSet.Free;
  DS.Free;
  FreeAndNil(Conn);
  Frm_SubMain := nil;
end;
initialization
  dxInitialize;
finalization
  dxFinalize;
end.