内存映射文件的使用

library Project1;
{ 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
  ShareMem,
  Windows,
  dialogs,
  SysUtils,
  Classes;
const
     cMMFileName: PChar = 'ShareMapData';
  {$I G:/Delphi/应用程序/DLL/共享数据的DLL/DLLDATA.INC }
{$R *.res}
var
  GlobalData : PGlobalDLLData;
  MapHandle : THandle;
  flag:integer=0;
 //GetDLLData 是DLL 的导出函数
 procedure GetDLLData(var AGlobalData:PGlobalDLLData);stdcall;
 begin
// 让变量AGlobalData 与 GlobaData 指向同一个内存地址
  AGlobalData:= GlobalData;
 end;
 procedure OpenSharedData;
 var
   Size:Integer;
 begin
   Size := SizeOf(TGlobalDllData);
   //获得内存的映射文件对象
   MapHandle := CreateFileMapping(DWord(-1),nil,PAGE_READWRITE,0,size,cMMFileName);
   if MapHandle = 0 then
     raiseLastWin32Error;
     //将数据映射到调用进程的地址空间并获得首地址的指针
   GlobalData:= MapViewOfFile(MapHandle,FILE_MAP_ALL_ACCESS,0,0,size);
   //数据初始化
   GlobalData^.S := 'ShareLib';
   GlobalData^.I := 1;
   if GlobalData = nil then
   begin
     CloseHandle(MapHandle);
     RaiseLastWin32Error;
   end;
 end;
 procedure CloseSharedData;
 //该进程取消内存映射文件并释放内存映射文件的句柄
 begin
   UnmapViewOfFile(GlobalData);
   CloseHandle(MapHandle);
 end;
 procedure DLLEntryPoint(dwReason:DWord);
 begin
   case dwReason of
     DLL_PROCESS_ATTACH : begin
       OpenSharedData;
       flag:=flag+1;
       messagedlg('load DLL ...'+inttostr(flag),mtinformation,[mbok],0);
     end;
     DLL_PROCESS_DETACH : begin
       CloseSharedData;
       flag:=flag-1;
       messagedlg('free DLL ...'+inttostr(flag),mtinformation,[mbok],0);
     end;
   end;
 end;
 exports
   GetDLLData;
begin
  DllProc := @DLLEntryPoint;
  DllEntryPoint(DLL_PROCESS_ATTACH);
end.
//以上是dll
//以下是 exe 调用上面的dll.
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 type
  PGlobalDLLData=^TGlobalDLLData;
  TGlobalDLLData= record
  S:string[50];
  i:integer;
end;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure AttchDll(DllName: string);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  TGetShare = procedure (var AGlobalData:PGlobalDLLData) stdcall;
 const
    DLLPATH='G:/Delphi/应用程序/DLL/共享数据的DLL/Project1.dll';
var                 
  Form1: TForm1;
  getshare1:TGetShare;
  attch:Thandle;
  ifgetshare1:boolean=false;
  loadDll : boolean=false;
  SharePoint:PGlobalDLLData;
implementation
{$R *.dfm}
procedure TForm1.AttchDll(DllName: string);
begin
  attch:= LoadLibrary(PChar(DllName));
  if attch <= 0 then
  begin
    raise exception.Create ('调用DLL失败！');
    loadDll:=false;
  end;
  loadDll:=true;
  @getShare1:=GetProcAddress(attch,'GetDLLData');
  if not Assigned(getShare1) then begin
    raise exception.Create('GetProcAddress 调用失败！');
    ifgetshare1:=false;
  end;
  ifgetshare1:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 try
   AttchDll(DLLPATH);
   SharePoint:=nil;
 except
   rai
a8f4
se exception.Create('加载DLL失败！');
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  s,s1:string;
begin
  if not loadDLL then begin
     showmessage('还没有加载DLL,请先加载DLL再进行此操作！');
     exit;
  end;
  getshare1(SharePoint);
  memo1.Lines.add('load Share data...'+datetimetostr(now));
  memo1.Lines.Add('SharePoint.S    SharePoint.I');
  s:=SharePoint.s;
  s1:=inttostr(SharePoint.i);
  while length(s)<12 do s:=' '+s;
  while length(s1)<16 do s1:=' '+s1;
  memo1.Lines.Add(s+s1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not loadDLL then begin
     showmessage('还没有加载DLL,请先加载DLL再进行此操作！');
     exit;
  end;
  if  assigned(SharePoint) then
    getShare1(SharePoint);
  SharePoint.S:=Edit2.text;
 try
   SharePoint.i:=strtoint(Edit1.text);
 except
   messagedlg('类型转换错误！',mterror,[mbok],0);
 end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
  if loadDLL then
    freelibrary(attch);
  close;
end;
end.