ACCESS使用开发框架的——通过外存映像文件共享一组对象

经外存映像文件共享一组对象(主程序和动态库或者各级进程中共享一组对象)

 

//单元设计:
陈新光(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; 

 

 

 

相关文章