通过内存映像文件共享一组对象

通过内存映像文件共享一组对象（主程序和动态库或者各进程之间共享一组对象）

 

//单元设计: 陈新光(CXG)

//设计时间: 2009-10-8 16:51:40

//单元功用: 封装内存映射操作

 

unit uMap;

 

interface

 

uses

  Windows, SysUtils, Dialogs;

 

procedure SetMappedObj(const AObj:Pointer);stdcall;

function GetMappedObj:Pointer;stdcall;

 

procedure Map(const DesiredAccess: DWORD = FILE_MAP_ALL_ACCESS); stdcall;

procedure Unmap(); stdcall;

 

implementation

 

const

  SExceptionInfo = 'Error in calling MappedObj.dll.';

  SMappedObjName = 'RocketGis.MappedObj';

 

type

  PMappedObj = ^TMappedObj;

  TMappedObj = packed record

    Size: DWORD;

    Data: Pointer;

  end;

 

var

  HasMapped: Boolean;

  MappedObjHandle: THandle;

  MappedObj: PMappedObj;

 

function GetMappedObj:Pointer; stdcall;

begin

  Result := MappedObj^.data;

end;

 

procedure SetMappedObj(const AObj:Pointer);

begin

  if not assigned(MappedObj^.Data) then

    MappedObj^.Data := AObj;

end;

 

procedure Map(const DesiredAccess: DWORD); stdcall;

var

  LSize: Integer;

begin

  try

    if HasMapped then  exit ;

    LSize := Sizeof(TMappedObj);

    MappedObjHandle := CreateFileMapping(DWORD($FFFFFFFF),nil, PAGE_READWRITE,0,

      LSize,SMappedObjName);

    if MappedObjHandle = 0 then RaiseLastOSError();

    MappedObj := MapViewOfFile(MappedObjHandle, DesiredAccess, 0, 0, LSize);

    if not Assigned(MappedObj) then

    begin

      CloseHandle(MappedObjHandle);

      RaiseLastOSError();

    end;

    HasMapped := true;

   except

    on Exception do

      MessageDlg(SExceptionInfo,mtError, [mbOk],0);

    end;

end;

 

procedure Unmap(); stdcall;

begin

  try

    if not HasMapped then exit;

    UnmapViewOfFile(MappedObj);

    CloseHandle(MappedObjHandle);

    HasMapped := False;

  except

    on Exception do MessageDlg(SExceptionInfo, mtError, [mbOk], 0);

  end;

end;

 

end.

 

调用示例：

// 定义一个全局共享对象的结构体
  PShareObjRec = ^TShareObjRec;  
  TShareObjRec = record
    Udpconnection: TRemoteUdpConnection;
    employee: PTEmployeeRec;
    imageList: TImageList;
  end;

// 将全局对象映射进内存镜像文件里面
PShareObjRec.Udpconnection := RemoteUdpConnection1;
PShareObjRec.imageList := ImageList1;
uMap.SetMappedObj(PShareObjRec);

// 从内存镜像文件里面获取全局共享对象
function GetUdpconnection: TRemoteUdpConnection;
begin
  Result := nil;
  uMap.Map();
  Result := PShareObjRec(uMap.GetMappedObj)^.Udpconnection;
  uMap.Unmap;
end;