umap.pas

来自「中式财务栏 表格式录入 运行时设置可显示列、列名、列宽」· PAS 代码 · 共 87 行

{*******************************************************}
{                                                       }
{       内存映像文件                                    }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

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.