通过内存映像文件共享一组对象（主程序和动态库或者各进程之间共享一组对象）
//单元设计: 陈新光(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;