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

测试环境：XP,DELPHI XE

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

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

主程序代码：

unit Main_Unit;interfaceuses  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;interfaceuses  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.